photogal/photo-gal.el

(defvar *photogal/operating-photo-dir* nil)
(defvar *photogal/all-photos* nil)
(defvar *photogal/operating-table* nil)


(defun photogal-init-operating-table ()
       (setq *photogal/operating-table* (mapcar (lambda (photo)
						  (cons (list 'photo) photo))
						*photogal/all-photos*)))

(require 'transient)

(define-derived-mode photogal-mode text-mode "photogal"
  "Major mode for grouping and labeling images.")

(setq photogal-raw-tags '(("s" . "selfie") ("c" . "cityscape")))

(defun photogal-auto-tags ()
  (let ((args (mapcar (lambda (tag) (list (car tag) " " (cdr tag))) photogal-raw-tags)))
    (vconcat (cons "Arguments"
		   args))))

(setq photogal-tags
      (photogal-auto-tags))
(setq photogal-operations
      [["Operations"
	("RET" "Next"             photogal-next-file)
	("P" "Previous"             photogal-prev-file)
	("A" "Add new tag"        photogal-add-tag)]])


(defvar photogal-default-directory "/Users/jwd/bench/photos/")


(defun photogal (photo-dir)
  (interactive (list (read-directory-name "where are ur photos? " 
                                          photogal-default-directory)))
  (message photo-dir)
  (let ((photo-files-directory (directory-file-name photo-dir)))
    (setq *photogal/operating-photo-dir* (concat photo-files-directory "-photogal"))
    (setq *photogal/all-photos* (photogal-all-photos)))
  (photogal-init-operating-table)
  (photogal-init (photogal-current-file))
  (photogal-categorize)
  )


(transient-define-prefix photogal-categorize ()
  "Tag a photo."
  photogal-tags
  photogal-operations
  (interactive)
  (setq *photogal-current-file* (photogal-current-file))
  (transient-setup 'photogal-categorize))


(defun photogal-all-photos ()
  (message *photogal/operating-photo-dir*)
  (directory-files *photogal/operating-photo-dir*
		   t directory-files-no-dot-files-regexp))

(defun photogal-current-file ()
  (car *photogal/all-photos*))

(defun photogal-add-tags-to-file (file tag)
  (let ((tags (car (rassoc file *photogal/operating-table*))))
    (setcar (rassoc file *photogal/operating-table*) (cons tag tags))))

(defun photogal-get-tags-for-file (file)
  (car (rassoc file *photogal/operating-table*)))

(defun photogal-next-file ()
  (interactive)
  (let ((current-file (photogal-current-file)))
    (mapcar (lambda (t-arg) (photogal-add-tags-to-file current-file t-arg))
	    (transient-args 'photogal-categorize))
    )

  (setq *photogal/all-photos*
	(append (cdr *photogal/all-photos*) (list (car *photogal/all-photos*))))
  (photogal-init (photogal-current-file))
  (photogal-categorize))

(defun photogal-prev-file ()
  (interactive)
  (let ((current-file (photogal-current-file)))
    (mapcar (lambda (t-arg) (photogal-add-tags-to-file current-file t-arg))
	    (transient-args 'photogal-categorize))
    )

  (setq *photogal/all-photos*
	(append (last *photogal/all-photos*) (butlast *photogal/all-photos*)))
  (photogal-init (photogal-current-file))
  (photogal-categorize))

(defun photogal-init (photo-file-path)
  (let ((buf (get-buffer-create "photogal")))
    (with-current-buffer buf
      (photogal-mode)
      (erase-buffer)
      (insert "\n")
      (insert " ")
      (insert-image
       ;; (create-image (car photos) 'imagemagick nil :width (- (window-pixel-width) 75))
       (create-image photo-file-path
		     'imagemagick nil :height (/ (window-pixel-height) 2)))
      (insert "\n\n")
      (insert (format "%s" (photogal-get-tags-for-file photo-file-path)))
      )
    (switch-to-buffer buf)))


(defun photogal-add-tag (new-tag new-tag-code)
  (interactive "sNew tag: \nsTag code: ")
  (setq photogal-raw-tags
	(cons (cons new-tag-code new-tag) photogal-raw-tags))
  (setq photogal-tags (photogal-auto-tags))
  (eval `(transient-define-prefix photogal-categorize ()
	   "Tag a photo."
	   ,photogal-tags
	   ,photogal-operations
	   (interactive)
	   (setq *photogal-current-file* (photogal-current-file))
	   (transient-setup 'photogal-categorize)))
  (transient-setup 'photogal-categorize))