this is the one

Functionality: complete. v1.0

photogal.el

@@ -1,44 +1,181 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;    PHOTOGAL    ;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; v1.0 ;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                                                         ;;
+;;  author: jordyn                          ,   -    *     ;;
+;;  authored: spokane valley, summer '22      .          ` ;;
+;;                                                 ^ ~     ';
+;;    PHOTO                *    ,    '  . `   `  *      ,  ;;
+;;    , Grouper         '    `     .   ,* -   .            ;;
+;; .      And        ,    ^ '  .  '  .   `  `      '       ;;
+;;    `     Labeler    '   ,     * '      *                ;;
+;;  ,     .   ,     `        '        .                    ;;
+;;   '           -     '        ,                          ;;
+;;                                                         ;;
+;;                                                         ;;
+;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;; ;;  ;;
+
+
+
+;;;;  --  ----  --  -      DATA         -  --  ----  --  ;;;;
+
 (defvar *photogal/operating-photo-dir* nil)
 (defvar *photogal/all-photos* nil)
 (defvar *photogal/operating-table* nil)
+(defvar *photogal/--resize-photo* nil)
+(defvar *photogal/commands*
+  '(("RET" . "Next")
+    ("P" . "Prev")
+    ("A" . "Add tag")
+    ("D" . "Delete tag")
+    ("F" . "Show filename")
+    ("G" . "Refresh buffer")
+    ("R" . "Resize photo")
+    ("C" . "Compile and commit")))
 
-(defun photogal-init-operating-table ()
-       (setq *photogal/operating-table* (mapcar (lambda (photo)
-						  (cons (list 'photo) photo))
-						*photogal/all-photos*)))
+(defcustom photogal-default-directory "/Users/jwd/bench/photos/"
+  "This is where photogal will look for photos.")
+
+(defcustom photogal/tags
+  '(("a" . "art")
+    ("c" . "cityscape")
+    ("f" . "family")
+    ("g" . "good")
+    ("h" . "screenshot")
+    ("l" . "politics")
+    ("m" . "meme")
+    ("o" . "computer")
+    ("p" . "portrait")
+    ("r" . "reaction-photo")
+    ("t" . "photography")
+    ("s" . "selfie"))
+    "These are photo tags and the key to activate them.")
 
-(define-derived-mode photogal-mode text-mode "photogal"
-  "Major mode for grouping and labeling images.")
 
-(setq *photogal/raw-tags* '(("s" . "selfie") ("c" . "cityscape")))
+;;;;  --  ----  --  -      THE APP      -  --  ----  --  ;;;;
+
 
-(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)))
+  (interactive
+   (list (read-directory-name
+	  "where are ur photos? " photogal-default-directory)))
+  (let ((photos-origin-directory (directory-file-name photo-dir)))
+    (setq *photogal/operating-photo-dir* (concat photos-origin-directory "-photogal"))
+    (setq *photogal/all-photos* (photogal-all-photos photos-origin-directory))
+    (photogal-init (photogal-current-file)))
   (photogal-init-operating-table)
-  (photogal-init (photogal-current-file))
-  )
+  (photogal-generate-tag-commands))
 
