]> code.delx.au - gnu-emacs/blobdiff - lisp/image-dired.el
Merge from mainline.
[gnu-emacs] / lisp / image-dired.el
index 730dd1aadc80a7b7324bb11014788d3a60ab9d8a..31a6aed7206c800251d20ac3f95f87e3c78f61b0 100644 (file)
@@ -1,6 +1,6 @@
 ;;; image-dired.el --- use dired to browse and manipulate your images
 ;;
-;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
 ;;
 ;; Version: 0.4.11
 ;; Keywords: multimedia
 (require 'widget)
 
 (eval-when-compile
+  (require 'cl)
   (require 'wid-edit))
 
 (defgroup image-dired nil
@@ -383,7 +384,7 @@ Used together with `image-dired-cmd-read-exif-data-program-options'."
   "%p -s -s -s -%t \"%f\""
   "Format of command used to read EXIF data.
 Available options are %p which is replaced by
-`image-dired-cmd-write-exif-data-options', %f which is replaced
+`image-dired-cmd-write-exif-data-program', %f which is replaced
 by the image file name and %t which is replaced by the tag name."
   :type 'string
   :group 'image-dired)
@@ -550,7 +551,7 @@ Create the thumbnails directory if it does not exist."
     ))
 
 (defun image-dired-insert-thumbnail (file original-file-name
-                                    associated-dired-buffer)
+                                     associated-dired-buffer)
   "Insert thumbnail image FILE.
 Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER."
   (let (beg end)
@@ -632,26 +633,32 @@ according to the Thumbnail Managing Standard."
     (call-process shell-file-name nil nil nil shell-command-switch command)))
 
 ;;;###autoload
-(defun image-dired-dired-insert-marked-thumbs ()
-  "Insert thumbnails before file names of marked files in the dired buffer."
-  (interactive)
+(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
+  "Toggle thumbnails in front of file names in the dired buffer.
+If no marked file could be found, insert or hide thumbnails on the
+current line.  ARG, if non-nil, specifies the files to use instead
+of the marked files.  If ARG is an integer, use the next ARG (or
+previous -ARG, if ARG<0) files."
+  (interactive "P")
   (dired-map-over-marks
-   (let* ((image-pos (dired-move-to-filename))
-          (image-file (dired-get-filename))
-          (thumb-file (image-dired-get-thumbnail-image image-file))
+   (let* ((image-pos  (dired-move-to-filename))
+          (image-file (dired-get-filename nil t))
+          thumb-file
           overlay)
-     ;; If image is not already added, then add it.
-     (unless (delq nil (mapcar (lambda (o) (overlay-get o 'put-image))
-                               ;; Can't use (overlays-at (point)), BUG?
-                               (overlays-in (point) (1+ (point)))))
-       (put-image thumb-file image-pos)
-       (setq
-       overlay
-       (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o))
-                              (overlays-in (point) (1+ (point)))))))
-       (overlay-put overlay 'image-file image-file)
-       (overlay-put overlay 'thumb-file thumb-file)))
-   nil)
+     (when (and image-file (string-match-p (image-file-name-regexp) image-file))
+       (setq thumb-file (image-dired-get-thumbnail-image image-file))
+       ;; If image is not already added, then add it.
+       (let ((cur-ov (overlays-in (point) (1+ (point)))))
+         (if cur-ov
+             (delete-overlay (car cur-ov))
+          (put-image thumb-file image-pos)
+          (setq overlay (loop for o in (overlays-in (point) (1+ (point)))
+                              when (overlay-get o 'put-image) collect o into ov
+                              finally return (car ov)))
+          (overlay-put overlay 'image-file image-file)
+          (overlay-put overlay 'thumb-file thumb-file)))))
+   arg             ; Show or hide image on ARG next files.
+   'show-progress) ; Update dired display after each image is updated.
   (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t))
 
 (defun image-dired-dired-after-readin-hook ()
@@ -809,7 +816,7 @@ used or not.  If non-nil, use `display-buffer' instead of
 thumbnail buffer to be selected."
   (interactive "P")
   (let ((buf (image-dired-create-thumbnail-buffer))
-        curr-file thumb-name files count dired-buf beg)
+        thumb-name files dired-buf)
     (if arg
         (setq files (list (dired-get-filename)))
       (setq files (dired-get-marked-files)))
@@ -911,7 +918,7 @@ FILE-TAGS is an alist in the following form:
   "For all FILES, remove TAG from the image database."
   (image-dired-sane-db-file)
   (save-excursion
-    (let (end buf start)
+    (let (end buf)
       (setq buf (find-file image-dired-db-file))
       (if (not (listp files))
           (if (stringp files)
@@ -937,7 +944,7 @@ FILE-TAGS is an alist in the following form:
                ;; If on empty line at end of buffer
                (when (and (eobp)
                           (looking-at "^$"))
-                 (delete-backward-char 1))))))
+                 (delete-char -1))))))
        files)
       (save-buffer)
       (kill-buffer buf))))
