Просмотр исходного кода

gal is complete, with major and minor features confirmed to function

jordyn 2 лет назад
Родитель
Сommit
9745755ba7
2 измененных файлов с 121 добавлено и 48 удалено
  1. 19 0
      changelog
  2. 102 48
      photogal.el

+ 19 - 0
changelog

@@ -0,0 +1,19 @@
+v1.1 ~ ...
+
+     can insert a custom "name" to the file
+
+     MOVES files to destination directory
+
+     doesn't copy files that have no tags or no name
+
+     define data by interface of getters and setters,
+     decoupling the app from its internal data structure
+
+
+v1.0 ~ Jun 23 2022; - jordyn: spokane valley, wa
+
+     works! can page thru photos and add tags to them :()
+
+     can also add new tags, or delete existing ones.
+
+     renames and copies the files to destination directory

+ 102 - 48
photogal.el

@@ -24,6 +24,7 @@
 (defvar *photogal/all-photos* nil)
 (defvar *photogal/operating-table* nil)
 (defvar *photogal/--resize-photo* nil)
+(defvar *photogal/photos-origin-directory* nil)
 (defvar *photogal/commands*
   '(("RET" . "Next")
     ("P" . "Prev")
@@ -32,7 +33,8 @@
     ("F" . "Show filename")
     ("G" . "Refresh buffer")
     ("R" . "Resize photo")
-    ("C" . "Compile and commit")))
+    ("C" . "Compile and commit")
+    ("N" . "Name the file")))
 
 (defcustom photogal-default-directory "/Users/jwd/bench/photos/"
   "This is where photogal will look for photos.")
@@ -50,7 +52,48 @@
     ("r" . "reaction-photo")
     ("t" . "photography")
     ("s" . "selfie"))
-    "These are photo tags and the key to activate them.")
+    "Tags and key-command to associate to photos.")
+
+(defun photogal-get-tags-for-file (photo-filepath)
+  "what tags does this file have?"
+  (photogal--get-tags (photogal--lookup-photo photo-filepath)))
+(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-name-for-file (photo-filepath)
+  "does this file have a user-given name?"
+  (photogal--get-name (photogal--lookup-photo photo-filepath)))
+(defun photogal-set-name-for-file (photo-filepath name)
+  "give this file a Proper name. (embedded in final filename) (optional)"
+  (photogal--set-name (photogal--lookup-photo photo-filepath) name))
+
+;; //             internal           \\ ;;
+(defun photogal--get-filepath (photo)
+  (car photo))
+(defun photogal--lookup-photo (photo-filepath)
+  (assoc photo-filepath *photogal/operating-table*))
+(defun photogal--get-tags (photo)
+  "What are all the tags for this file?"
+  (caadr photo))
+(defun photogal--set-tags (photo tags)
+  (setcar (cadr photo)
+	  tags))
+(defun photogal--get-name (photo)
+  (cadadr photo))
+(defun photogal--set-name (photo name)
+  (setcar (cdadr photo)
+	  name))
+;; \\             internal           // ;;
+
+(defun photogal-advance-photo ()
+  "Move forward by one photo."
+  (setq *photogal/all-photos*
+	(append (cdr *photogal/all-photos*) (list (car *photogal/all-photos*)))))
+
+(defun photogal-rewind-photo ()
+  "Reverse by one photo."
+  (setq *photogal/all-photos*
+	(append (last *photogal/all-photos*) (butlast *photogal/all-photos*))))
 
 
 ;;;;  --  ----  --  -      THE APP      -  --  ----  --  ;;;;
@@ -61,10 +104,10 @@
   (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)))
+  (setq *photogal/photos-origin-directory* (directory-file-name photo-dir))
+  (setq *photogal/operating-photo-dir* (concat *photogal/photos-origin-directory* "-photogal"))
+  (setq *photogal/all-photos* (photogal-all-photos *photogal/photos-origin-directory*))
+  (photogal-init (photogal-current-file))
   (photogal-init-operating-table)
   (photogal-generate-tag-commands))
 
