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