robust file saving (commit photos)

Harden the commit functionality.

photogal.el

@@ -2,8 +2,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;    PHOTOGAL    ;;;;;;;;;;;;;;;;;;;;;`;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; v1.0 ;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;*;;;
-;;                                                         ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;,;;;;;;;;;*;;;
+;;                                        `                ;;
 ;;  author: jordyn                          ,   -    *     ;;
 ;;  authored: spokane valley, summer '22      .          ` ;;
 ;;                                           *     ^ ~     ';
@@ -11,7 +11,7 @@
 ;;    , Grouper         '    `     .    * -   .            ;;
 ;; .      And        ,    ^ '  .  '  .   `  `      '       ;;
 ;;    `     Labeler    '   ,     * '      *                ;;
-;;  ,     .   ,     `        '        .                    ;;
+;;  ,     .   ,     `        '        .        `           ;;
 ;;   '           -     '        ,                          ;;
 ;;                                                         ;;
 ;;                                                         ;;
@@ -34,8 +34,9 @@
     ("F" . "Show filename")
     ("G" . "Refresh buffer")
     ("R" . "Resize photo")
-    ("C" . "Compile and commit")
-    ("N" . "Name the file")))
+    ("C" . "Commit all")
+    ("N" . "Name the file")
+    ("O" . "Add a dir")))
 
 (defcustom photogal-default-directory "/Users/jwd/bench/photos/"
   "This is where photogal will look for photos.")
@@ -61,6 +62,14 @@
 (defun photogal-set-tags-for-file (photo-filepath tags)
   "make this file have these tags"
   (photogal--set-tags (photogal--lookup-photo photo-filepath) tags))
+
+(defun photogal-get-folders-for-file (photo-filepath)
+  "what folders does this file have?"
+  (photogal--get-folders (photogal--lookup-photo photo-filepath)))
+(defun photogal-set-folders-for-file (photo-filepath folders)
+  "make this file have these folders"
+  (photogal--set-folders (photogal--lookup-photo photo-filepath) folders))
+
 (defun photogal-get-name-for-file (photo-filepath)
   "does this file have a user-given name?"
   (photogal--get-name (photogal--lookup-photo photo-filepath)))
@@ -68,9 +77,33 @@
   "give this file a Proper name. (embedded in final filename) (optional)"
   (photogal--set-name (photogal--lookup-photo photo-filepath) name))
 
