;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;; PHOTOGAL ;;;;;;;;;;;;;;;;;;;;;`;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; v1.1 ;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;,;;;;;;;;;*;;;
;; ` ;;
;; author: jordyn , - * ;;
;; authored: spokane valley, summer '22 . ` ;;
;; * ^ ~ ';
;; PHOTO * , ' . ` * , ;;
;; , Grouper ' ` . * - . ;;
;; . And , ^ ' . ' . ` ` ' ;;
;; ` Labeler ' , * ' * ;;
;; , . , ` ' . ` ;;
;; ' - ' , ^ ;;
;; . > ` ' ;;
;; V , _ ;;
;; ' ;;
;; ` - ;;
;; ^ ;;
;; O ;;
;; ;;
;; x ;;
;; * ;;
;; ;;
;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-derived-mode photogal-mode text-mode "photogal"
"Major mode for grouping and labeling images.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun photogal (photo-dir)
"Start PHOTOGAL!"
(interactive (list (read-directory-name
"where are ur photos? " photogal-default-directory)))
(setq photogal-photo-dir photo-dir)
(setq *photogal/photoreel* (photogal-create-photo-roll photogal-photo-dir))
(setq photogal-mode-map (make-sparse-keymap))
(photogal-engage))
(defun photogal-engage ()
"Puts everything in order for the current configuration and state."
(interactive)
(photogal-render *photogal/photoreel* *photogal/tags*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; || || || << GRAPHICS >> || || || ;;
;; -- -- -- ------------- -- -- -- ;;
;; -- -- functions that render and draw -- -- ;;
;; -- -- in the buffer -- -- ;;
;; -- -- -- ------------- -- -- -- ;;
;; / / / \ \ \ ;;
(defun photogal-render (photoreel tags &optional show-filepath)
(photogal-draw-buffer photoreel "photogal" tags show-filepath))
(defun photogal-draw-buffer (photoreel buffer tags show-filepath)
(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 (photogaltag-top-level-tags tags)))
(with-current-buffer buf
(photogal-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--insert-folders current-photo)
(photogaldraw--insert-photo-name current-photo)
(photogaldraw--newline)
(photogaldraw--newline)
(photogaldraw--insert-tags display-tags current-photo)
(photogaldraw--newline)
(photogaldraw--insert-commands-to-buffer photogal-user-actions)
(photogaldraw--insert-filepath show-filepath current-photo)
(switch-to-buffer buf)
(photogal-activate-user-actions tags))))
(defun photogaldraw--insert-filepath (show-filepath current-photo)
(when show-filepath
(insert "\n\n")
(insert (photogal--get-filepath current-photo))))
(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 ")
(photogaldraw--insert-print-color current-index "red")
(insert " of ")
(photogaldraw--insert-print-color total-photos "red")))
(defun photogaldraw--commit-message (photo)
(if (photogal-photo-valid-for-committing-p photo)
(progn
(insert "\t\t\t\t will commit?: ")
(photogaldraw--insert-print-color "✓" "SeaGreen3"))
(progn
(insert "\t\t\t\t will commit?: ")
(photogaldraw--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 #'photogaltag-tag-name (photogal--get-tags photo)))))
(defun photogaldraw--insert-folders (photo)
(when (photogal--get-folders photo)
(photogaldraw--newline)
(photogaldraw--insert-print-color
(format "\ndest dir: %s"
(photogal--get-folders photo))
"light gray")))
(defun photogaldraw--insert-photo-name (photo)
(if (photogal--get-name photo)
(insert (format "\nName: %s" (photogal--get-name photo)))))
(defun photogaldraw--insert-tags (tags photo)
(photogaldraw--insert-print-color "Tag:\n" "red")
(mapcar (lambda (tag)
(let* ((key-command (photogaltag-tag-key tag))
(tag-name (photogaltag-tag-name tag))
(activated (photogaltag-has-tag-p tag photo)))
(photogaldraw--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)
(photogaldraw--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
(photogaldraw--pprint-key-command key-command display-copy 16))))
commands))
(defun photogaldraw--newline ()
(insert "\n"))
(defun photogaldraw--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
(photogaldraw--insert-print-color key-to-type "SeaGreen3")
(photogaldraw--insert-print-color key-to-type "dark gray"))
(insert "] ")
(photogaldraw--insert-print-color name-of-command "blue" (- padding (length key-to-type)))
(insert " ")))
(defun photogaldraw--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))))
;; \ \ \ / / / ;;
;; -- -- -- ------------- -- -- -- ;;
;; || || || << GRAPHICS >> || || || ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; || || || << FILE OPS >> || || || ;;
;; -- -- -- ------------- -- -- -- ;;
;; -- -- shit that moves files around on -- -- ;;
;; -- -- ~ disk ~ -- -- ;;
;; -- -- -- ------------- -- -- -- ;;
;; / / / \ \ \ ;;
(defun photogal-add-folder-for-file (file folder)
"Append new folder for a file."
(let ((folders (photogal--get-folders file)))
(photogal--set-folders 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 *photogal/photoreel*) folder-name)
(photogal-render *photogal/photoreel* *photogal/tags*)))
(defun photogal-heavy-move-files-to-directory ()
;; THIS DOES A LOTTA SHIT!!!
(defun rename-file-to-folders (file-rename)
(let* ((photo (car file-rename))
(origin-filepath (photogal--get-filepath photo))
(new-name (cdr file-rename)))
(when (photogal-photo-valid-for-committing-p photo)
(let ((dest-dirs (photogal--get-folders photo)))
(mapcar (lambda (directory)
(make-directory directory 'parents)
(let ((new-file-name (expand-file-name new-name directory)))
(message (format "renaming %s to %s" origin-filepath new-file-name))
(copy-file origin-filepath new-file-name)))
dest-dirs)
(delete-file origin-filepath)))))
(let* ((new-names (photogal-files--new-filenames-for-photos)))
(mapcar
#'rename-file-to-folders
new-names)
(setq *photogal/photoreel* (photogal-create-photo-roll photogal-photo-dir))
(photogal-render *photogal/photoreel* *photogal/tags*)))
;; \ \ \ / / / ;;
;; -- -- -- ------------- -- -- -- ;;
;; || || || << FILE OPS >> || || || ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; || || || << TAGS >> || || || ;;
;; -- -- -- ------------- -- -- -- ;;
;; -- -- the tags that group the photos -- -- ;;
;; -- -- ~ the core user experience ~ -- -- ;;
;; -- -- -- ------------- -- -- -- ;;
;; / / / \ \ \ ;;
(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= (photogaltag-tag-key tag1) (photogaltag-tag-key tag2)))
(defun photogaltag-tags< (tag1 tag2)
(string< (photogaltag-tag-key tag1) (photogaltag-tag-key tag2)))
(defun photogaltag-is-parent (tag)
;; 91 is '[', right after 'Z' in the ascii table
(< (string-to-char (photogaltag-tag-key tag))
91))
(defun photogaltag-is-parent-or-child (mytag)
(or (photogaltag-is-parent mytag)
(photogaltag-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 photogaltag-tag-family (parent-tag)
(photogal-render
*photogal/photoreel*
(mapcar #'photogaltag-collapse-tag
(photogaltag-child-tags-belonging-to parent-tag *photogal/tags*))))
(defun photogaltag-collapse-tag (tag)
(let* ((parent (photogaltag-tag-parent tag))
(parent-key (photogaltag-tag-key parent))
(parent-name (photogaltag-tag-name parent))
(child-name (photogaltag-tag-name tag))
(child-key (photogaltag-tag-key tag)))
(list child-key 'name (concat child-name parent-name))))
(defun photogaltag-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 photogaltag-child-tags-belonging-to (parent tags)
(seq-filter
(lambda (tag)
(photogaltag-tags= parent (photogaltag-tag-parent tag)))
tags))
(defun photogaltag-tags-with-parents (tags)
(seq-filter (lambda (tag) (plist-member (cdr tag) 'parent))
*photogal/tags*))
(defun photogaltag-tags-with-no-parents (tags)
(seq-remove (lambda (tag) (plist-member (cdr tag) 'parent)) tags))
(defun photogaltag-top-level-tags (tags)
(append (photogaltag-all-parents tags)
(photogaltag-tags-with-no-parents tags)))
(defun photogaltag-tag-name (tag)
(plist-get (cdr tag) 'name))
(defun photogaltag-tag-parent (tag)
(plist-get (cdr tag) 'parent))
(defun photogaltag-tag-key (tag)
(car tag))
(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)))
;; \ \ \ / / / ;;
;; -- -- -- ------------- -- -- -- ;;
;; || || || << TAGS >> || || || ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; || || || << USER ACTIONS >> || || || ;;
;; -- -- -- ------------- -- -- -- ;;
;; -- -- the things a PHOTOGALer can do -- -- ;;
;; -- -- ~ assign tags, other metadata ~ -- -- ;;
;; -- -- -- ------------- -- -- -- ;;
;; / / / \ \ \ ;;
(defun photogal-activate-user-actions (active-tags)
(defun photogal-activate-user-action (key-command)
(let ((key (car key-command))
(function (cadr key-command))
(info-message (caddr key-command))
(display (cadddr key-command)))
(eval
`(define-key photogal-mode-map (kbd ,key)
',function))))
(photogal-engage-keys-for-tags (photogaltag-tags-with-no-parents active-tags))
(photogal-engage-keys-for-parents (photogaltag-all-parents *photogal/tags*))
(mapcar #'photogal-activate-user-action
photogal-user-actions))
(defun photogal-engage-keys-for-tags (tags)
(defun photogal-eval--define-key (tag)
(let ((key (photogaltag-tag-key tag)))
(eval `(define-key photogal-mode-map (kbd ,key)
(lambda () (interactive)
(photogal-tag-current-photo ',tag)
(photogal-engage))))))
(mapcar #'photogal-eval--define-key
tags))
(defun photogal-engage-keys-for-parents (parent-tags)
(defun photogal-eval--define-key--for-parent (tag)
(let ((key (photogaltag-tag-key tag)))
(eval `(define-key photogal-mode-map (kbd ,key)
(lambda () (interactive)
(photogaltag-tag-family ',tag))))))
(mapcar #'photogal-eval--define-key--for-parent
parent-tags))
(defvar photogal-user-actions
'(
("RET" photogal-next-file "next")
("" photogal-next-file nil)
("SPC" photogal-next-file nil )
("C-p" photogal-prev-file "prev")
("" photogal-prev-file nil)
;; ("C-a" . photogal-add-tag)
;; ("C-d" . photogal-delete-tag)
("C-f" photogal-show-filepath "show path")
;; ("C-r" . photogal-resize-photo)
("C-c" photogal-compile-and-commit "save/move photos")
("C-n" photogal-name-the-file "name the photo")
("C-o" photogal-give-a-folder "put in folder?")
("C-g" photogal-engage "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*))
(defun photogal-show-filepath ()
(interactive)
(photogal-render *photogal/photoreel* *photogal/tags* t))
(defun photogal-name-the-file (name)
(interactive "sWhat do u want to name this file? ")
(photogal--set-name
(photogal-current-file *photogal/photoreel*)
(let ((formatted-name (string-replace " " "-" name)))
(if (> (length formatted-name) 0)
formatted-name
nil)))
(photogal-render *photogal/photoreel* *photogal/tags*))
(defun photogal-compile-and-commit ()
(interactive)
(if (y-or-n-p (format "Are u sure? "))
(photogal-heavy-move-files-to-directory)
(message "whoops")))
;; \ \ \ / / / ;;
;; -- -- -- ------------- -- -- -- ;;
;; || || || << USER ACTIONS >> || || || ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; || || || << PHOTO DATAOBJ >> || || || ;;
;; -- -- -- ------------- -- -- -- ;;
;; -- -- the datastructure of a photo -- -- ;;
;; -- -- ~ a buncha data mushed together ~ -- -- ;;
;; -- -- -- ------------- -- -- -- ;;
;; / / / \ \ \ ;;
(defun photogal--make-photo-dataobject (destination-dir filepath)
"This is a photo -- its path on disk and all its PHOTOGAL metadata."
`(filepath ,filepath
tags ,nil
name ,nil
folders ,(list destination-dir)
copy-to-dir ,nil
index ,-1))
(defun photogal--get-filepath (photo)
"What is the filepath for this photo?"
(plist-get photo 'filepath))
(defun photogal--get-tags (photo)
"What are all the tags for this photo?"
(plist-get photo 'tags))
(defun photogal--set-tags (photo tags)
"These are all the tags for this photo."
(plist-put photo 'tags
tags))
(defun photogal--get-name (photo)
"What is the name for this photo?"
(plist-get photo 'name))
(defun photogal--set-name (photo name)
"This is the name for this photo."
(plist-put photo 'name
name))
(defun photogal--get-folders (photo)
"What are all the folders for this photo?"
(plist-get photo 'folders))
(defun photogal--set-folders (photo folders)
"These are all the folders for this photo."
(plist-put photo 'folders
folders))
(defun photogal--get-index (photo)
"What is the index of this photo?"
(plist-get photo 'index))
(defun photogal--set-index (photo index)
"This is the index of this photo."
(plist-put photo 'index
index))
(defun photogal--get-copy-to-dir? (photo)
"Should this photo be copied to the output directory?"
(plist-get photo 'copy-to-dir))
(defun photogal--set-copy-to-dir? (photo copy-to-dir)
"This photo should be copied to the output directory."
(plist-put photo 'copy-to-dir
copy-to-dir))
(defun photogal-photo-valid-for-committing-p (photo)
(let ((all-fields-for-photo
(mapcar (lambda (field) (plist-get photo
field))
'(tags name))))
(seq-some (lambda (field) (not (eq nil field)))
all-fields-for-photo)))
;; \ \ \ / / / ;;
;; -- -- -- ------------- -- -- -- ;;
;; || || || << PHOTO DATAOBJ >> || || || ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; || || || << STATE [EVIL!] >> || || || ;;
;; -- -- -- ------------- -- -- -- ;;
;; -- -- what is the state of data from -- -- ;;
;; -- -- ~ the user's perspective ~ -- -- ;;
;; -- -- -- ------------- -- -- -- ;;
;; / / / \ \ \ ;;
(defvar *photogal/photoreel* nil)
(defun photogal-create-photo-roll (photo-dir)
"Give me a list of all the photos in my operating directory."
(defun photogalroll--assemble (destination-dir)
(mapcar (apply-partially #'photogal--make-photo-dataobject destination-dir)
(photogalroll--all-photos photo-dir)))
(defun photogalroll--all-photos (directory)
(directory-files directory
t directory-files-no-dot-files-regexp))
(let ((destination-dir (concat (directory-file-name photo-dir) "-photogal"))
(idx 0))
(mapcar (lambda (photo) (photogal--set-index photo (cl-incf idx)))
(photogalroll--assemble 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)))
;; \ \ \ / / / ;;
;; -- -- -- ------------- -- -- -- ;;
;; || || || << STATE [EVIL!] >> || || || ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; || || || << CONFIGURATION >> || || || ;;
;; -- -- -- ------------- -- -- -- ;;
;; / / / \ \ \ ;;
(defcustom photogal-default-directory "/home/"
"This is where photogal will look for photos.")
(defvar photogal-mode-map nil "Keymap for `photogal-mode`")
(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 "Location")))) ;; parents. they will be
("e" . (name "emma-chamberlain" ;; considered the same.
parent ("C" . (name "Celebrity")))) ;; The file name will likely
("x" . (name "lil-nas-x" ;; take the typo
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"))))
;; \ \ \ / / / ;;
;; -- -- -- ------------- -- -- -- ;;
;; || || || << CONFIGURATION >> || || || ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun photogal-files--new-filenames-for-photos ()
(mapcar
(lambda (photo)
(let ((filepath (photogal--get-filepath photo))
(tags
(mapcar #'photogaltag-tag-name
(photogal--get-tags photo)))
(name (photogal--get-name photo)))
(photogal-files--new-file-name-for-photo photo filepath tags name)))
*photogal/photoreel*))
(defun photogal-files--new-file-name-for-photo (photo filepath tags name)
(cons
photo
(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--generate-unique-identifier (filepath)
"Not GUARANTEED unique, but probably unique enough for my purposes."
(seq-take (md5 (concat (current-time-string) filepath))
6))