photo-gal.el 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293
  1. (setq *photo-dir* (directory-file-name "/Users/jwd/bench/photos/"))
  2. (setq *operating-photo-dir* (concat *photo-dir* "-photogal"))
  3. (setq *my-tags* nil)
  4. (setq *photogal-operating-table* (mapcar (lambda (photo)
  5. (cons (list 'photo) photo))
  6. (all-photos)))
  7. (defun photogal-add-tag (file tag)
  8. (let ((tags (car (rassoc file *photogal-operating-table*))))
  9. (setcar (rassoc file *photogal-operating-table*) (cons tag tags))))
  10. (delete-directory *operating-photo-dir* t)
  11. (copy-directory *photo-dir* *operating-photo-dir*)
  12. (defun all-photos ()
  13. (directory-files *operating-photo-dir* t directory-files-no-dot-files-regexp))
  14. (all-photos)
  15. (define-derived-mode photogal-mode text-mode "photogal"
  16. "Major mode for grouping and labeling images.")
  17. (defun photogal-init ()
  18. (interactive)
  19. (let ((buf (get-buffer-create "photogal"))
  20. (photos (all-photos)))
  21. (with-current-buffer buf
  22. (photogal-mode)
  23. (erase-buffer)
  24. (insert "\n")
  25. (insert " ")
  26. (insert-image
  27. ;; (create-image (car photos) 'imagemagick nil :width (- (window-pixel-width) 75))
  28. (create-image (car photos) 'imagemagick nil :height (/ (window-pixel-height) 2)))
  29. (insert "\n\n")
  30. )
  31. buf)
  32. (switch-to-buffer (get-buffer-create "photogal")))
  33. (defun photogal-selfie ()
  34. (interactive)
  35. (photogal-add-tag *photogal-current-file* "selfie")
  36. (message *photogal-current-file*))
  37. (transient-define-prefix photogal-tag ()
  38. [["Commit"
  39. ("c" "Tag: selfie" photogal-selfie)]]
  40. (interactive)
  41. (setq *my-photo-args* (transient-args 'photogal-categorize))
  42. (message (transient-args 'photogal-categorize))
  43. (transient-setup 'photogal-tag))
  44. (setq photogal-raw-tags '(("s" . "selfie") ("c" . "cityscape")))
  45. (defun photogal-auto-tags ()
  46. (let ((args (mapcar (lambda (tag) (list (car tag) " " (cdr tag))) photogal-raw-tags)))
  47. (vconcat (cons "Arguments"
  48. args))))
  49. (setq photogal-tags
  50. (photogal-auto-tags))
  51. (defun photogal-add-tag (new-tag new-tag-code)
  52. (interactive "sNew tag: \nsTag code: ")
  53. (setq photogal-raw-tags
  54. (cons (cons new-tag-code new-tag) photogal-raw-tags))
  55. (setq photogal-tags (photogal-auto-tags))
  56. (eval `(transient-define-prefix photogal-categorize ()
  57. "Tag a photo."
  58. ,photogal-tags
  59. [["Tag"
  60. ("t" "Tag" photogal-tag)
  61. ("a" "Add tag" photogal-add-tag)]]
  62. (interactive)
  63. (setq *photogal-current-file* (car (all-photos)))
  64. (transient-setup 'photogal-categorize)))
  65. (transient-setup 'photogal-categorize))
  66. (transient-define-prefix photogal-categorize ()
  67. "Tag a photo."
  68. photogal-tags
  69. [["Tag"
  70. ("t" "Tag" photogal-tag)
  71. ("a" "Add tag" photogal-add-tag)]]
  72. (interactive)
  73. (setq *photogal-current-file* (car (all-photos)))
  74. (transient-setup 'photogal-categorize))
  75. (photogal-categorize)
  76. (message *my-tags*)