;; $Id: jdired.el,v 1.1 2005/01/17 01:45:20 sra Exp $
;;
;; A simple editor for attaching comments to JPEG files.
;;
;; I have come to the conclusion that the best way to caption a JPEG
;; is to stuff the caption into a JPEG comment field, so that the
;; caption will then stick with the image and won't be lost the next
;; time I switch to a different web gallery program, or mail the
;; picture to a friend, or whatever.
;;
;; Programs to do this have existed for years, of course, but I find
;; all of them annoying.  This is a simple editing job, and therefore
;; should of course be done in emacs.  So I wrote this for my own use.
;; If it happens to be useful to anybody else, cool.
;;
;; This program is hereby explictly placed in the public domain as
;; Beer-Ware.  If we meet some day and you think this program is worth
;; it, you can buy me a beer.  Your mileage may vary.  We decline
;; responsibilities, all shapes, all sizes, all colors.  If this
;; program breaks, you get to keep both pieces.
;;
;; Notes:
;;
;; - jhead is a nice program, but it's lame about using stderr or
;;   returning exit codes.  So one has to examine its output to figure
;;   out whether it worked or not (sigh).  I tried to write the lisp
;;   code in such a way that it'll still work if this is ever fixed.
;;
;; - For images that don't have an EXIF thumbnail, I'm using "convert"
;;   from the ImageMagick package to generate one.  Geometry
;;   specifications for this were chosen to match the geometry of the
;;   EXIF thumbnails that my camera generates.  YMMV.  "convert"
;;   claims to be clever about how it does the JPEG decompression if
;;   one warns it that one is producing a thumbnail (see the man
;;   page), so this should, in theory, be faster than performing the
;;   equivilent operation with, eg, netpbm.
;;
;; - There are many interesting things buried in the EXIF, and
;;   exifprobe can probably extract most of them, but I can't be
;;   bothered to figure out the argument syntax.  Feel free to hack
;;   lisp code for this and send it back to me.
;;
;; - The code is not yet clever enough to handle events that would
;;   ordinarily save the buffer.  In theory one can do this sort of
;;   thing using write-contents-hooks but it didn't work right when I
;;   tried it and I lacked the patience to find a working example.

