Browse Source

the new gal finds her feet

"tag families" really bit my ass. but after a heavy rework and a bit
of rearchitecting and a lot of tightening up, photogal is almost
back to her previous self, but new and improved!

this is still a wip ;)
jordyn 2 years ago
parent
commit
d03e50f2bb
2 changed files with 385 additions and 178 deletions
  1. 119 61
      photogal.el
  2. 266 117
      photogal3.el

+ 119 - 61
photogal.el

@@ -1,4 +1,3 @@
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;    PHOTOGAL    ;;;;;;;;;;;;;;;;;;;;;`;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; v1.0 ;;;;;;
@@ -31,6 +30,23 @@
 (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")
@@ -79,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)
@@ -88,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)
@@ -153,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)
@@ -212,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."
@@ -297,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)
@@ -363,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 ()
@@ -440,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.
@@ -545,3 +590,16 @@ the current file."
 
 (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))
+

+ 266 - 117
photogal3.el

@@ -1,7 +1,7 @@
 (defvar *photogal/photoreel* nil)
 (defvar *photogal/tags*
   '(
-    ("e" . (name "spokane"                           ;; pg will not display
+    ("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
@@ -23,36 +23,34 @@
     ("t" . (name "photography"))
     ("s" . (name "selfie"))))
 
+(defcustom photogal-default-directory "/Users/jwd/bench/photos/"
+  "This is where photogal will look for photos.")
 
-(define-derived-mode photogal-mode text-mode "photogal"
-  "Major mode for grouping and labeling images.")
 
 (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))
+    "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)
+    (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))
-    ))
+	    (photogalroll--generate destination-dir))))
 
 (defun photogal-current-file (photoreel)
-    "What is the file currently being operated on?"
-    (car 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))))
+  (append (cdr photoreel) (list (car photoreel))))
 (defun photogal-rewind-file (photoreel)
-    "Reverse by one photo."
-    (append (last photoreel) (butlast photoreel)))
+  "Reverse by one photo."
+  (append (last photoreel) (butlast photoreel)))
 
 
 
@@ -61,24 +59,76 @@
   (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-render *photogal/photoreel* *photogal/tags*))
 
-(defun photogal-render (photoreel)
-    (photogal-draw-buffer photoreel "photogal3" (photogal-top-level-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
-	       ))
+  `(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)
@@ -106,106 +156,178 @@
 ;; \\				// ;;
 
 
+(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 photogal-draw-buffer (photoreel buffer tags)
-  (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"))
+(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 "✗" "red"))))
-
-  (defun photogaldraw--insert-image (filepath)
-    (insert " ")
-    (insert-image
-     (if resize-image
-	 (create-image filepath 'imagemagick nil
-		       :width (- (window-pixel-width) 75))
+	(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
-		     :height (/ (window-pixel-height) 2)))))
-
-  (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 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 (photogal-file-has-tag? photo tag-name)))
-		(photogal--pprint-key-command key-command tag-name 16 activated)))
-	    ;;(seq-sort (lambda (t1 t2) (string< (car t1) (car t2))) tags)
-	    tags
-	    )
-    )
-
-  (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))))
+		     :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)))
-
+	 (buf (get-buffer-create buffer))
+	 (display-tags (photogal-top-level-tags tags)))
     (with-current-buffer buf
-      (photogal-mode)
-      (erase-buffer)
+      (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-tags tags current-photo)
+      (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))
-    )
-  )
 
-(defun photogal-file-has-tag? (tag _) t)
+      (switch-to-buffer buf)
+      (photogaldraw-activate-key-commands tags))))
 
 (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)
+    ("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)
@@ -213,22 +335,22 @@
     ;; ("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-render *photogal/photoreel* *photogal/tags*))
 
-(defvar photogal-mode-map nil "Keymap for `photogal-mode`")
+(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*))
 
-(progn
-  (setq photogal-mode-map (make-sparse-keymap))
-  (map-do (lambda (key command)
-	    (eval `(define-key photogal-mode-map (kbd ,key) ',command)))
-	  key-commands))
 
 ;; // tag shit
 
@@ -236,13 +358,40 @@
   (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 ()
-  (append (photogal-all-parents *photogal/tags*)
-	  (photogal-tags-with-no-parents *photogal/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))