a new gal emerges

photogal.el was version 1.0

she wasn't flexible enuff

she had to be rewritten

she had to be replaced

photogal3.el

@@ -0,0 +1,248 @@
+(defvar *photogal/photoreel* nil)
+(defvar *photogal/tags*
+  '(
+    ("e" . (name "spokane"                           ;; pg 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"))))
+
+
+(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))
+
+  (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*))
+
+(defun photogal-render (photoreel)
+    (photogal-draw-buffer photoreel "photogal3" (photogal-top-level-tags) )
+  )
+
+
+
+
+;; //	  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-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"))
+      (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--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))))
+
+  (let* ((current-photo (photogal-current-file photoreel))
+	 (resize-image nil)
+	 (photo-file-path (photogal--get-filepath current-photo))
+	 (buf (get-buffer-create buffer)))
+
+    (with-current-buffer buf
+      (photogal-mode)
+      (erase-buffer)
+
+
+      (photogaldraw-index-tracker photoreel)
+      (photogaldraw--commit-message current-photo)
+      (photogaldraw--newline)
+      (photogaldraw--insert-image (photogal--get-filepath current-photo))
+      (photogaldraw--newline)
+      (photogaldraw--insert-tags tags current-photo)
+
+      (switch-to-buffer buf))
+    )
+  )
+
+(defun photogal-file-has-tag? (tag _) t)
+
+(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)
+    ))
+
+(defun photogal-next-file ()
+  (interactive)
+  (setq *photogal/photoreel* (photogal-advance-file *photogal/photoreel*))
+  (photogal-render *photogal/photoreel*)
+  )
+
+
+(defvar photogal-mode-map nil "Keymap for `photogal-mode`")
+
+(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
+
+(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-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-tag-name (tag)
+  (plist-get (cdr tag) 'name))
+(defun photogal-tag-key (tag)
+  (car tag))