photogal finds herself

bugs

@@ -0,0 +1,2 @@
+[ ] adding a file to the folder updates the counter, but doesn't read in the
+      new file.

monolog

@@ -0,0 +1,543 @@
+
+
+
+
+		                //					h	e	l	l	o	!				\\
+
+
+						i	am	going	to	record	some	of	my	work	for
+						a	bit.		will	perhaps	chop	this	up	later	into
+						video.		what	i 	will 	be 	doing	is 	creating
+						some	features	in 	a	new 	emacs	project	i	put
+						together.		the	project	is	called	      p h o t o g a l.
+						it 	works 	great,	i	built	the 	functional      prototype
+						a	week	ago.	she 	works.	she	works	great!	she	has
+						that 	~~potential~~.	theres	a	lot	of	stuff	that	i
+						can	add 	to 	make 	it 	killer	software.	ive	done
+						some	of 	the 	most 	essential	already,	up	next
+						are	the 	first	few	nice-to-haves.	i	am	coding	to
+						music:	SOPHIE		—	"Product".	its	late.	here	goes.
+
+
+
+
+
+
+
+
+		-- j o r d y n .....
+						
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  i think the easiest first thing to do is add an index ticker:
+
+    "you are viewing photo 1/75"
+    "you are viewing photo 2/75"    ...
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+                                                that index counter was damn easy.
+
+
+						next bit will be harder.
+
+
+
+
+
+			the two big features i want to do next are "tag families" and "destination dirs". i think im gna do dest dirs first
+
+
+  sophie ended. its always hard to put on something after sophie
+  bc there's no one quite like her. and im always a little sad
+  as i choose the next album.
+    anyway i put on "asakusa light" by soichi terada
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+                                the reason i wrote that test file yesterday, was because i knew my central datasource was moulded.
+
+				the app puts all its weight on a single cons cell with car/cdr getter/setters. it worked great to
+				get me started, but it was starting to creak and moan. so i knew i'd have to gut it. but also it is
+				the essence of my app, if i fuck it up, its gon be messy.
+
+				so i wrote the tests to give me the confidence to rip it out and replace it with something stronger.
+
+
+  if this (what i'm about to attempt) just works `TM`, i will be
+    awed and amazed
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+i just gutted this app, and it didnt even flinch.
+
+lisp is so powerful.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+  this is a good place to pause for me. going to go eat food.
+
+  the directory functionality is useless right now, but i set it
+  up for the simple directory-managing busy work i'll do later.
+
+  what i did today was more important: enabled that. its an easy
+  matter of tieing looose ends after this.
+
+  the next big thing is tag families.
+
+
+
+      	       xoxoxoxox jordyn <3
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+                my latest feature, dest dir, works pretty good rn.
+		the bones are there.
+		but none of the corners have been rounded off, none of
+		the details have been given polish, its pretty rustic.
+
+		so i guess i'll do that tonite. it's a bit of a chore,
+		just busy work. might knock out a few bugs along
+		the way.
+
+		tonite's music: starting with Dorian Electra, ^*flamboyant*^
+
+			
+
+
+
+			- jordyn
+
+wowowow that was tricky!! funny, good one BD
+
+
+
+
+
+
+
+      now we are going to do tag families
+
+      its one of those things that requires loosening up some tightly
+      coupled shit in pleasingly functional/abstract fashion.
+
+
+
+    -    -      -    -      -    -      -    -      -    -      -    -      -    -
+
+
+      this is slightly messier than expected (as it always is)
+      introducing "tag families" introduces complexity at a very
+        awkward juncture in the code. it invites an awful lot of
+	uncertainty and subtlety in a way that can be done, but
+	feels awkward and unnatural.
+      it plants the seeds for a major refactor/reworking at a later
+      time.
+	but i have to do it the ugly way first,
+      so here goes the ugly way.
+
+
+
+
+      tunes: the brand-new episode of blonded radio
+
+      	     frank has been quiet for a long time. is he getting ready
+	     to make moves? i hope so
+
+	     didnt realize the blonded epi would be a lecture on
+	     psychedelics.
+
+	     well thats all nice for u but its so damn unreliable for
+	       me to aquire
+
+	     legalize that shit got damn
+
+	     although i hope frankie is doing as many hallucinagens
+	       as he can get his hands on. gon make some fire tracks
+
+
+
+  guuuhhhh this is ugly and unpleasant. perhaps i will have to take
+  on the rewrite preepmtively .... cause this rly aint goin well lol
+
+
+
+
+
+
+
+
+     	 	 	      that last attempt to graft tag fams onto photogal really really did not go well. it's picking at very brittle code in a
+			      very aggressive mannor. the complexity is just too much for the old code to bear, and even if it's possible it's
+			      confusing the heck outta me and causing me frustration.
+			      i was thinkin about it a bit, and i think i can solve the problem (create arbitrary key bindings that are aware of state
+			      i.e.: (photogal-current-file)) in a better way. perhaps using partial application, perhaps get rid of the macro, we will
+			      see how things go, but the state of affairs is unnacceptable.
+
+
+
+
+			      " all software is beautiful until you try adding features "	-me
+
+
+
+			      for music tonite, gonna start with the new album from s u p e r o r g a n i s m ("World Wide Pop")
+
+
+ that superorganism album might be one of the most foul things ive ever heard
+
+  and i ADORED their first one
+
+
+
+
+
+   here goes a gain. 3rd night in a row? utter --failure-- "learning"
+   the last few goes. but chewing on it in my subconsious. developping Plans
+
+
+
+
+   ok ok OK!! we making moves
+
+after absolute shit ass progress, we are puttin things together!
+
+i feel good about the direction of things. will be a while
+before i find out if the progress was worthwhile.
+
+but i really think things are looking better already!
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+									shit's really coming together now !!!
+
+
+
+
+
+
+
+						i wasnt sure for a while, but now ive found the groove, and now it's all about porting that
+						v1 mess over to a tider, more disciplined structure. the first version grew organically,
+						as i explored the idea. there were some scraggly bits, so this is like giving a hedge a
+						thorough trimming. get everything more uniform, shear off the bits that have overgrown or
+						stick out. and i feel really good about how those things are piecing together :)
+
+
+
+
+
+
+
+
+				... back now after a long (5 day) weekend
+
+				really looking to get in and knock out the last final pieces.
+
+				was gone at CHBP where i saw beachbunny, flomilli, 100gecs, chloemoriondo, theblacktones and more
+
+				great time
+
+				today im starting by listening to
+				moses sumney's live album From
+				Blackalachia
+
+
+				damn i love this moses shit
+
+				i feel like that album was slept on (græ) bc it came
+				out right before the pandemic. he in general slept on
+				aromanticism a damn classic
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+		time for new music; beachbunny & soccermommy both just
+		  put out new LPs. im obsessed. will prolly listen to
+		  one and then the other. i love both of them sm <3 <3
+
+		also beabadoobee put out some new shit. havent heard it
+		  yet.
+
+
+
+
+
+                         YOOOOOOOOOOOOO
+			 HOOOOOOOOOOLy
+			 FUUUUUUUUUUUUCK!!
+			 IT FUCKEN WORKS!!!!
+
+
+
+
+
+			 tying up the last few threads; ie porting over the final features that were in
+			 the old version but aren't in the new one yet :)
+
+			 for music, listening to the new sam gendel album (live in texas)
+			 and then of course we will put on the new beyoncé (renaissance)
+
+			 its over a hundred degrees here :L
+
+
+
+
+
+
+			     lets port over the last few final features ;)
+
+			     music: starting with the new maggie rogers "surrender" <- great
+			     	    this album came out the same day as the new bey...
+				    how u even compete with that  lol
+				    (but music isnt a competition!!)
+
+the new beabadoobee next ( i cant help but simp !! ) "beatopia"
+  i love her just for the song "wish i was stephen malkmus"
+
+
+
+ ;; it works! not elegantly yet.  but it will! the imortant thing is that it go vroomvroom
+
+
+
+
+     now begins... the Good Refactor.
+
+I'm just outside klamath falls on the pacific crest amtrak line
+
+i need some aloof perspective to refactor durably.
+
+listening from the downloaded (no cell service) albums on my iphone
+
+  going with big thief's latest: dragon new warm mountain i believe in you
+

