|
@@ -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.")
|