3 Commits b92204a589 ... d03e50f2bb

Autore SHA1 Messaggio Data
  jordyn d03e50f2bb the new gal finds her feet 2 anni fa
  jordyn 0a97f87b63 a new gal emerges 2 anni fa
  jordyn 1069f4ab0d commands are like C-{_} 2 anni fa
2 ha cambiato i file con 552 aggiunte e 89 eliminazioni
  1. 155 89
      photogal.el
  2. 397 0
      photogal3.el

+ 155 - 89
photogal.el

@@ -1,4 +1,3 @@
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;    PHOTOGAL    ;;;;;;;;;;;;;;;;;;;;;`;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; v1.0 ;;;;;;
@@ -26,21 +25,28 @@
 (defvar *photogal/operating-table* nil)
 (defvar *photogal/--resize-photo* nil)
 (defvar *photogal/photos-origin-directory* nil)
-(defvar *photogal/commands*
-  '(("RET" . "Next")
-    ("P" . "Prev")
-    ("A" . "Add tag")
-    ("D" . "Delete tag")
-    ("F" . "Show filename")
-    ("G" . "Refresh buffer")
-    ("R" . "Resize photo")
-    ("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.")
 
+(photogal-add-tag "Location" "L")
+(defun photogal-generate-group-tagger (group-key group-name)
+  (let ((tags (caddr (assoc group-key photogal/group-tags))))
+    (map-do (lambda (key name)
+	      (photogal-add-tag (format "%s-%s" group-name name)
+				(format "%s%s" group-key key)))
+	    tags)))
+(photogal-generate-group-tagger "L" "Location")
+
+
+(defcustom photogal/group-tags
+  '(("L" . ("Location"
+	    (("b" . "new-york")
+	     ("d" . "seattle")
+	     ("e" . "spokane")))))
+  "tags in groups")
+
 (defcustom photogal/tags
   '(("a" . "art")
     ("c" . "cityscape")
@@ -56,6 +62,18 @@
     ("s" . "selfie"))
     "Tags and key-command to associate to photos.")
 
+(defvar *photogal/commands*
+  '(("RET" . "Next")
+    ("C-p" . "Prev")
+    ("C-a" . "Add tag")
+    ("C-d" . "Delete tag")
+    ("C-f" . "Show filename")
+    ("C-g" . "Refresh buffer")
+    ("C-r" . "Resize photo")
+    ("C-c" . "Commit all")
+    ("C-n" . "Name the file")
+    ("C-o" . "Add a dir")))
+
 (defun photogal-get-tags-for-file (photo-filepath)
   "what tags does this file have?"
   (photogal--get-tags (photogal--lookup-photo photo-filepath)))
@@ -77,6 +95,17 @@
   "give this file a Proper name. (embedded in final filename) (optional)"
   (photogal--set-name (photogal--lookup-photo photo-filepath) name))
 
+
+(defun photogal-mark-current-photo-for-copying ()
+  "toggle on to copy this file. Warning: marks file for committing."
+  (plist-put (photogal--lookup-photo (photogal-current-file))
+	     'copy-to-dir t))
+(defun photogal-unmark-current-photo-for-copying ()
+  "toggle on to NOT copy this file. Warning: will not commit file."
+  (plist-put (photogal--lookup-photo (photogal-current-file))
+	     'copy-to-dir nil))
+
+
 (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)
@@ -86,6 +115,7 @@
   (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)
@@ -151,7 +181,7 @@
   (setq *photogal/all-photos* (photogal-all-photos *photogal/photos-origin-directory*))
   (photogal-init (photogal-current-file))
   (photogal-init-operating-table)
-  (photogal-generate-tag-commands))
+  (photogal-generate-tag-commands (photogal-general-tag-list)))
 
 (defun photogal-restart ()
   (interactive)
@@ -210,23 +240,42 @@ for all tags defined -- one function per tag."
 (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
-     (cons (cons new-tag-code escaped-str-tag) photogal/tags)))
-  (photogal-generate-tag-commands))
+    ;; (customize-save-variable
+     ;; 'photogal/tags
+     ;; (cons (cons new-tag-code escaped-str-tag) photogal/tags)))
+    (photogal-generate-tag-commands (photogal-tags-including-families))))
 
 (defun photogal-tag-code-in-use (tag-code)
   (seq-contains-p
    photogal/tags tag-code
    (lambda (tag test) (string= (car tag) test))))
 
+(defun photogal-tag-name-in-use (tag)
+  (seq-contains-p
+   photogal/tags tag
+   (lambda (tag test) (string= (cdr tag) test))))
+
+(defun photogal-tags-including-families ()
+  ;; ugly lol
+  (append photogal/tags (mapcar (lambda (x) (cons (car x) (cadr x))) photogal/group-tags)))
+
+(defun photogal-general-tag-list ()
+  "alist of tags without depth (families are flattened)"
+  (mapcar (lambda (tag) (let* ((key-command (car tag))
+			       (tag-name (if (listp (cdr tag))
+					     (car (cdr tag))
+					   (cdr tag))))
+			  `(,key-command . ,tag-name)))
+          photogal/tags))
+
 ;;;;  --  ----  --  -   TAGGING FILES   -  --  ----  --  ;;;;
 
