|
|
@@ -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,14 +153,21 @@
|
|
|
(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 - -- ---- -- ;;;;
|
|
|
|
|
|
(defun photogal-make-photo (filepath)
|
|
|
`(filepath ,filepath
|
|
|
- tags ()
|
|
|
- name nil))
|
|
|
+ tags ,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.")
|
jordyn