Sfoglia il codice sorgente

first few bits, many mostly operational

Getting a first commit down. Most of this is exploratory code
and proofs of concept.
jordyn 2 anni fa
commit
8ec3dfd270
1 ha cambiato i file con 93 aggiunte e 0 eliminazioni
  1. 93 0
      photo-gal.el

+ 93 - 0
photo-gal.el

@@ -0,0 +1,93 @@
+(setq *photo-dir* (directory-file-name "/Users/jwd/bench/photos/"))
+(setq *operating-photo-dir* (concat *photo-dir* "-photogal"))
+(setq *my-tags* nil)
+
+(setq *photogal-operating-table* (mapcar (lambda (photo)
+					    (cons (list 'photo) photo))
+					 (all-photos)))
+(defun photogal-add-tag (file tag)
+  (let ((tags (car (rassoc file *photogal-operating-table*))))
+    (setcar (rassoc file *photogal-operating-table*) (cons tag tags))))
+
+(delete-directory *operating-photo-dir* t)
+(copy-directory *photo-dir* *operating-photo-dir*)
+
+
+(defun all-photos ()
+  (directory-files *operating-photo-dir* t directory-files-no-dot-files-regexp))
+
+(all-photos)
+
+(define-derived-mode photogal-mode text-mode "photogal"
+  "Major mode for grouping and labeling images.")
+
+(defun photogal-init ()
+  (interactive)
+  (let ((buf (get-buffer-create "photogal"))
+	(photos (all-photos)))
+    (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 (car photos) 'imagemagick nil :height (/ (window-pixel-height) 2)))
+      (insert "\n\n")
+      )
+    buf)
+  (switch-to-buffer (get-buffer-create "photogal")))
+
+(defun photogal-selfie ()
+  (interactive)
+  (photogal-add-tag *photogal-current-file* "selfie")
+  (message *photogal-current-file*))
+
+(transient-define-prefix photogal-tag ()
+  [["Commit"
+    ("c" "Tag: selfie" photogal-selfie)]]
+  (interactive)
+  (setq *my-photo-args* (transient-args 'photogal-categorize))
+  (message (transient-args 'photogal-categorize))
+  (transient-setup 'photogal-tag))
+
+
+(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))
+
+(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
+	   [["Tag"
+	     ("t" "Tag"         photogal-tag)
+	     ("a" "Add tag"     photogal-add-tag)]]
+	   (interactive)
+	   (setq *photogal-current-file* (car (all-photos)))
+	   (transient-setup 'photogal-categorize)))
+  (transient-setup 'photogal-categorize))
+
+(transient-define-prefix photogal-categorize ()
+  "Tag a photo."
+  photogal-tags
+  [["Tag"
+    ("t" "Tag"         photogal-tag)
+    ("a" "Add tag"     photogal-add-tag)]]
+  (interactive)
+  (setq *photogal-current-file* (car (all-photos)))
+  (transient-setup 'photogal-categorize))
+
+(photogal-categorize)
+
+(message *my-tags*)