-(defun photogal-for-file-toggle-tag (file tag)
+(defun photogal-for-file-toggle-tag (tag)
   "If a file has the tag, remove it. If it doesn't have it, add it."
-  (if (photogal-file-has-tag? file tag)
-      (photogal-rm-tag-from-file file tag)
-    (photogal-add-tag-to-file file tag)))
+  (let ((file (current-file)))
+    (if (photogal-file-has-tag? file tag)
+	(photogal-rm-tag-from-file file tag)
+      (photogal-add-tag-to-file file tag))))
 
 (defun photogal-add-tag-to-file (file tag)
   "Append new tag for a file."
@@ -295,54 +344,54 @@ for all tags defined -- one function per tag."
   (let ((buf (get-buffer-create "photogal")))
     (with-current-buffer buf
       (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
-       (if *photogal/--resize-photo*
-	   (create-image photo-file-path 'imagemagick nil
-			 :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)))
-      (let ((padding "\n"))
-	(if (photogal-get-name-for-file photo-file-path)
-	  (insert (format  "\nName: %s" (photogal-get-name-for-file photo-file-path)))
-	  (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" "red")
-      (photogal-insert-commands-to-buffer
-       *photogal/commands*)
-      (when show-filepath
-	(insert "\n\n")
-	(insert (photogal-current-file))))
-    (switch-to-buffer buf)))
-
+      (photogal-draw-ui photo-file-path (photogal-tags-including-families))
+    (switch-to-buffer buf))))
+
+(defun photogal-draw-ui (photo-file-path tags)
+  (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
+   (if *photogal/--resize-photo*
+       (create-image photo-file-path 'imagemagick nil
+		     :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)))
+  (let ((padding "\n"))
+    (if (photogal-get-name-for-file photo-file-path)
+	(insert (format  "\nName: %s" (photogal-get-name-for-file photo-file-path)))
+      (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 tags)
+  (photogal--insert-print-color "\n\nCommands:\n" "red")
+  (photogal-insert-commands-to-buffer
+   *photogal/commands*)
+  (when show-filepath
+    (insert "\n\n")
+    (insert (photogal-current-file))))
+  
 (defun photogal-next-file ()
   (interactive)
   (photogal-advance-photo)
@@ -361,7 +410,7 @@ for all tags defined -- one function per tag."
     (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)
+  (photogal-generate-tag-commands (photogal-general-tag-list))
   (beginning-of-buffer))
 
 (defun photogal-resize-photo ()
@@ -401,7 +450,7 @@ for all tags defined -- one function per tag."
 	    (let* ((key-command (car tag))
 		   (tag-name (cdr tag))
 		   (activated (photogal-file-has-tag? (photogal-current-file) tag-name)))
-	      (photogal--pprint-key-command key-command tag-name activated)))
+	      (photogal--pprint-key-command key-command tag-name 16 activated)))
 	  (seq-sort (lambda (t1 t2) (string< (car t1) (car t2))) tags)))
 
 (defun photogal-insert-commands-to-buffer (commands)
@@ -409,10 +458,10 @@ for all tags defined -- one function per tag."
   (mapcar (lambda (command)
 	    (let ((key-command (car command))
 		  (command-name (cdr command)))
-	      (photogal--pprint-key-command key-command command-name)))
+	      (photogal--pprint-key-command key-command command-name 24)))
 	  commands))
 
-(defun photogal--pprint-key-command (key-to-type name-of-command &optional activated)
+(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)
@@ -424,7 +473,7 @@ for all tags defined -- one function per tag."
 	(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)))
+    (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)
@@ -438,8 +487,6 @@ for all tags defined -- one function per tag."
     (put-text-property beg (point) 'font-lock-face `(:foreground ,color))))
 
 ;;;;  --  ----  --  -     META SHIT     -  --  ----  --  ;;;;
-;; this is the coolest damn thing here.                    ;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defmacro photogal-generate-tagger (name)
   "Generate function to toggle a tag which is itself on the current file.
@@ -519,21 +566,40 @@ the current file."
 
 (defvar photogal-mode-map nil "Keymap for `photogal-mode`")
 
+(defvar key-commands
+  '(("G" . photogal-refresh-buffer)
+    ("RET" . photogal-next-file)
+    ("<right>" . photogal-next-file)
+    ("SPC" . photogal-next-file)
+    ("C-p" . photogal-prev-file)
+    ("<left>" . photogal-prev-file)
+    ("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)))
+
+
 (progn
   (setq photogal-mode-map (make-sparse-keymap))
-  (define-key photogal-mode-map (kbd "G") 'photogal-refresh-buffer)
-  (define-key photogal-mode-map (kbd "RET") 'photogal-next-file)
-  (define-key photogal-mode-map (kbd "<right>") 'photogal-next-file)
-  (define-key photogal-mode-map (kbd "SPC") 'photogal-next-file)
-  (define-key photogal-mode-map (kbd "P") 'photogal-prev-file)
-  (define-key photogal-mode-map (kbd "<left>") 'photogal-prev-file)
-  (define-key photogal-mode-map (kbd "A") 'photogal-add-tag)
-  (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 "N") 'photogal-name-the-file)
-  (define-key photogal-mode-map (kbd "O") 'photogal-give-a-folder))
+  (map-do (lambda (key command)
+	    (eval `(define-key photogal-mode-map (kbd ,key) ',command)))
+	  key-commands))
 
 (define-derived-mode photogal-mode text-mode "photogal"
   "Major mode for grouping and labeling images.")
+
+
+;;;
+
+;;new stuff:
+
+(defun make-tag (name key family)
+  (list name key family))
+
+(defun tag-name (tag) (intern (car tag)))
+(defun tag-key (tag) (cadr tag))
+(defun tag-family (tag) (caddr tag))
+

+ 397 - 0
photogal3.el

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