-(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*))
+
+;;;;  --  ----  --  -  INITIALIZATION   -  --  ----  --  ;;;;
+
+(defun photogal-init-operating-table ()
+  (setq *photogal/operating-table*
+	(mapcar (lambda (photo)
+		  (cons '() photo))
+		*photogal/all-photos*)))
+
+(defun photogal-generate-tag-commands ()
+  "Generate and activate M-x (photogal-toggle-tag-TAG) to tag curent photo,
+for all tags defined -- one function per tag."
+  (mapcar (lambda (tag)
+	    (let ((tag-key (car tag))
+		  (tag-name (cdr tag)))
+	      (eval `(photogal-generate-tagger ,(intern tag-name)))
+	      (define-key photogal-mode-map (kbd tag-key)
+		(intern (format "photogal-toggle-tag-%s" tag-name)))))
+	  photogal/tags))
+
+;;;;  --  ----  --  -        TAG        -  --  ----  --  ;;;;
+
+(defun photogal-add-tag (new-tag new-tag-code)
+  (interactive "sNew tag: \nsTag code (length 1): ")
+  (let ((tag-code-too-long (> (length new-tag-code) 1))
+	(tag-code-in-use (photogal-tag-code-in-use new-tag-code)))
+    (if (or tag-code-too-long tag-code-in-use)
+	(progn (message "tag code must be a single character and can't be already in use")
+	       (call-interactively 'photogal-add-tag))
+      (photogal--add-tag new-tag new-tag-code))))
+
+(defun photogal-delete-tag (tag-code)
+  (interactive "sDelete tag: ")
+  (customize-save-variable
+   'photogal/tags
+   (seq-remove (lambda (tag) (string= (car tag) tag-code)) photogal/tags))
+  (photogal-refresh-buffer))
+
+(defun photogal--add-tag (new-tag new-tag-code)
+  (let ((escaped-str-tag (string-replace " " "-" new-tag)))
+    (customize-save-variable
+     'photogal/tags
+     (cons (cons new-tag-code escaped-str-tag) photogal/tags)))
+  (photogal-generate-tag-commands)
+  (photogal-refresh-buffer))
+
+(defun photogal-tag-code-in-use (tag-code)
+  (seq-contains-p
+   photogal/tags tag-code
+   (lambda (tag test) (string= (car tag) test))))
+
+(defun photogal-tags-for-file (file)
+  "Give the tags that this file has."
+  (car (rassoc file *photogal/operating-table*)))
+
+;;;;  --  ----  --  -   TAGGING FILES   -  --  ----  --  ;;;;
+
+(defun photogal-for-file-toggle-tag (file tag)
+  "If a file has the tag, remove it. If it doesn't have it, add it."
+  (if (photogal-file-has-tag? file tag)
+      (photogal-rm-tag-from-file file tag)
+    (photogal-add-tag-to-file file tag)))
 
 (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))))
+  "Append new tag for a file."
+  (let ((tags (photogal-tags-for-file file)))
+    (setcar (rassoc file *photogal/operating-table*)
+	    (seq-sort #'string< (seq-uniq (cons tag tags))))))
+
+(defun photogal-rm-tag-from-file (file tag)
+  "Dissociate tag from file."
+  (defun tags-without-tag (tags tag)
+    (seq-sort
+     #'string<
+     (seq-uniq
+      (seq-remove
+       (lambda (tg) (string= tg tag)) tags))))
+  (let ((tags (photogal-tags-for-file file)))
+    (setcar (rassoc file *photogal/operating-table*)
+	    (tags-without-tag tags tag))))
+
+(defun photogal-file-has-tag? (file tag)
+  "Does this file have this tag?"
+  (let ((tags (photogal-tags-for-file file)))
+    (seq-contains-p tags tag)))
+
 (defun photogal-get-tags-for-file (file)
+  "What are all the tags for this file?"
   (car (rassoc file *photogal/operating-table*)))
 
-(defun photogal-init (photo-file-path)
+
+;;;;  --  ----  --  -      FILE OPS     -  --  ----  --  ;;;;
+
+(defun photogal-all-photos (directory)
+  "Give me a list of all the photos in my operating directory."
+  (directory-files directory
+		   t directory-files-no-dot-files-regexp))
+
+(defun photogal-current-file ()
+  "What is the file currently being operated on?"
+  (car *photogal/all-photos*))
+
+
+
+;;;;  --  ----  --  -       U I         -  --  ----  --  ;;;;
+(defun photogal-init (photo-file-path &optional show-filepath)
+  "Set everything up in the buffer."
   (let ((buf (get-buffer-create "photogal")))
     (with-current-buffer buf
       (photogal-mode)
@@ -46,65 +183,176 @@
       (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)))
+       (if *photogal/--resize-photo*
+	   (create-image photo-file-path '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)
+      (photogal--insert-print-color "Tag:\n\n" "red")
+      (photogal-insert-tags-to-buffer photogal/tags)
+      (photogal--insert-print-color "\n\nCommands:\n\n" "red")
+      (photogal-insert-commands-to-buffer
+       *photogal/commands*)
+      (when show-filepath
+	(insert "\n\n")
+	(insert (photogal-current-file)))
       )
     (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*))
+(defun photogal-next-file ()
+  (interactive)
+  (setq *photogal/all-photos*
+	(append (cdr *photogal/all-photos*) (list (car *photogal/all-photos*))))
+  (photogal-refresh-buffer))
 
-(defvar photogal-mode-map nil "Keymap for `photogal-mode`")
+(defun photogal-prev-file ()
+  (interactive)
+  (setq *photogal/all-photos*
+	(append (last *photogal/all-photos*) (butlast *photogal/all-photos*)))
+  (photogal-refresh-buffer))
 
-(defun photogal-refresh-buffer ()
+(defun photogal-refresh-buffer (&optional show-filepath)
   "Refresh buffer."
   (interactive)
   (message "refreshing buffer")
-  (photogal-init (photogal-current-file)))
+  (photogal-init (photogal-current-file) show-filepath)
+  (photogal-generate-tag-commands)
+  (beginning-of-buffer))
 
-(progn
-  (setq photogal-mode-map (make-sparse-keymap))
-  (define-key photogal-mode-map (kbd "g") 'photogal-refresh-buffer))
+(defun photogal-resize-photo ()
+  (interactive)
+  (setq *photogal/--resize-photo* (not *photogal/--resize-photo*))
+  (photogal-refresh-buffer))
 
-(defmacro photogal-tagger (name)
+(defun photogal-show-filepath ()
   (interactive)
-  (let ((my-funcname (intern (format "photogal-add-tag-%s" name))))
+  (photogal-refresh-buffer t))
+
+(defun photogal-insert-tags-to-buffer (tags)
+  "Pretty print the tags with their toggle key."
+  (mapcar (lambda (tag)
+	    (let* ((key-command (car tag))
+		   (tag-name (cdr tag))
+		   (activated (photogal-file-has-tag? (photogal-current-file) tag-name)))
+	      (photogal--pprint-key-command key-command tag-name activated)))
+	  (seq-sort (lambda (t1 t2) (string< (car t1) (car t2))) tags)))
+
+(defun photogal-insert-commands-to-buffer (commands)
+  "Pretty print the commands with their invoke key."
+  (mapcar (lambda (command)
+	    (let ((key-command (car command))
+		  (command-name (cdr command)))
+	      (photogal--pprint-key-command key-command command-name)))
+	  commands))
+
+
+(defun photogal--pprint-key-command (key-to-type name-of-command &optional activated)
+  "Make the low-level insertions to the buffer to render a key-command."
+  (let ((length-of-unit (+ (length key-to-type) (length name-of-command) 3)))
+    (when (> (+ (+ (current-column) length-of-unit)
+		10)
+	     (window-width))
+	(insert "\n"))
+    (insert "[")
+    (if activated
+	(photogal--insert-print-color key-to-type "SeaGreen2")
+      (photogal--insert-print-color key-to-type "dark gray"))
+    (insert "] ")
+    (photogal--insert-print-color name-of-command "blue" (- 16 (length key-to-type)))
+    (insert " ")))
+
+(defun photogal--insert-print-color (string-to-insert-to-buffer color &optional padding)
+  "Insert some text in this color."
+  (let ((beg (point))
+	(padding
+	 (if padding
+	     (format "%s" padding)
+	   "0")))
+    (insert (format (concat "%-" padding "s") string-to-insert-to-buffer))
+    (put-text-property beg (point) 'font-lock-face `(:foreground ,color))))
+
+
+;;;;  --  ----  --  -     META SHIT     -  --  ----  --  ;;;;
+
+(defmacro photogal-generate-tagger (name)
+  "Generate function to toggle a tag which is itself on the current file.
+One of these is needed per tag. For instance if you want to create the tag
+'cool', you can run and evaluate (photogal-generate-tagger cool) to create a new
+function `photogal-toggle-tag-cool` that will toggle the tag 'cool' for
+the current file."
+  (let ((my-funcname (intern (format "photogal-toggle-tag-%s" name))))
     `(defun ,my-funcname ()
        (interactive)
-       (photogal-add-tag-to-file ,(photogal-current-file) ,(format "%s" name))
+       (photogal-for-file-toggle-tag (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))
+;;;;  --  ----  --  -MOVING FILES AROUND-  --  ----  --  ;;;;
+
+
+(defun photogal-files--get-extension (filepath)
+  (file-name-extension filepath))
+
+(defun photogal-files--generate-unique-identifier (filepath)
+  "Not GUARANTEED unique, but probably unique enough for my purposes."
+  (seq-take (md5 (concat (current-time-string) filepath))
+	    6))
+
+(defun photogal-files--new-file-name-for-photo (filepath tags)
+  (cons
+   filepath
+   (file-name-with-extension
+    (file-name-concat
+     *photogal/operating-photo-dir*
+     (concat
+      (photogal-files--generate-unique-identifier filepath)
+      "-"
+      (format-time-string "%M%H,%d%m%y")
+      "_"
+      (string-join tags "_")
+      ))
+    (file-name-extension filepath))))
+
+(defun photogal-files--new-filenames-for-photos ()
+  (mapcar
+   (lambda (photo)
+     (let ((filepath (cdr photo))
+	   (tags (car photo)))
+       (photogal-files--new-file-name-for-photo filepath tags)))
+   *photogal/operating-table*))
+
+(defun photogal-compile-and-commit ()
+  (interactive)
+  (if (y-or-n-p (format  "Are u sure? "))
+    (mapcar
+     (lambda (file-rename)
+       (let ((origin (car file-rename))
+	     (destination (cdr file-rename)))
+	 (copy-file origin destination)))
+     (photogal-files--new-filenames-for-photos))
+    (message "whoops")))
+
 
-(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*)
+
+;;;;  --  ----  --  -   KEY BINDINGS    -  --  ----  --  ;;;;
+
+(defvar photogal-mode-map nil "Keymap for `photogal-mode`")
+
+(progn
+  (setq photogal-mode-map (make-sparse-keymap))
+  (define-key photogal-mode-map (kbd "G") 'photogal-refresh-buffer)
+  (define-key photogal-mode-map (kbd "RET") 'photogal-next-file)
+  (define-key photogal-mode-map (kbd "<right>") 'photogal-next-file)
+  (define-key photogal-mode-map (kbd "P") 'photogal-prev-file)
+  (define-key photogal-mode-map (kbd "<left>") 'photogal-prev-file)
+  (define-key photogal-mode-map (kbd "A") 'photogal-add-tag)
+  (define-key photogal-mode-map (kbd "D") 'photogal-delete-tag)
+  (define-key photogal-mode-map (kbd "F") 'photogal-show-filepath)
+  (define-key photogal-mode-map (kbd "R") 'photogal-resize-photo)
+  (define-key photogal-mode-map (kbd "C") 'photogal-compile-and-commit))
+
+(define-derived-mode photogal-mode text-mode "photogal"
+  "Major mode for grouping and labeling images.")