(require 'image)

(defvar jdired-get-image-thumbnail-size "160x120"
  "ImageMagick geometry specification for generating thumbnails.")

(defun jdired-get-image-thumbnail (filename)
  "Extract (or generate) a thumbnail from a JPG file."
  (let (buf)
    (unwind-protect
	(save-excursion
	  (setq buf (generate-new-buffer "*jdired-get-image-thumbnail*"))
	  (set-buffer buf)
	  (if (or
	       (and
		(prog1 t
		  (message "Extracting %s exif thumbnail..." filename))
		(= 0 (call-process "jhead" nil '(t nil) nil "-st" "-" filename))
		(prog1 t
		  (goto-char (point-min)))
		(not (looking-at (concat "Image '" (regexp-quote filename) "' contains no thumbnail")))
		(< 0 (buffer-size)))
	       (and
		(prog1 t
		  (erase-buffer)
		  (message "Extracting %s exif thumbnail...failed.  Generating thumbnail..." filename))
		(= 0 (call-process "convert" nil '(t nil) nil 
				   "-size" jdired-get-image-thumbnail-size filename "+profile" "*"
				   "-resize" jdired-get-image-thumbnail-size "jpg:-"))
		(< 0 (buffer-size))))
	      (create-image (buffer-string) 'jpeg t)
	    (error "Couldn't figure out how to extract thumbnail from %s" filename)))
      (when buf
	(kill-buffer buf)))))

(defun jdired-get-image-comment (filename)
  "Extract a comment from a JPG file."
  (let (buf)
    (unwind-protect
	(save-excursion
	  (setq buf (generate-new-buffer "*jdired-get-image-comment*"))
	  (set-buffer buf)
	  (cond
	   ((= 0 (call-process "rdjpgcom" nil '(t nil) nil filename))
	    (goto-char (point-max))
	    (skip-chars-backward "\n\t ")
	    (buffer-substring (point-min) (point)))
	   (t
	    (error "Couldn't read JFIF comment from %s" filename))))
      (when buf
	(kill-buffer buf)))))

(defun jdired-put-image-comment (filename comment)
  "Insert a comment into a JPG file."
  (let (buf)
    (unwind-protect
	(save-excursion
	  (setq buf (generate-new-buffer "*jdired-put-image-comment*"))
	  (set-buffer buf)
	  (let ((res (call-process "jhead" nil '(t t) t "-cl" comment filename)))
	    (goto-char (point-max))
	    (skip-chars-backward "\n\t ")
	    (delete-region (point) (point-max))
	    (goto-char (point-min))
	    (if (and (= res 0) (looking-at "^Modified: "))
		(message "%s" (buffer-string))
	      (error "Couldn't write JFIF comment to %s: %s" filename (buffer-string)))))
      (when buf
	(kill-buffer buf)))))

(defun jdired-assert-mode (mode)
  "Make sure we're in the mode we think we're in."
  (unless (eq major-mode mode)
    (error "Sorry, this command is only useful in %s" (symbol-name mode))))

(defun jdired (dir)
  "JPG Dired hack, for editing JPG comments.
Looks for *.jpg files in the specified directory."
  (interactive "DDirectory name: ")
  (let ((debug-on-error t))
    (jdired-setup (directory-files dir t "\.jpg$"))))

(defun jdired-setup (files)
  "Set up a JDired buffer given a list of (absolute) names of JPG files.
This is a separate function from (jdired) because it doesn't really
care whether the files are all in the same directory or not,
everything is done via absolute filenames.  So feel free to construct
some horrible Lisp expression that generates a list of every JPG file
on your machine and feed it to this function if for some reason that
seems like an interesting thing to do."
  (let ((buffer (get-buffer-create "*jdired*")))
    (set-buffer buffer)
    (jdired-mode)
    (set (make-local-variable 'jdired-forward)
	 (mapcar
	  (function
	   (lambda (file)
	     (let ((sym (make-symbol file)))
	       (put sym :image (jdired-get-image-thumbnail file))
	       (put sym :original-comment (jdired-get-image-comment file))
	       (put sym :buffer buffer)
	       (put sym :comment (get sym :original-comment))
	       sym)))
	  files))
    (set (make-local-variable 'jdired-backward)
	 (reverse jdired-forward))
    (set (make-local-variable 'jdired-completions)
	 (mapcar (function (lambda (x) (cons (symbol-name x) x)))
		 jdired-forward))
    (setq buffer-read-only t)
    (jdired-format-buffer (car jdired-forward))
    (set-buffer-modified-p nil)
    (switch-to-buffer buffer)))

(defun jdired-format-buffer (cur)
  "Generate contents of a JDired buffer.
CUR indicates the image to which the cursor should be set."
  (let ((buffer-read-only nil))
    (erase-buffer)
    (mapc (function
	   (lambda (sym)
	     (let ((start (point)))
	       (unless (bolp)
		 (insert "\n"))
	       (put sym :cursor (point))
	       (insert-image (get sym :image))
	       (insert "\n"
		       (symbol-name sym) "\n\n"
		       (get sym :comment) "\n\n")
	       (put-text-property start (point) :jdired-obj sym))))
	  jdired-forward)
    (jdired-goto cur)))

(defvar jdired-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "n" 'jdired-next)
    (define-key map "p" 'jdired-previous)
    (define-key map "f" 'jdired-next)
    (define-key map "b" 'jdired-previous)
    (define-key map "e" 'jdired-edit)
    (define-key map "q" 'jdired-quit)
    (define-key map "s" 'jdired-save)
    (define-key map "j" 'jdired-jump)
    (define-key map "v" 'jdired-view)
    map)
  "Mode map for jdired-mode.")

(defun jdired-mode ()
  "Mode for fiddling with comments of a list of JPG files.
\\{jdired-mode-map}"
  (kill-all-local-variables)
  (use-local-map jdired-mode-map)
  (setq major-mode 'jdired-mode)
  (setq mode-name "JDired"))

(defun jdired-current ()
  "Figure out at which image the cursor is pointing."
  (jdired-assert-mode 'jdired-mode)
  (or (get-text-property (point) :jdired-obj)
      (error "Sorry, no image object at this buffer location")))

(defun jdired-goto (sym)
  "Set cursor to a particular image."
  (jdired-assert-mode 'jdired-mode)
  (goto-char (get sym :cursor)))

(defun jdired-view ()
  "Run XV on the full-sized version of the current image."
  (interactive)
  (let ((name (symbol-name (jdired-current))))
    (message "Running xv %s" name)
    (call-process "xv" nil 0 nil name)))

(defun jdired-jump ()
  "Jump to a particular image."
  (interactive)
  (jdired-assert-mode 'jdired-mode)
  (let ((sym (cdr (assoc (completing-read "Go to image: "
					  jdired-completions nil t)
			 jdired-completions))))
    (unless sym
      (error "Sorry, can't figure out where you want me to go"))
    (jdired-goto sym)))

(defun jdired-next ()
  "Move to next image."
  (interactive)
  (let ((next (cadr (memq (jdired-current) jdired-forward))))
    (unless next
      (error "No next image"))
    (jdired-goto next)))

(defun jdired-previous ()
  "Move to previous image."
  (interactive)
  (let ((prev (cadr (memq (jdired-current) jdired-backward))))
    (unless prev
      (error "No previous image"))
    (jdired-goto prev)))

(defun jdired-quit ()
  "Leave JDired mode."
  (interactive)
  (jdired-assert-mode 'jdired-mode)
  (when (or (not (buffer-modified-p))
	    (yes-or-no-p "Comments have been modified, sure you want to exit JDired? "))
    (kill-buffer (current-buffer))))

(defun jdired-set-buffer-modified-p ()
  "Figure out whether any of the comments in the buffer have been modified."
  (jdired-assert-mode 'jdired-mode)
  (set-buffer-modified-p
   (delq nil
	 (mapcar
	  (function
	   (lambda (sym)
	     (not (string-equal (get sym :original-comment) (get sym :comment)))))
	  jdired-forward))))

(defun jdired-save ()
  "Save any changed comments."
  (interactive)
  (jdired-assert-mode 'jdired-mode)
  (mapc (function
	 (lambda (sym)
	   (unless (string-equal (get sym :original-comment) (get sym :comment))
	     (jdired-goto sym)
	     (when (y-or-n-p (concat "Save new comment for " (symbol-name sym) "? "))
	       (jdired-put-image-comment (symbol-name sym) (get sym :comment))
	       (put sym :original-comment (jdired-get-image-comment (symbol-name sym)))))))
	jdired-forward)
  (jdired-set-buffer-modified-p))

(defun jdired-edit ()
  "Edit the current comment."
  (interactive)
  (let ((sym (jdired-current))
	(config (current-window-configuration)))
    (pop-to-buffer (generate-new-buffer (concat "JDired-edit: " (symbol-name sym))))
    (jdired-edit-mode)
    (set (make-local-variable 'jdired-obj) sym)
    (set (make-local-variable 'jdired-window-config) config)
    (insert (get sym :comment))
    (set-buffer-modified-p nil)))

(defvar jdired-edit-mode-hook nil
  "Mode hook for jdired-edit-mode.")

(defvar jdired-edit-mode-map
  (let ((map (copy-keymap text-mode-map)))
    (define-key map "\C-C\C-C" 'jdired-edit-exit)
    (define-key map "\C-C\C-y" 'jdired-edit-yank)
    map)
  "Mode map for jdired-edit-mode.")

(defun jdired-edit-mode ()
  "Mode for editing comments in JDired.
\\{jdired-edit-mode-map}
Turning on jdired-edit-mode runs the hooks text-mode-hook and jdired-edit-mode-hook,
in that order.  See run-hooks for details."
  (kill-all-local-variables)
  (use-local-map jdired-edit-mode-map)
  (setq major-mode 'jdired-edit-mode)
  (setq mode-name "JDired-edit")
  (setq local-abbrev-table text-mode-abbrev-table)
  (set-syntax-table text-mode-syntax-table)
  (run-hooks 'text-mode-hook 'jdired-edit-mode-hook))

(defun jdired-edit-yank ()
  "Yank the current comment into the buffer."
  ;; Should this yank the original comment instead?
  (interactive)
  (jdired-assert-mode 'jdired-edit-mode)
  (insert (get jdired-obj :comment)))

(defun jdired-edit-exit ()
  "Finish editing a comment."
  (interactive)
  (jdired-assert-mode 'jdired-edit-mode)
  (goto-char (point-max))
  (skip-chars-backward "\n\t ")
  (let ((sym jdired-obj))
    (put sym :comment (buffer-substring (point-min) (point)))
    (set-window-configuration
     (prog1 jdired-window-config
       (kill-buffer (current-buffer))))
    (set-buffer (get sym :buffer))
    (jdired-format-buffer sym)
    (jdired-set-buffer-modified-p)))

(provide 'jdired)