+(defun photogal-mark-photo-for-copying (photo-filepath)
+  "toggle on to copy this file. Warning: marks file for committing."
+  (plist-put (photogal--lookup-photo photo-filepath)
+	     'copy-to-dir t))
+(defun photogal-unmark-photo-for-copying (photo-filepath)
+  "toggle on to NOT copy this file. Warning: will not commit file."
+  (plist-put (photogal--lookup-photo photo-filepath)
+	     'copy-to-dir nil))
+
+(defun photogal-photo-valid-for-committing? (photo-filepath)
+  (let ((all-fields-for-photo
+	 (mapcar (lambda (field) (plist-get (photogal--lookup-photo photo-filepath)
+					    field))
+		 '(tags name))))
+
+    (seq-some (lambda (field) (not (eq nil field)))
+	      all-fields-for-photo)))
+
+(defun photogal-file-marked-for-copying? (photo-filepath)
+  (plist-get (photogal--lookup-photo photo-filepath)
+	     'copy-to-dir ))
+
 ;; //             internal           \\ ;;
 (defun photogal--lookup-photo (photo-filepath)
-  (assoc photo-filepath *photogal/operating-table*))
+  (seq-find (lambda (photo)
+	      (string= (photogal--get-filepath photo) photo-filepath))
+   *photogal/operating-table*))
 
 (defun photogal--get-filepath (photo)
   (plist-get photo 'filepath))
@@ -120,6 +153,11 @@
   (photogal-init-operating-table)
   (photogal-generate-tag-commands))
 
+(defun photogal-restart ()
+  (interactive)
+  (setq *photogal/all-photos* (photogal-all-photos *photogal/photos-origin-directory*))
+  (photogal-init-operating-table)
+  (photogal-init (photogal-current-file)))
 
 
 ;;;;  --  ----  --  -  INITIALIZATION   -  --  ----  --  ;;;;
@@ -127,7 +165,9 @@
 (defun photogal-make-photo (filepath)
   `(filepath ,filepath
 	     tags ,nil
-	     name ,nil))
+	     name ,nil
+	     folders ,(list *photogal/operating-photo-dir*)
+	     copy-to-dir ,nil))
 
 (defun photogal-init-operating-table ()
   (setq *photogal/operating-table*
@@ -211,6 +251,22 @@ for all tags defined -- one function per tag."
   (let ((tags (photogal-get-tags-for-file file)))
     (seq-contains-p tags tag)))
 
+;;;;  --  ----  --  -     DEST DIRS     -  --  ----  --  ;;;;
+
+(defun photogal-add-folder-for-file (file folder)
+  "Append new folder for a file."
+  (let ((folders (photogal-get-folders-for-file file)))
+    (photogal-set-folders-for-file file
+		       (seq-sort #'string< (seq-uniq (cons folder folders))))))
+
+(defun photogal-give-a-folder (name)
+  (interactive ;"sWhat folder do u wannan put this in ")
+   (list (read-directory-name
+	  "What folder do u wannan put this in " photogal-default-directory)))
+  (let ((folder-name (directory-file-name name)))
+    (photogal-add-folder-for-file (photogal-current-file) folder-name)
+    (photogal-mark-photo-for-copying (photogal-current-file))
+    (photogal-refresh-buffer)))
 
 ;;;;  --  ----  --  -     FILE NAME     -  --  ----  --  ;;;;
 
@@ -219,6 +275,7 @@ for all tags defined -- one function per tag."
   (photogal-set-name-for-file
    (photogal-current-file)
    (string-replace " " "-"  name))
+  (photogal-mark-photo-for-copying (photogal-current-file))
   (photogal-refresh-buffer))
 
 ;;;;  --  ----  --  -      FILE OPS     -  --  ----  --  ;;;;
@@ -240,6 +297,14 @@ for all tags defined -- one function per tag."
       (photogal-mode)
       (erase-buffer)
       (photogal-index-tracker)
+
+      (if (photogal-file-marked-for-copying? photo-file-path)
+	  (progn
+	    (insert "\t\t\t\t    will commit?: ")
+	    (photogal--insert-print-color "✓" "SeaGreen3"))
+	(progn
+	  (insert "\t\t\t\t    will commit?: ")
+	  (photogal--insert-print-color "✗" "red")))
       (insert "\n")
       (insert " ")
       (insert-image
@@ -248,15 +313,29 @@ for all tags defined -- one function per tag."
 			 :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)))
-      (if (photogal-get-name-for-file photo-file-path)
+      (let ((padding "\n"))
+	(if (photogal-get-name-for-file photo-file-path)
 	  (insert (format  "\nName: %s" (photogal-get-name-for-file photo-file-path)))
-	(insert "\n"))
-      (insert "\n\n")
-      (photogal--insert-print-color "Tag:\n\n" "red")
+	  (setq padding (concat padding "\n")))
+	(if (photogal-get-folders-for-file photo-file-path)
+	    (photogal--insert-print-color
+	     (format  "\ndest dir: %s"
+		      (photogal-get-folders-for-file photo-file-path))
+	     "light gray")
+	  (setq padding (concat padding "\n")))
+
+	(insert padding))
+
+
+
+
+      (insert "\n")
+      (photogal--insert-print-color "Tag:\n" "red")
       (photogal-insert-tags-to-buffer photogal/tags)
-      (photogal--insert-print-color "\n\nCommands:\n\n" "red")
+      (photogal--insert-print-color "\n\nCommands:\n" "red")
       (photogal-insert-commands-to-buffer
        *photogal/commands*)
       (when show-filepath
@@ -277,7 +356,10 @@ for all tags defined -- one function per tag."
 (defun photogal-refresh-buffer (&optional show-filepath)
   "Refresh buffer."
   (interactive)
-  (message "refreshing buffer")
+  ;; (message "refreshing buffer") ;; useful to know when screen re-draws
+  (progn ; useful stuff to run every page draw
+    (if (not (photogal-photo-valid-for-committing? (photogal-current-file)))
+	(photogal-unmark-photo-for-copying (photogal-current-file))))
   (photogal-init (photogal-current-file) show-filepath)
   (photogal-generate-tag-commands)
   (beginning-of-buffer))
@@ -301,7 +383,7 @@ for all tags defined -- one function per tag."
 	       (photogal-current-file))))
 	(total-photos
 	 (length (photogal-all-photos *photogal/photos-origin-directory*))))
-    (insert "ur lookin at photo ")
+    (insert "  ur lookin at photo ")
     (photogal--insert-print-color current-index "red")
     (insert " of ")
     (photogal--insert-print-color total-photos "red")))
@@ -339,7 +421,7 @@ for all tags defined -- one function per tag."
 	(insert "\n"))
     (insert "[")
     (if activated
-	(photogal--insert-print-color key-to-type "SeaGreen2")
+	(photogal--insert-print-color key-to-type "SeaGreen3")
       (photogal--insert-print-color key-to-type "dark gray"))
     (insert "] ")
     (photogal--insert-print-color name-of-command "blue" (- 16 (length key-to-type)))
@@ -369,6 +451,7 @@ the current file."
     `(defun ,my-funcname ()
        (interactive)
        (photogal-for-file-toggle-tag (photogal-current-file) ,(format "%s" name))
+       (photogal-mark-photo-for-copying (photogal-current-file))
        (photogal-refresh-buffer))))
 
 ;;;;  --  ----  --  -MOVING FILES AROUND-  --  ----  --  ;;;;
@@ -384,20 +467,18 @@ the current file."
 (defun photogal-files--new-file-name-for-photo (filepath tags name)
   (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")
-      "-"
-      name
-      "-_"
-      (string-join tags "_")
-      "_"
-      ))
-    (file-name-extension filepath))))
+   (let (( new-name (concat
+		     (photogal-files--generate-unique-identifier filepath)
+		     "-"
+		     (format-time-string "%M%H,%d%m%y")
+		     "-"
+		     name
+		     "-_"
+		     (string-join tags "_")
+		     "_")))
+     (if (file-name-extension filepath)
+	 (file-name-with-extension new-name (file-name-extension filepath))
+       new-name))))
 
 (defun photogal-files--new-filenames-for-photos ()
   (mapcar
@@ -408,27 +489,32 @@ the current file."
        (photogal-files--new-file-name-for-photo filepath tags name)))
    *photogal/operating-table*))
 
-(defun photogal-restart ()
-  (setq *photogal/all-photos* (photogal-all-photos *photogal/photos-origin-directory*))
-  (photogal-init-operating-table)
-  (photogal-init (photogal-current-file)))
-
 (defun photogal-compile-and-commit ()
   (interactive)
   (if (y-or-n-p (format  "Are u sure? "))
-      (progn
-	(make-directory *photogal/operating-photo-dir* 'parents)
-	(mapcar
-	 (lambda (file-rename)
-	   (let ((origin (car file-rename))
-		 (destination (cdr file-rename)))
-	     (when (or (photogal-get-tags-for-file origin)
-		       (photogal-get-name-for-file origin))
-	       (rename-file origin destination))))
-	 (photogal-files--new-filenames-for-photos))
-	(photogal-restart))
+      (photogal-heavy-move-files-to-directory)
     (message "whoops")))
 
+(defun photogal-heavy-move-files-to-directory ()
+  ;; THIS DOES A LOTTA SHIT!!!
+  (defun rename-file-to-folders (file-rename)
+    (let ((origin (car file-rename))
+	  (new-name (cdr file-rename)))
+      (when (photogal-photo-valid-for-committing? origin)
+	(let ((dest-dirs (photogal-get-folders-for-file origin)))
+	  (mapcar (lambda (directory)
+		    (make-directory directory 'parents)
+		    (let ((new-file-name (expand-file-name new-name directory)))
+		      (message (format "renaming %s to %s" origin new-file-name))
+		      (copy-file origin new-file-name)))
+		  dest-dirs)
+	  (delete-file origin)))))
+  (let* ((new-names (photogal-files--new-filenames-for-photos)))
+    (mapcar
+     #'rename-file-to-folders
+     new-names)
+    (photogal-restart)))
+
 ;;;;  --  ----  --  -   KEY BINDINGS    -  --  ----  --  ;;;;
 
 (defvar photogal-mode-map nil "Keymap for `photogal-mode`")
@@ -446,7 +532,8 @@ the current file."
   (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-key photogal-mode-map (kbd "N") 'photogal-name-the-file))
+  (define-key photogal-mode-map (kbd "N") 'photogal-name-the-file)
+  (define-key photogal-mode-map (kbd "O") 'photogal-give-a-folder))
 
 (define-derived-mode photogal-mode text-mode "photogal"
   "Major mode for grouping and labeling images.")

test-photogal.el

@@ -3,14 +3,14 @@
 (load "/Users/jwd/code/photo-gal/photogal.el")
 
 (setq photogaltest-example-operating-table
-      '(("/Photos/comp.png"
-	 (nil nil))
-	("/Photos/e06de5-5501,240622--_art_computer_good_meme_photography_politics_portrait_reaction-photo_screenshot_selfie_.png"
-	 (nil nil))
-	("/Photos/e99e1a-5501,240622-como-_art_cityscape_computer_family_meme_politics_reaction-photo_screenshot_selfie_.jpg"
-	 (nil nil))
-	("/Photos/rsf.png"
-	 (nil nil))))
+      '((filepath "/Photos/comp.png"
+	 tags nil name nil folders nil)
+	(filepath "/Photos/e06de5-5501,240622--_art_computer_good_meme_photography_politics_portrait_reaction-photo_screenshot_selfie_.png"
+	 tags nil name nil folders nil)
+	(filepath "/Photos/e99e1a-5501,240622-como-_art_cityscape_computer_family_meme_politics_reaction-photo_screenshot_selfie_.jpg"
+	 tags nil name nil folders)
+	(filepath "/Photos/rsf.png"
+	 tags nil name nil folders nil)))
 
 (ert-deftest file-properties-test ()
 
@@ -36,17 +36,20 @@
     (should (eq (photogal-get-tags-for-file "/Photos/comp.png")
 		'()))))
 
+(defvar *photogal/operating-photo-dir* nil)
 
 
-(ert-deftest folder-sorting-test ()
+(ert-deftest destination-folder-test ()
 
   (let
       ((*photogal/operating-table*
 	photogaltest-example-operating-table))
 
-    (should (eq (photogal-get-folder-for-file "/Photos/comp.png")
-		""))
-
-    ))
+    (should (eq (photogal-get-folders-for-file "/Photos/comp.png")
+		'()))
 
+    (photogal-add-folder-for-file "/Photos/comp.png" "Trash")
 
+    (should (equal (photogal-get-folders-for-file "/Photos/comp.png")
+		   '("Trash")))
+    ))