photogal3.el

@@ -1,397 +0,0 @@
-(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))

photogal_og.el

@@ -0,0 +1,605 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;    PHOTOGAL    ;;;;;;;;;;;;;;;;;;;;;`;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; v1.0 ;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;,;;;;;;;;;*;;;
+;;                                        `                ;;
+;;  author: jordyn                          ,   -    *     ;;
+;;  authored: spokane valley, summer '22      .          ` ;;
+;;                                           *     ^ ~     ';
+;;    PHOTO                *    ,    '  .     `  *      ,  ;;
+;;    , Grouper         '    `     .    * -   .            ;;
+;; .      And        ,    ^ '  .  '  .   `  `      '       ;;
+;;    `     Labeler    '   ,     * '      *                ;;
+;;  ,     .   ,     `        '        .        `           ;;
+;;   '           -     '        ,                          ;;
+;;                                                         ;;
+;;                                                         ;;
+;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;;  ;; ;;  ;;
+
+
+
+;;;;  --  ----  --  -      DATA         -  --  ----  --  ;;;;
+
+(defvar *photogal/operating-photo-dir* nil)
+(defvar *photogal/all-photos* nil)
+(defvar *photogal/operating-table* nil)
+(defvar *photogal/--resize-photo* nil)
+(defvar *photogal/photos-origin-directory* nil)
+
+
+(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")
+    ("f" . "family")
+    ("g" . "good")
+    ("h" . "screenshot")
+    ("l" . "politics")
+    ("m" . "meme")
+    ("o" . "computer")
+    ("p" . "portrait")
+    ("r" . "reaction-photo")
+    ("t" . "photography")
+    ("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)))
+(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-folders-for-file (photo-filepath)
+  "what folders does this file have?"
+  (photogal--get-folders (photogal--lookup-photo photo-filepath)))
+(defun photogal-set-folders-for-file (photo-filepath folders)
+  "make this file have these folders"
+  (photogal--set-folders (photogal--lookup-photo photo-filepath) folders))
+
+(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))
+
+
+(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)
+	     'copy-to-dir t))
+(defun photogal-unmark-photo-for-copying (photo-filepath)
+  "toggle on to NOT copy this file. Warning: will not commit file."
+  (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)
+					    field))
+		 '(tags name))))
+
+    (seq-some (lambda (field) (not (eq nil field)))
+	      all-fields-for-photo)))
+
+(defun photogal-file-marked-for-copying? (photo-filepath)
+  (plist-get (photogal--lookup-photo photo-filepath)
+	     'copy-to-dir ))
+
+;; //             internal           \\ ;;
+(defun photogal--lookup-photo (photo-filepath)
+  (seq-find (lambda (photo)
+	      (string= (photogal--get-filepath photo) photo-filepath))
+   *photogal/operating-table*))
+
+(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-name (photo)
+  (plist-get photo 'name))
+(defun photogal--set-name (photo name)
+  (plist-put photo 'name
+	     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      -  --  ----  --  ;;;;
+
+
+
+(defun photogal (photo-dir)
+  (interactive
+   (list (read-directory-name
+	  "where are ur photos? " photogal-default-directory)))
+  (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 (photogal-general-tag-list)))
+
+(defun photogal-restart ()
+  (interactive)
+  (setq *photogal/all-photos* (photogal-all-photos *photogal/photos-origin-directory*))
+  (photogal-init-operating-table)
+  (photogal-init (photogal-current-file)))
+
+
+;;;;  --  ----  --  -  INITIALIZATION   -  --  ----  --  ;;;;
+
+(defun photogal-make-photo (filepath)
+  `(filepath ,filepath
+	     tags ,nil
+	     name ,nil
+	     folders ,(list *photogal/operating-photo-dir*)
+	     copy-to-dir ,nil))
+
+(defun photogal-init-operating-table ()
+  (setq *photogal/operating-table*
+	(mapcar (lambda (photo)
+		  (photogal-make-photo photo))
+		*photogal/all-photos*)))
+
+(defun photogal-generate-tag-commands ()
+  "Generate and activate M-x (photogal-toggle-tag-TAG) to tag curent photo,
+for all tags defined -- one function per tag."
+  (mapcar (lambda (tag)
+	    (let ((tag-key (car tag))
+		  (tag-name (cdr tag)))
+	      (eval `(photogal-generate-tagger ,(intern tag-name)))
+	      (define-key photogal-mode-map (kbd tag-key)
+		(intern (format "photogal-toggle-tag-%s" tag-name)))))
+	  photogal/tags))
+
+;;;;  --  ----  --  -        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)))
+    (if (or tag-code-too-long tag-code-in-use)
+	(progn (message "tag code must be a single character and can't be already in use")
+	       (call-interactively 'photogal-add-tag))
+      (photogal--add-tag new-tag new-tag-code)
+      (photogal-refresh-buffer))))
+
+(defun photogal-delete-tag (tag-code)
+  "Remove a tag from the library."
+  (interactive "sDelete tag: ")
+  (customize-save-variable
+   'photogal/tags
+   (seq-remove (lambda (tag) (string= (car tag) tag-code)) photogal/tags))
+  (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
+     ;; (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 (tag)
+  "If a file has the tag, remove it. If it doesn't have it, add it."
+  (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."
+  (let ((tags (photogal-get-tags-for-file file)))
+    (photogal-set-tags-for-file file
+		       (seq-sort #'string< (seq-uniq (cons tag tags))))))
+
+(defun photogal-rm-tag-from-file (file tag)
+  "Dissociate tag from file."
+  (defun tags-without-tag (tags tag)
+    (seq-sort
+     #'string<
+     (seq-uniq
+      (seq-remove
+       (lambda (tg) (string= tg tag)) tags))))
+  (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-get-tags-for-file file)))
+    (seq-contains-p tags tag)))
+
+;;;;  --  ----  --  -     DEST DIRS     -  --  ----  --  ;;;;
+
+(defun photogal-add-folder-for-file (file folder)
+  "Append new folder for a file."
+  (let ((folders (photogal-get-folders-for-file file)))
+    (photogal-set-folders-for-file 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) folder-name)
+    (photogal-mark-photo-for-copying (photogal-current-file))
+    (photogal-refresh-buffer)))
+
+;;;;  --  ----  --  -     FILE NAME     -  --  ----  --  ;;;;
+
+(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-mark-photo-for-copying (photogal-current-file))
+  (photogal-refresh-buffer))
+
+;;;;  --  ----  --  -      FILE OPS     -  --  ----  --  ;;;;
+
+(defun photogal-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 photogal-current-file ()
+  "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."
+  (let ((buf (get-buffer-create "photogal")))
+    (with-current-buffer buf
+      (photogal-mode)
+      (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)
+  (photogal-refresh-buffer))
+
+(defun photogal-prev-file ()
+  (interactive)
+  (photogal-rewind-photo)
+  (photogal-refresh-buffer))
+
+(defun photogal-refresh-buffer (&optional show-filepath)
+  "Refresh buffer."
+  (interactive)
+  ;; (message "refreshing buffer") ;; useful to know when screen re-draws
+  (progn ; useful stuff to run every page draw
+    (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-general-tag-list))
+  (beginning-of-buffer))
+
+(defun photogal-resize-photo ()
+  (interactive)
+  (setq *photogal/--resize-photo* (not *photogal/--resize-photo*))
+  (photogal-refresh-buffer))
+
+(defun photogal-show-filepath ()
+  (interactive)
+  (photogal-refresh-buffer t))
+
+(defun photogal-index-tracker ()
+  ;; this is a little expensive, running photogal-all-photos
+  ;; on every paint, but i'd like to have the file count
+  ;; be very accurate.
+  (let ((current-index
+	 (+ 1 (seq-position
+	       (photogal-all-photos *photogal/photos-origin-directory*)
+	       (photogal-current-file))))
+	(total-photos
+	 (length (photogal-all-photos *photogal/photos-origin-directory*))))
+    (insert "  ur lookin at photo ")
+    (photogal--insert-print-color current-index "red")
+    (insert " of ")
+    (photogal--insert-print-color total-photos "red")))
+
+
+;;;;  --  ----  --  - LO-LEVEL DISPLAY  -  --  ----  --  ;;;;
+;; this stuff paints the words on the screen, changing     ;;
+;; color, etc, pprinting stuff at a pretty granular and    ;;
+;; tediously technical level.                              ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun photogal-insert-tags-to-buffer (tags)
+  "Pretty print the tags with their toggle key."
+  (mapcar (lambda (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 16 activated)))
+	  (seq-sort (lambda (t1 t2) (string< (car t1) (car t2))) tags)))
+
+(defun photogal-insert-commands-to-buffer (commands)
+  "Pretty print the commands with their invoke key."
+  (mapcar (lambda (command)
+	    (let ((key-command (car command))
+		  (command-name (cdr command)))
+	      (photogal--pprint-key-command key-command command-name 24)))
+	  commands))
+
+(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))))
+
+;;;;  --  ----  --  -     META SHIT     -  --  ----  --  ;;;;
+
+(defmacro photogal-generate-tagger (name)
+  "Generate function to toggle a tag which is itself on the current file.
+One of these is needed per tag. For instance if you want to create the tag
+'cool', you can run and evaluate (photogal-generate-tagger cool) to create a new
+function `photogal-toggle-tag-cool` that will toggle the tag 'cool' for
+the current file."
+  (let ((my-funcname (intern (format "photogal-toggle-tag-%s" name))))
+    `(defun ,my-funcname ()
+       (interactive)
+       (photogal-for-file-toggle-tag (photogal-current-file) ,(format "%s" name))
+       (photogal-mark-photo-for-copying (photogal-current-file))
+       (photogal-refresh-buffer))))
+
+;;;;  --  ----  --  -MOVING FILES AROUND-  --  ----  --  ;;;;
+
+(defun photogal-files--get-extension (filepath)
+  (file-name-extension filepath))
+
+(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))
+
+(defun photogal-files--new-file-name-for-photo (filepath tags name)
+  (cons
+   filepath
+   (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--new-filenames-for-photos ()
+  (mapcar
+   (lambda (photo)
+     (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-compile-and-commit ()
+  (interactive)
+  (if (y-or-n-p (format  "Are u sure? "))
+      (photogal-heavy-move-files-to-directory)
+    (message "whoops")))
+
+(defun photogal-heavy-move-files-to-directory ()
+  ;; THIS DOES A LOTTA SHIT!!!
+  (defun rename-file-to-folders (file-rename)
+    (let ((origin (car file-rename))
+	  (new-name (cdr file-rename)))
+      (when (photogal-photo-valid-for-committing? origin)
+	(let ((dest-dirs (photogal-get-folders-for-file origin)))
+	  (mapcar (lambda (directory)
+		    (make-directory directory 'parents)
+		    (let ((new-file-name (expand-file-name new-name directory)))
+		      (message (format "renaming %s to %s" origin new-file-name))
+		      (copy-file origin new-file-name)))
+		  dest-dirs)
+	  (delete-file origin)))))
+  (let* ((new-names (photogal-files--new-filenames-for-photos)))
+    (mapcar
+     #'rename-file-to-folders
+     new-names)
+    (photogal-restart)))
+
+;;;;  --  ----  --  -   KEY BINDINGS    -  --  ----  --  ;;;;
+
+(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))
+  (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))
+