@@ -967,7 +974,7 @@ FILE-TAGS is an alist in the following form:
   "Tag marked file(s) in dired.  With prefix ARG, tag file at point."
   (interactive "P")
   (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))
-        curr-file files)
+        files)
     (if arg
         (setq files (list (dired-get-filename)))
       (setq files (dired-get-marked-files)))
@@ -1591,7 +1598,7 @@ Note that n, p and <down> and <up> will be hijacked and bound to
 With prefix argument ARG, create thumbnails even if they already exist
 \(i.e. use this to refresh your thumbnails)."
   (interactive "P")
-  (let (curr-file thumb-name files count)
+  (let (thumb-name files)
     (setq files (dired-get-marked-files))
     (mapcar
      (lambda (curr-file)
@@ -1899,7 +1906,7 @@ overwritten.  This confirmation can be turned off using
   (if (not (image-dired-image-at-point-p))
       (message "No image at point")
     (let ((file (image-dired-original-file-name))
-          command temp-file)
+          command)
       (if (not (string-match "\.[jJ][pP[eE]?[gG]$" file))
           (error "Only JPEG images can be rotated!"))
       (setq command (format-spec
@@ -2187,26 +2194,25 @@ matching tag will be marked in the dired buffer."
 Track this in associated dired buffer if `image-dired-track-movement' is
 non-nil."
   (interactive "e")
-  (let (file)
-    (mouse-set-point event)
-    (goto-char (posn-point (event-end event)))
-    (setq file (image-dired-original-file-name))
-    (if image-dired-track-movement
-        (image-dired-track-original-file))
-    (image-dired-create-display-image-buffer)
-    (display-buffer image-dired-display-image-buffer)
-    (image-dired-display-image file)))
+  (mouse-set-point event)
+  (goto-char (posn-point (event-end event)))
+  (let ((file (image-dired-original-file-name)))
+    (when file
+      (if image-dired-track-movement
+         (image-dired-track-original-file))
+      (image-dired-create-display-image-buffer)
+      (display-buffer image-dired-display-image-buffer)
+      (image-dired-display-image file))))
 
 (defun image-dired-mouse-select-thumbnail (event)
   "Use mouse EVENT to select thumbnail image.
 Track this in associated dired buffer if `image-dired-track-movement' is
 non-nil."
   (interactive "e")
-  (let (file)
-    (mouse-set-point event)
-    (goto-char (posn-point (event-end event)))
-    (if image-dired-track-movement
-        (image-dired-track-original-file)))
+  (mouse-set-point event)
+  (goto-char (posn-point (event-end event)))
+  (if image-dired-track-movement
+      (image-dired-track-original-file))
   (image-dired-display-thumb-properties))
 
 (defun image-dired-mouse-toggle-mark (event)
@@ -2214,11 +2220,10 @@ non-nil."
 Track this in associated dired buffer if `image-dired-track-movement' is
 non-nil."
   (interactive "e")
-  (let (file)
-    (mouse-set-point event)
-    (goto-char (posn-point (event-end event)))
-    (if image-dired-track-movement
-        (image-dired-track-original-file)))
+  (mouse-set-point event)
+  (goto-char (posn-point (event-end event)))
+  (if image-dired-track-movement
+      (image-dired-track-original-file))
   (image-dired-toggle-mark-thumb-original-file))
 
 (defun image-dired-dired-display-properties ()
@@ -2367,7 +2372,7 @@ it easier to generate, then HTML-files are created in
 when using per-directory thumbnail file storage"))
   (image-dired-create-gallery-lists)
   (let ((tags image-dired-tag-file-list)
-        count curr tag index-buf tag-buf
+        count tag index-buf tag-buf
         comment file-tags tag-link tag-link-list)
     ;; Make sure gallery root exist
     (if (file-exists-p image-dired-gallery-dir)
@@ -2526,7 +2531,7 @@ the operation by activating the Cancel button.\n\n")
     (widget-insert "\n")
     (widget-create 'push-button
                  :notify
-                 (lambda (&rest ignore)
+                 (lambda (&rest _ignore)
                    (image-dired-save-information-from-widgets)
                    (bury-buffer)
                    (message "Done."))
@@ -2534,7 +2539,7 @@ the operation by activating the Cancel button.\n\n")
     (widget-insert " ")
     (widget-create 'push-button
                    :notify
-                   (lambda (&rest ignore)
+                   (lambda (&rest _ignore)
                      (bury-buffer)
                      (message "Operation canceled."))
                    "Cancel")
@@ -2615,5 +2620,4 @@ tags to their respective image file.  Internal function used by
 
 (provide 'image-dired)
 
-;; arch-tag: 9d11411d-331f-4380-8b44-8adfe3a0343e
 ;;; image-dired.el ends here