Kaynağa Gözat

ahhhh brilliant tbh

got myself off that old magit shit. i did NOT need it.

my struggle of the day was macros, and
  i got the metaprogramming shit WORKING!!

this is my first juicy, production macro. at all!! in any lisp!! the
first one i had to figure out on my own, that wasn't in a book or a
blog... and it was non-trivial! pretty proud of myself actually. could
use some cleaning up. and probably (definitely) not the way an old
hand would have done it but still. im proud of myself :)
jordyn 2 yıl önce
ebeveyn
işleme
59b3cfb59c
1 değiştirilmiş dosya ile 110 ekleme ve 0 silme
  1. 110 0
      photogal.el

+ 110 - 0
photogal.el

@@ -0,0 +1,110 @@
+(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*)))
+
+(define-derived-mode photogal-mode text-mode "photogal"
+  "Major mode for grouping and labeling images.")
+
+(setq *photogal/raw-tags* '(("s" . "selfie") ("c" . "cityscape")))
+
+(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))
+  )
+
+(defun photogal-all-photos ()
+  (directory-files *photogal/operating-photo-dir*
+		   t directory-files-no-dot-files-regexp))
+
+(defun photogal-current-file ()
+  (car *photogal/all-photos*))
+
+(defun photogal-add-tag-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-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\nCurrent tags: ")
+      (insert (format "%s" (photogal-get-tags-for-file photo-file-path)))
+      (insert "\n\n")
+      (photogal-print-color "Tag:\n\n" "red")
+      (photogal-insert-tags)
+      )
+    (switch-to-buffer buf)))
+
+(defun photogal-print-color (str color)
+  (let ((beg (point)))
+    (insert str)
+    (put-text-property beg (point) 'font-lock-face `(:foreground ,color))))
+
+(defun photogal-insert-tags ()
+  (mapcar (lambda (tag)
+	    (let ((beg (point))
+		  (key-command (car tag))
+		  (tag-name (cdr tag)))
+	      (insert "[")
+	      (photogal-print-color key-command "dark gray")
+	      (insert "] ")
+	      (photogal-print-color tag-name "blue")
+	      (insert " ")))
+	  *photogal/raw-tags*))
+
+(defvar photogal-mode-map nil "Keymap for `photogal-mode`")
+
+(defun photogal-refresh-buffer ()
+  "Refresh buffer."
+  (interactive)
+  (message "refreshing buffer")
+  (photogal-init (photogal-current-file)))
+
+(progn
+  (setq photogal-mode-map (make-sparse-keymap))
+  (define-key photogal-mode-map (kbd "g") 'photogal-refresh-buffer))
+
+(defmacro photogal-tagger (name)
+  (interactive)
+  (let ((my-funcname (intern (format "photogal-add-tag-%s" name))))
+    `(defun ,my-funcname ()
+       (interactive)
+       (photogal-add-tag-to-file ,(photogal-current-file) ,(format "%s" name))
+       (photogal-refresh-buffer))))
+
+
+(defun photogal-add-tag-to-current-file (tag-key)
+  (photogal-add-tag-to-file (photogal-current-file) tag-key))
+
+(mapcar (lambda (tag)
+	  (let ((tag-key (car tag))
+		(tag-name (cdr tag))
+		)
+	    (eval `(photogal-tagger ,(intern tag-key)))
+	    (define-key photogal-mode-map (kbd tag-key) (intern (format "photogal-add-tag-%s" tag-key))
+	      ;#'(lambda () (photogal-add-tag-to-current-file tag-key))
+	      )
+	    ))
+	*photogal/raw-tags*)