@@ -75,7 +118,8 @@
 (defun photogal-init-operating-table ()
   (setq *photogal/operating-table*
 	(mapcar (lambda (photo)
-		  (cons '() photo))
+		  ;; '(old-file-path (tags optional-name))
+		  (list photo (list '() nil)))
 		*photogal/all-photos*)))
 
 (defun photogal-generate-tag-commands ()
@@ -92,6 +136,7 @@ for all tags defined -- one function per tag."
 ;;;;  --  ----  --  -        TAG        -  --  ----  --  ;;;;
 
 (defun photogal-add-tag (new-tag new-tag-code)
+  "Add a user-generated tag to the tag library."
   (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)))
@@ -101,6 +146,7 @@ for all tags defined -- one function per tag."
       (photogal--add-tag new-tag new-tag-code))))
 
 (defun photogal-delete-tag (tag-code)
+  "Remove a tag from the library."
   (interactive "sDelete tag: ")
   (customize-save-variable
    'photogal/tags
@@ -108,6 +154,7 @@ for all tags defined -- one function per tag."
   (photogal-refresh-buffer))
 
 (defun photogal--add-tag (new-tag new-tag-code)
+  "Modify the defcustom var to the new collection of tags."
   (let ((escaped-str-tag (string-replace " " "-" new-tag)))
     (customize-save-variable
      'photogal/tags
@@ -120,10 +167,6 @@ for all tags defined -- one function per tag."
    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)
@@ -134,9 +177,16 @@ for all tags defined -- one function per tag."
 
 (defun photogal-add-tag-to-file (file tag)
   "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))))))
+  (let ((tags (photogal-get-tags-for-file file)))
+    (photogal-set-tags-for-file file
+		       (seq-sort #'string< (seq-uniq (cons tag tags))))))
+
+(defun photogal-name-the-file (name)
+  (interactive "sWhat do u want to name this file? ")
+  (photogal-set-name-for-file
+   (photogal-current-file)
+   (string-replace " " "-"  name))
+  (photogal-refresh-buffer))
 
 (defun photogal-rm-tag-from-file (file tag)
   "Dissociate tag from file."
@@ -146,20 +196,15 @@ for all tags defined -- one function per tag."
      (seq-uniq
       (seq-remove
        (lambda (tg) (string= tg tag)) tags))))
-  (let ((tags (photogal-tags-for-file file)))
-    (setcar (rassoc file *photogal/operating-table*)
+  (let ((tags (photogal-get-tags-for-file file)))
+    (photogal-set-tags-for-file file
 	    (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)))
+  (let ((tags (photogal-get-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*)))
-
-
 ;;;;  --  ----  --  -      FILE OPS     -  --  ----  --  ;;;;
 
 (defun photogal-all-photos (directory)
@@ -171,8 +216,6 @@ for all tags defined -- one function per tag."
   "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."
@@ -190,6 +233,9 @@ for all tags defined -- one function per tag."
 		       :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)
+	  (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")
       (photogal-insert-tags-to-buffer photogal/tags)
@@ -198,20 +244,17 @@ for all tags defined -- one function per tag."
        *photogal/commands*)
       (when show-filepath
 	(insert "\n\n")
-	(insert (photogal-current-file)))
-      )
+	(insert (photogal-current-file))))
     (switch-to-buffer buf)))
 
 (defun photogal-next-file ()
   (interactive)
-  (setq *photogal/all-photos*
-	(append (cdr *photogal/all-photos*) (list (car *photogal/all-photos*))))
+  (photogal-advance-photo)
   (photogal-refresh-buffer))
 
 (defun photogal-prev-file ()
   (interactive)
-  (setq *photogal/all-photos*
-	(append (last *photogal/all-photos*) (butlast *photogal/all-photos*)))
+  (photogal-rewind-photo)
   (photogal-refresh-buffer))
 
 (defun photogal-refresh-buffer (&optional show-filepath)
@@ -231,6 +274,8 @@ for all tags defined -- one function per tag."
   (interactive)
   (photogal-refresh-buffer t))
 
+;;;;  --  ----  --  - LO-LEVEL DISPLAY  -  --  ----  --  ;;;;
+
 (defun photogal-insert-tags-to-buffer (tags)
   "Pretty print the tags with their toggle key."
   (mapcar (lambda (tag)
@@ -248,7 +293,6 @@ for all tags defined -- one function per tag."
 	      (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)))
@@ -274,7 +318,6 @@ for all tags defined -- one function per tag."
     (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)
@@ -289,10 +332,8 @@ the current file."
        (photogal-for-file-toggle-tag (photogal-current-file) ,(format "%s" name))
        (photogal-refresh-buffer))))
 
-
 ;;;;  --  ----  --  -MOVING FILES AROUND-  --  ----  --  ;;;;
 
-
 (defun photogal-files--get-extension (filepath)
   (file-name-extension filepath))
 
@@ -301,7 +342,7 @@ the current file."
   (seq-take (md5 (concat (current-time-string) filepath))
 	    6))
 
-(defun photogal-files--new-file-name-for-photo (filepath tags)
+(defun photogal-files--new-file-name-for-photo (filepath tags name)
   (cons
    filepath
    (file-name-with-extension
@@ -311,32 +352,44 @@ the current file."
       (photogal-files--generate-unique-identifier filepath)
       "-"
       (format-time-string "%M%H,%d%m%y")
-      "_"
+      "-"
+      name
+      "-_"
       (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)))
+     (let ((filepath (photogal--get-filepath photo))
+	   (tags (photogal--get-tags photo))
+	   (name (photogal--get-name photo)))
+       (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? "))
-    (mapcar
-     (lambda (file-rename)
-       (let ((origin (car file-rename))
-	     (destination (cdr file-rename)))
-	 (copy-file origin destination)))
-     (photogal-files--new-filenames-for-photos))
+      (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))
     (message "whoops")))
 
-
-
 ;;;;  --  ----  --  -   KEY BINDINGS    -  --  ----  --  ;;;;
 
 (defvar photogal-mode-map nil "Keymap for `photogal-mode`")
@@ -352,7 +405,8 @@ the current file."
   (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-key photogal-mode-map (kbd "C") 'photogal-compile-and-commit)
+  (define-key photogal-mode-map (kbd "N") 'photogal-name-the-file))
 
 (define-derived-mode photogal-mode text-mode "photogal"
   "Major mode for grouping and labeling images.")