|
@@ -0,0 +1,110 @@
|
|
|
+(defvar *photogal/operating-photo-dir* nil)
|
|
|
+(defvar *photogal/all-photos* nil)
|
|
|
+(defvar *photogal/operating-table* nil)
|
|
|
+
|
|
|
+(defun photogal-init-operating-table ()
|
|
|
+ (setq *photogal/operating-table* (mapcar (lambda (photo)
|
|
|
+ (cons (list 'photo) photo))
|
|
|
+ *photogal/all-photos*)))
|
|
|
+
|
|
|
+(define-derived-mode photogal-mode text-mode "photogal"
|
|
|
+ "Major mode for grouping and labeling images.")
|
|
|
+
|
|
|
+(setq *photogal/raw-tags* '(("s" . "selfie") ("c" . "cityscape")))
|
|
|
+
|
|
|
+(defvar photogal-default-directory "/Users/jwd/bench/photos/")
|
|
|
+
|
|
|
+(defun photogal (photo-dir)
|
|
|
+ (interactive (list (read-directory-name "where are ur photos? "
|
|
|
+ photogal-default-directory)))
|
|
|
+ (message photo-dir)
|
|
|
+ (let ((photo-files-directory (directory-file-name photo-dir)))
|
|
|
+ (setq *photogal/operating-photo-dir* (concat photo-files-directory "-photogal"))
|
|
|
+ (setq *photogal/all-photos* (photogal-all-photos)))
|
|
|
+ (photogal-init-operating-table)
|
|
|
+ (photogal-init (photogal-current-file))
|
|
|
+ )
|
|
|
+
|
|
|
+(defun photogal-all-photos ()
|
|
|
+ (directory-files *photogal/operating-photo-dir*
|
|
|
+ t directory-files-no-dot-files-regexp))
|
|
|
+
|
|
|
+(defun photogal-current-file ()
|
|
|
+ (car *photogal/all-photos*))
|
|
|
+
|
|
|
+(defun photogal-add-tag-to-file (file tag)
|
|
|
+ (let ((tags (car (rassoc file *photogal/operating-table*))))
|
|
|
+ (setcar (rassoc file *photogal/operating-table*) (cons tag tags))))
|
|
|
+(defun photogal-get-tags-for-file (file)
|
|
|
+ (car (rassoc file *photogal/operating-table*)))
|
|
|
+
|
|
|
+(defun photogal-init (photo-file-path)
|
|
|
+ (let ((buf (get-buffer-create "photogal")))
|
|
|
+ (with-current-buffer buf
|
|
|
+ (photogal-mode)
|
|
|
+ (erase-buffer)
|
|
|
+ (insert "\n")
|
|
|
+ (insert " ")
|
|
|
+ (insert-image
|
|
|
+ ;; (create-image (car photos) 'imagemagick nil :width (- (window-pixel-width) 75))
|
|
|
+ (create-image photo-file-path
|
|
|
+ 'imagemagick nil :height (/ (window-pixel-height) 2)))
|
|
|
+ (insert "\n\nCurrent tags: ")
|
|
|
+ (insert (format "%s" (photogal-get-tags-for-file photo-file-path)))
|
|
|
+ (insert "\n\n")
|
|
|
+ (photogal-print-color "Tag:\n\n" "red")
|
|
|
+ (photogal-insert-tags)
|
|
|
+ )
|
|
|
+ (switch-to-buffer buf)))
|
|
|
+
|
|
|
+(defun photogal-print-color (str color)
|
|
|
+ (let ((beg (point)))
|
|
|
+ (insert str)
|
|
|
+ (put-text-property beg (point) 'font-lock-face `(:foreground ,color))))
|
|
|
+
|
|
|
+(defun photogal-insert-tags ()
|
|
|
+ (mapcar (lambda (tag)
|
|
|
+ (let ((beg (point))
|
|
|
+ (key-command (car tag))
|
|
|
+ (tag-name (cdr tag)))
|
|
|
+ (insert "[")
|
|
|
+ (photogal-print-color key-command "dark gray")
|
|
|
+ (insert "] ")
|
|
|
+ (photogal-print-color tag-name "blue")
|
|
|
+ (insert " ")))
|
|
|
+ *photogal/raw-tags*))
|
|
|
+
|
|
|
+(defvar photogal-mode-map nil "Keymap for `photogal-mode`")
|
|
|
+
|
|
|
+(defun photogal-refresh-buffer ()
|
|
|
+ "Refresh buffer."
|
|
|
+ (interactive)
|
|
|
+ (message "refreshing buffer")
|
|
|
+ (photogal-init (photogal-current-file)))
|
|
|
+
|
|
|
+(progn
|
|
|
+ (setq photogal-mode-map (make-sparse-keymap))
|
|
|
+ (define-key photogal-mode-map (kbd "g") 'photogal-refresh-buffer))
|
|
|
+
|
|
|
+(defmacro photogal-tagger (name)
|
|
|
+ (interactive)
|
|
|
+ (let ((my-funcname (intern (format "photogal-add-tag-%s" name))))
|
|
|
+ `(defun ,my-funcname ()
|
|
|
+ (interactive)
|
|
|
+ (photogal-add-tag-to-file ,(photogal-current-file) ,(format "%s" name))
|
|
|
+ (photogal-refresh-buffer))))
|
|
|
+
|
|
|
+
|
|
|
+(defun photogal-add-tag-to-current-file (tag-key)
|
|
|
+ (photogal-add-tag-to-file (photogal-current-file) tag-key))
|
|
|
+
|
|
|
+(mapcar (lambda (tag)
|
|
|
+ (let ((tag-key (car tag))
|
|
|
+ (tag-name (cdr tag))
|
|
|
+ )
|
|
|
+ (eval `(photogal-tagger ,(intern tag-key)))
|
|
|
+ (define-key photogal-mode-map (kbd tag-key) (intern (format "photogal-add-tag-%s" tag-key))
|
|
|
+ ;#'(lambda () (photogal-add-tag-to-current-file tag-key))
|
|
|
+ )
|
|
|
+ ))
|
|
|
+ *photogal/raw-tags*)
|