|
|
@@ -0,0 +1,397 @@
|
|
|
+(defvar *photogal/photoreel* nil)
|
|
|
+(defvar *photogal/tags*
|
|
|
+ '(
|
|
|
+ ("e" . (name "spokane" ;; phg will not display
|
|
|
+ parent ("L" . (name "Location")))) ;; differences in the
|
|
|
+ ("n" . (name "new-york" ;; names of tag
|
|
|
+ parent ("L" . (name "Locution")))) ;; parents. they will be
|
|
|
+ ("e" . (name "emma-chamberlain" ;; considered the same.
|
|
|
+ parent ("C" . (name "Celebrity"))))
|
|
|
+ ("x" . (name "lil-nas-x"
|
|
|
+ parent ("C" . (name "Celebrity"))))
|
|
|
+
|
|
|
+ ("a" . (name "art"))
|
|
|
+ ("c" . (name "cityscape"))
|
|
|
+ ("f" . (name "family"))
|
|
|
+ ("g" . (name "good"))
|
|
|
+ ("h" . (name "screenshot"))
|
|
|
+ ("l" . (name "politics"))
|
|
|
+ ("m" . (name "meme"))
|
|
|
+ ("o" . (name "computer"))
|
|
|
+ ("p" . (name "portrait"))
|
|
|
+ ("r" . (name "reaction-photo"))
|
|
|
+ ("t" . (name "photography"))
|
|
|
+ ("s" . (name "selfie"))))
|
|
|
+
|
|
|
+(defcustom photogal-default-directory "/Users/jwd/bench/photos/"
|
|
|
+ "This is where photogal will look for photos.")
|
|
|
+
|
|
|
+
|
|
|
+(defun photogal-create-photo-roll (photo-dir)
|
|
|
+ (defun photogalroll--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 photogalroll--generate (destination-dir)
|
|
|
+ (mapcar (apply-partially #'photogalroll--make-photo-entry destination-dir)
|
|
|
+ (photogalroll--all-photos photo-dir)))
|
|
|
+
|
|
|
+ (let ((destination-dir (concat photo-dir "-photogal"))
|
|
|
+ (idx 0))
|
|
|
+ (mapcar (lambda (photo) (photogal--set-index photo (cl-incf idx)))
|
|
|
+ (photogalroll--generate destination-dir))))
|
|
|
+
|
|
|
+(defun photogal-current-file (photoreel)
|
|
|
+ "What is the file currently being operated on?"
|
|
|
+ (car photoreel))
|
|
|
+(defun photogal-advance-file (photoreel)
|
|
|
+ "Move forward by one photo."
|
|
|
+ (append (cdr photoreel) (list (car photoreel))))
|
|
|
+(defun photogal-rewind-file (photoreel)
|
|
|
+ "Reverse by one photo."
|
|
|
+ (append (last photoreel) (butlast photoreel)))
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+(defun photogal3 (photo-dir)
|
|
|
+ (interactive (list (read-directory-name
|
|
|
+ "where are ur photos? " photogal-default-directory)))
|
|
|
+ (setq *photogal/photoreel* (photogal-create-photo-roll photo-dir))
|
|
|
+ (photogal-render *photogal/photoreel* *photogal/tags*))
|
|
|
+
|
|
|
+(defun photogal-render (photoreel tags)
|
|
|
+ (photogal-draw-buffer photoreel "photogal3" tags))
|
|
|
+
|
|
|
+(defun photogal-refresh ()
|
|
|
+ (photogal-render *photogal/photoreel* *photogal/tags*))
|
|
|
+
|
|
|
+(defun photogal-tag-current-photo (tag)
|
|
|
+ (photogaltag-toggle tag (photogal-current-file *photogal/photoreel*)))
|
|
|
+
|
|
|
+
|
|
|
+(defun photogaltag-tags= (tag1 tag2)
|
|
|
+ ;; tags are equal ONLY when their keys are the same
|
|
|
+ (string= (photogal-tag-key tag1) (photogal-tag-key tag2)))
|
|
|
+
|
|
|
+(defun photogaltag-tags< (tag1 tag2)
|
|
|
+ (string< (photogal-tag-key tag1) (photogal-tag-key tag2)))
|
|
|
+
|
|
|
+(defun photogaltag-is-parent (tag)
|
|
|
+ ;; 91 is '[', right after 'Z' in the ascii table
|
|
|
+ (< (string-to-char (photogal-tag-key tag))
|
|
|
+ 91))
|
|
|
+
|
|
|
+(defun photogaltag-is-parent-or-child (mytag)
|
|
|
+ (or (photogaltag-is-parent mytag)
|
|
|
+ (photogal-tag-parent mytag)))
|
|
|
+
|
|
|
+(defun photogaltag-add-tag (tag photo)
|
|
|
+ (let ((tags (photogal--get-tags photo)))
|
|
|
+ (photogal--set-tags
|
|
|
+ photo
|
|
|
+ (seq-sort #'photogaltag-tags<
|
|
|
+ (seq-uniq (cons tag tags) #'photogaltag-tags=)))))
|
|
|
+
|
|
|
+(defun photogaltag-rm-tag (tag photo)
|
|
|
+ (photogal--set-tags
|
|
|
+ photo
|
|
|
+ (seq-remove (apply-partially #'photogaltag-tags= tag)
|
|
|
+ (photogal--get-tags photo))))
|
|
|
+
|
|
|
+(defun photogaltag-has-tag-p (tag photo)
|
|
|
+ (seq-contains-p (photogal--get-tags photo)
|
|
|
+ tag
|
|
|
+ #'photogaltag-tags=))
|
|
|
+
|
|
|
+(defun collapse-tag (tag)
|
|
|
+ (let* ((parent (photogal-tag-parent tag))
|
|
|
+ (parent-key (photogal-tag-key parent))
|
|
|
+ (parent-name (photogal-tag-name parent))
|
|
|
+ (child-name (photogal-tag-name tag))
|
|
|
+ (child-key (photogal-tag-key tag)))
|
|
|
+ (list child-key 'name (concat child-name parent-name))))
|
|
|
+
|
|
|
+(defun photogaltag-toggle (tag photo)
|
|
|
+ "If a photo has the tag, remove it. If it doesn't have it, add it."
|
|
|
+
|
|
|
+ (if (photogaltag-has-tag-p tag photo)
|
|
|
+ (photogaltag-rm-tag tag photo)
|
|
|
+ (photogaltag-add-tag tag photo)))
|
|
|
+
|
|
|
+;; // PHOTO DATAOBJECT \\ ;;
|
|
|
+(defun photogalroll--make-photo-entry (destination-dir filepath)
|
|
|
+ `(filepath ,filepath
|
|
|
+ tags ,nil
|
|
|
+ name ,nil
|
|
|
+ folders ,(list destination-dir)
|
|
|
+ copy-to-dir ,nil
|
|
|
+ index ,-1
|
|
|
+ ))
|
|
|
+(defun photogal--get-filepath (photo)
|
|
|
+ (plist-get photo 'filepath))
|
|
|
+(defun photogal--get-tags (photo)
|
|
|
+ "What are all the tags for this file?"
|
|
|
+ (plist-get photo 'tags))
|
|
|
+(defun photogal--set-tags (photo tags)
|
|
|
+ (plist-put photo 'tags
|
|
|
+ tags))
|
|
|
+(defun photogal--get-folders (photo)
|
|
|
+ "What are all the folders for this file?"
|
|
|
+ (plist-get photo 'folders))
|
|
|
+(defun photogal--set-folders (photo folders)
|
|
|
+ (plist-put photo 'folders
|
|
|
+ folders))
|
|
|
+(defun photogal--get-index (photo)
|
|
|
+ (plist-get photo 'index))
|
|
|
+(defun photogal--set-index (photo index)
|
|
|
+ (plist-put photo 'index
|
|
|
+ index))
|
|
|
+(defun photogal--get-copy-to-dir? (photo)
|
|
|
+ (plist-get photo 'copy-to-dir))
|
|
|
+(defun photogal--set-copy-to-dir? (photo copy-to-dir)
|
|
|
+ (plist-put photo 'copy-to-dir
|
|
|
+ copy-to-dir))
|
|
|
+;; \\ // ;;
|
|
|
+
|
|
|
+
|
|
|
+(defun photogal-engage-keys-for-tags (tags)
|
|
|
+ (mapcar (lambda (tag)
|
|
|
+ (let ((key (photogal-tag-key tag)))
|
|
|
+ (eval `(define-key photogal3-mode-map (kbd ,key)
|
|
|
+ (lambda () (interactive)
|
|
|
+ (photogal-tag-current-photo ',tag)
|
|
|
+ (photogal-refresh))))
|
|
|
+ ))
|
|
|
+ tags))
|
|
|
+
|
|
|
+(defun photogal-engage-keys-for-parents (parent-tags)
|
|
|
+ (mapcar (lambda (tag)
|
|
|
+ (let ((key (photogal-tag-key tag)))
|
|
|
+ (eval `(define-key photogal3-mode-map (kbd ,key)
|
|
|
+ (lambda () (interactive)
|
|
|
+ (photogal-tag-family ',tag)
|
|
|
+ ;; (photogal-refresh)
|
|
|
+ )))
|
|
|
+ ))
|
|
|
+ parent-tags))
|
|
|
+
|
|
|
+(defun photogal-tag-family (parent-tag)
|
|
|
+ (photogal-render
|
|
|
+ *photogal/photoreel*
|
|
|
+ (mapcar #'collapse-tag
|
|
|
+ (photogal-child-tags-belonging-to parent-tag *photogal/tags*))))
|
|
|
+
|
|
|
+
|
|
|
+;; //////////////// |||||||||||||||| //////////////// ;;
|
|
|
+;; ^^^^ ^^^^ ^^^^ work zone ^^^^ ^^^^ ^^^^
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+(defun photogaldraw-activate-key-commands (active-tags)
|
|
|
+
|
|
|
+ (photogal-engage-keys-for-tags (photogal-tags-with-no-parents active-tags))
|
|
|
+
|
|
|
+ (photogal-engage-keys-for-parents (photogal-all-parents *photogal/tags*))
|
|
|
+
|
|
|
+ (mapcar (lambda (key-command)
|
|
|
+ (let ((key (car key-command))
|
|
|
+ (function (cadr key-command))
|
|
|
+ (info-message (caddr key-command))
|
|
|
+ (display (cadddr key-command)))
|
|
|
+ (eval
|
|
|
+ `(define-key photogal3-mode-map (kbd ,key)
|
|
|
+ (lambda () (interactive)
|
|
|
+ (message ,info-message)
|
|
|
+ (funcall #',function))))))
|
|
|
+ key-commands)
|
|
|
+ )
|
|
|
+
|
|
|
+(defun photogaldraw-index-tracker (photoreel)
|
|
|
+ (let* ((current-file (photogal-current-file photoreel))
|
|
|
+ (current-index (photogal--get-index current-file))
|
|
|
+ (total-photos (length photoreel)))
|
|
|
+ (insert " ur lookin at photo ")
|
|
|
+ (photogal--insert-print-color current-index "red")
|
|
|
+ (insert " of ")
|
|
|
+ (photogal--insert-print-color total-photos "red")))
|
|
|
+
|
|
|
+(defun photogaldraw--commit-message (photo)
|
|
|
+ (if (photogal--get-copy-to-dir? photo)
|
|
|
+ (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"))))
|
|
|
+
|
|
|
+(defun photogaldraw--insert-image (filepath)
|
|
|
+ (insert " ")
|
|
|
+ (insert-image
|
|
|
+ (if resize-image
|
|
|
+ (create-image filepath 'imagemagick nil
|
|
|
+ :width (- (window-pixel-width) 75))
|
|
|
+ (create-image filepath 'imagemagick nil
|
|
|
+ :height (/ (window-pixel-height) 2)))))
|
|
|
+
|
|
|
+(defun photogaldraw--insert-photo-tags (photo)
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (insert "Current tags: ")
|
|
|
+ (insert (format "%s"
|
|
|
+ (mapcar #'photogal-tag-name (photogal--get-tags photo))))
|
|
|
+ (photogaldraw--newline))
|
|
|
+
|
|
|
+(defun photogaldraw--insert-tags (tags photo)
|
|
|
+ (photogal--insert-print-color "Tag:\n" "red")
|
|
|
+ (mapcar (lambda (tag)
|
|
|
+ (let* ((key-command (photogal-tag-key tag))
|
|
|
+ (tag-name (photogal-tag-name tag))
|
|
|
+ (activated (photogaltag-has-tag-p tag photo)))
|
|
|
+ (photogal--pprint-key-command key-command tag-name 16 activated)))
|
|
|
+ tags))
|
|
|
+
|
|
|
+(defun photogaldraw--insert-commands-to-buffer (commands)
|
|
|
+ "Pretty print the commands with their invoke key."
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (photogal--insert-print-color "Commands:" "red")
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (mapcar (lambda (command)
|
|
|
+ (let ((key-command (car command))
|
|
|
+ (display-copy (caddr command)))
|
|
|
+ (when display-copy ;; only show command if it has description
|
|
|
+ (photogal--pprint-key-command key-command display-copy 16))))
|
|
|
+ commands))
|
|
|
+
|
|
|
+(defun photogaldraw--newline ()
|
|
|
+ (insert "\n"))
|
|
|
+
|
|
|
+(defun photogal--pprint-key-command (key-to-type name-of-command padding &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 "SeaGreen3")
|
|
|
+ (photogal--insert-print-color key-to-type "dark gray"))
|
|
|
+ (insert "] ")
|
|
|
+ (photogal--insert-print-color name-of-command "blue" (- padding (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))))
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+(defun photogal-draw-buffer (photoreel buffer tags)
|
|
|
+ (let* ((current-photo (photogal-current-file photoreel))
|
|
|
+ (resize-image nil)
|
|
|
+ (photo-file-path (photogal--get-filepath current-photo))
|
|
|
+ (buf (get-buffer-create buffer))
|
|
|
+ (display-tags (photogal-top-level-tags tags)))
|
|
|
+ (with-current-buffer buf
|
|
|
+ (photogal3-mode)
|
|
|
+
|
|
|
+ (erase-buffer)
|
|
|
+
|
|
|
+ (photogaldraw-index-tracker photoreel)
|
|
|
+ (photogaldraw--commit-message current-photo)
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (photogaldraw--insert-image (photogal--get-filepath current-photo))
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (photogaldraw--insert-photo-tags current-photo)
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (photogaldraw--insert-tags display-tags current-photo)
|
|
|
+ (photogaldraw--newline)
|
|
|
+ (photogaldraw--insert-commands-to-buffer key-commands)
|
|
|
+
|
|
|
+
|
|
|
+ (switch-to-buffer buf)
|
|
|
+ (photogaldraw-activate-key-commands tags))))
|
|
|
+
|
|
|
+(defvar key-commands
|
|
|
+ '(
|
|
|
+ ("RET" photogal-next-file "next")
|
|
|
+ ("<right>" photogal-next-file nil)
|
|
|
+ ("SPC" photogal-next-file nil )
|
|
|
+ ("C-p" photogal-prev-file "prev")
|
|
|
+ ("<left>" photogal-prev-file nil)
|
|
|
+ ;; ("C-a" . photogal-add-tag)
|
|
|
+ ;; ("C-d" . photogal-delete-tag)
|
|
|
+ ;; ("C-f" . photogal-show-filepath)
|
|
|
+ ;; ("C-r" . photogal-resize-photo)
|
|
|
+ ;; ("C-c" . photogal-compile-and-commit)
|
|
|
+ ;; ("C-n" . photogal-name-the-file)
|
|
|
+ ;; ("C-o" . photogal-give-a-folder)
|
|
|
+ ("C-g" photogal-refresh "redraw buffer!")
|
|
|
+ ))
|
|
|
+
|
|
|
+(defun photogal-next-file ()
|
|
|
+ "Advance by one photo."
|
|
|
+ (interactive)
|
|
|
+ (setq *photogal/photoreel* (photogal-advance-file *photogal/photoreel*))
|
|
|
+ (photogal-render *photogal/photoreel* *photogal/tags*))
|
|
|
+
|
|
|
+(defun photogal-prev-file ()
|
|
|
+ "Reverse by one photo."
|
|
|
+ (interactive)
|
|
|
+ (setq *photogal/photoreel*
|
|
|
+ (append (last *photogal/photoreel*) (butlast *photogal/photoreel*)))
|
|
|
+ (photogal-render *photogal/photoreel* *photogal/tags*))
|
|
|
+
|
|
|
+
|
|
|
+;; // tag shit
|
|
|
+
|
|
|
+(defun photogal-all-parents (tags)
|
|
|
+ (seq-filter (lambda (x) x)
|
|
|
+ (seq-uniq (mapcar (lambda (tag) (plist-get (cdr tag) 'parent)) tags)
|
|
|
+ (lambda (a b) (string= (car a) (car b))))))
|
|
|
+(defun photogal-child-tags-belonging-to (parent tags)
|
|
|
+ (seq-filter
|
|
|
+ (lambda (tag)
|
|
|
+ (photogaltag-tags= parent (photogal-tag-parent tag)))
|
|
|
+ tags))
|
|
|
+
|
|
|
+(defun photogal-tags-with-parents (tags)
|
|
|
+ (seq-filter (lambda (tag) (plist-member (cdr tag) 'parent))
|
|
|
+ *photogal/tags*))
|
|
|
+(defun photogal-tags-with-no-parents (tags)
|
|
|
+ (seq-remove (lambda (tag) (plist-member (cdr tag) 'parent)) tags))
|
|
|
+(defun photogal-top-level-tags (tags)
|
|
|
+ (append (photogal-all-parents tags)
|
|
|
+ (photogal-tags-with-no-parents tags)))
|
|
|
+
|
|
|
+(defun photogal-tag-name (tag)
|
|
|
+ (plist-get (cdr tag) 'name))
|
|
|
+(defun photogal-tag-parent (tag)
|
|
|
+ (plist-get (cdr tag) 'parent))
|
|
|
+(defun photogal-tag-key (tag)
|
|
|
+ (car tag))
|
|
|
+
|
|
|
+
|
|
|
+(defvar photogal3-mode-map nil "Keymap for `photogal-mode`")
|
|
|
+;; (setq photogal3-mode-map nil)
|
|
|
+;; (setq photogal3-mode-map (make-sparse-keymap))
|
|
|
+(define-derived-mode photogal3-mode text-mode "photogal3"
|
|
|
+ "Major mode for grouping and labeling images.")
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+;; (progn
|
|
|
+;; (setq photogal-mode-map (make-sparse-keymap))
|
|
|
+;; (map-do (lambda (key command)
|
|
|
+;; (eval `(define-key photogal-mode-map (kbd ,key) ',command)))
|
|
|
+;; key-commands))
|
jordyn