X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7e76cdd807ee8253c2115ca9cdcd457f98ef01ac..b336bfcdf39f1e4d35bff4a7bd01d3b4bca8f516:/lisp/image-dired.el

diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index d520d99ea1..f006e2e9ed 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -1,6 +1,6 @@
 ;;; image-dired.el --- use dired to browse and manipulate your images
 ;;
-;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 ;;
 ;; Version: 0.4.11
 ;; Keywords: multimedia
@@ -8,10 +8,10 @@
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +19,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 ;;
@@ -166,7 +164,7 @@
   :prefix "image-dired-"
   :group 'multimedia)
 
-(defcustom image-dired-dir (concat user-emacs-directory "image-dired/")
+(defcustom image-dired-dir (locate-user-emacs-file "image-dired/")
   "Directory where thumbnail images are stored."
   :type 'string
   :group 'image-dired)
@@ -188,19 +186,19 @@ that allows sharing of thumbnails across different programs."
   :group 'image-dired)
 
 (defcustom image-dired-db-file
-  (concat user-emacs-directory "image-dired/.image-dired_db")
+  (locate-user-emacs-file "image-dired/.image-dired_db")
   "Database file where file names and their associated tags are stored."
   :type 'string
   :group 'image-dired)
 
 (defcustom image-dired-temp-image-file
-  (concat user-emacs-directory "image-dired/.image-dired_temp")
+  (locate-user-emacs-file "image-dired/.image-dired_temp")
   "Name of temporary image file used by various commands."
   :type 'string
   :group 'image-dired)
 
 (defcustom image-dired-gallery-dir
-  (concat user-emacs-directory "image-dired/.image-dired_gallery")
+  (locate-user-emacs-file "image-dired/.image-dired_gallery")
   "Directory to store generated gallery html pages.
 This path needs to be \"shared\" to the public so that it can access
 the index.html page that image-dired creates."
@@ -231,7 +229,7 @@ Used together with `image-dired-cmd-create-thumbnail-options'."
   :group 'image-dired)
 
 (defcustom image-dired-cmd-create-thumbnail-options
-  "%p -size %wx%h \"%f\" -resize %wx%h -strip jpeg:\"%t\""
+  "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\""
   "Format of command used to create thumbnail image.
 Available options are %p which is replaced by
 `image-dired-cmd-create-thumbnail-program', %w which is replaced by
@@ -249,7 +247,7 @@ Used together with `image-dired-cmd-create-temp-image-options'."
   :group 'image-dired)
 
 (defcustom image-dired-cmd-create-temp-image-options
-  "%p -size %wx%h \"%f\" -resize %wx%h -strip jpeg:\"%t\""
+  "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip jpeg:\"%t\""
   "Format of command used to create temporary image for display window.
 Available options are %p which is replaced by
 `image-dired-cmd-create-temp-image-program', %w and %h which is replaced by
@@ -282,7 +280,7 @@ with the information required by the Thumbnail Managing Standard."
       "-set \"Thumb::URI\" \"file://%f\" "
       "-set \"Description\" \"Thumbnail of file://%f\" "
       "-set \"Software\" \"" (emacs-version) "\" "))
-   "-thumbnail %wx%h png:\"%t\""
+   "-thumbnail \"%wx%h>\" png:\"%t\""
    (if image-dired-cmd-pngnq-program
        (concat
         " ; " image-dired-cmd-pngnq-program " -f \"%t\""
@@ -345,7 +343,7 @@ original image file name and %t which is replaced by
   :group 'image-dired)
 
 (defcustom image-dired-temp-rotate-image-file
-  (concat user-emacs-directory "image-dired/.image-dired_rotate_temp")
+  (locate-user-emacs-file "image-dired/.image-dired_rotate_temp")
   "Temporary file for rotate operations."
   :type 'string
   :group 'image-dired)
@@ -368,8 +366,8 @@ Used together with `image-dired-cmd-write-exif-data-options'."
   "%p -%t=\"%v\" \"%f\""
   "Format of command used to write EXIF data.
 Available options are %p which is replaced by
-`image-dired-cmd-write-exif-data-program', %f which is replaced by the
-image file name, %t which is replaced by the tag name and %v
+`image-dired-cmd-write-exif-data-program', %f which is replaced by
+the image file name, %t which is replaced by the tag name and %v
 which is replaced by the tag value."
   :type 'string
   :group 'image-dired)
@@ -399,7 +397,8 @@ Used by `image-dired-gallery-generate' to leave out \"hidden\" images."
 
 (defcustom image-dired-thumb-size (if (eq 'standard image-dired-thumbnail-storage) 128 100)
   "Size of thumbnails, in pixels.
-This is the default size for both `image-dired-thumb-width' and `image-dired-thumb-height'."
+This is the default size for both `image-dired-thumb-width'
+and `image-dired-thumb-height'."
   :type 'integer
   :group 'image-dired)
 
@@ -426,11 +425,11 @@ This is where you see the cursor."
 
 (defcustom image-dired-line-up-method 'dynamic
   "Default method for line-up of thumbnails in thumbnail buffer.
-Used by `image-dired-display-thumbs' and other functions that needs to
-line-up thumbnails.  Dynamic means to use the available width of the
-window containing the thumbnail buffer, Fixed means to use
-`image-dired-thumbs-per-row', Interactive is for asking the user, and No
-line-up means that no automatic line-up will be done."
+Used by `image-dired-display-thumbs' and other functions that needs
+to line-up thumbnails.  Dynamic means to use the available width of
+the window containing the thumbnail buffer, Fixed means to use
+`image-dired-thumbs-per-row', Interactive is for asking the user,
+and No line-up means that no automatic line-up will be done."
   :type '(choice :tag "Default line-up method"
                  (const :tag "Dynamic" dynamic)
 		 (const :tag "Fixed" fixed)
@@ -511,7 +510,7 @@ Used by `image-dired-copy-with-exif-file-name'."
   :group 'image-dired)
 
 (defcustom image-dired-show-all-from-dir-max-files 50
-  "Maximum number of files to show using `image-dired-show-all-from-dir'.
+  "Maximum number of files to show using `image-dired-show-all-from-dir'
 before warning the user."
   :type 'integer
   :group 'image-dired)
@@ -657,7 +656,7 @@ according to the Thumbnail Managing Standard."
 
 (defun image-dired-dired-after-readin-hook ()
   "Relocate existing thumbnail overlays in dired buffer after reverting.
-Move them to their corresponding files if they are still exist.
+Move them to their corresponding files if they still exist.
 Otherwise, delete overlays."
   (mapc (lambda (overlay)
           (when (overlay-get overlay 'put-image)
@@ -802,7 +801,7 @@ you have the dired buffer in the left window and the
 With optional argument APPEND, append thumbnail to thumbnail buffer
 instead of erasing it first.
 
-Option argument DO-NOT-POP controls if `pop-to-buffer' should be
+Optional argument DO-NOT-POP controls if `pop-to-buffer' should be
 used or not.  If non-nil, use `display-buffer' instead of
 `pop-to-buffer'.  This is used from functions like
 `image-dired-next-line-and-display' and
@@ -820,7 +819,7 @@ thumbnail buffer to be selected."
         (if (not append)
             (erase-buffer)
           (goto-char (point-max)))
-        (mapcar
+        (mapc
          (lambda (curr-file)
            (setq thumb-name (image-dired-thumb-name curr-file))
            (if (and (not (file-exists-p thumb-name))
@@ -869,11 +868,28 @@ displayed."
 ;;;###autoload
 (defalias 'tumme 'image-dired-show-all-from-dir)
 
+(defun image-dired-sane-db-file ()
+  "Check if `image-dired-db-file' exists.
+If not, try to create it (including any parent directories).
+Signal error if there are problems creating it."
+  (or (file-exists-p image-dired-db-file)
+      (let (dir buf)
+        (unless (file-directory-p (setq dir (file-name-directory
+                                             image-dired-db-file)))
+          (make-directory dir t))
+        (with-current-buffer (setq buf (create-file-buffer
+                                        image-dired-db-file))
+          (write-file image-dired-db-file))
+        (kill-buffer buf)
+        (file-exists-p image-dired-db-file))
+      (error "Could not create %s" image-dired-db-file)))
+
 (defun image-dired-write-tags (file-tags)
   "Write file tags to database.
-Write each file and tag in FILE-TAGS to the database.  FILE-TAGS
-is an alist in the following form:
+Write each file and tag in FILE-TAGS to the database.
+FILE-TAGS is an alist in the following form:
  ((FILE . TAG) ... )"
+  (image-dired-sane-db-file)
   (let (end file tag)
     (with-temp-file image-dired-db-file
       (insert-file-contents image-dired-db-file)
@@ -893,6 +909,7 @@ is an alist in the following form:
 
 (defun image-dired-remove-tag (files tag)
   "For all FILES, remove TAG from the image database."
+  (image-dired-sane-db-file)
   (save-excursion
     (let (end buf start)
       (setq buf (find-file image-dired-db-file))
@@ -900,7 +917,7 @@ is an alist in the following form:
           (if (stringp files)
               (setq files (list files))
             (error "Files must be a string or a list of strings!")))
-      (mapcar
+      (mapc
        (lambda (file)
          (goto-char (point-min))
          (when (search-forward-regexp
@@ -927,6 +944,7 @@ is an alist in the following form:
 
 (defun image-dired-list-tags (file)
   "Read all tags for image FILE from the image database."
+  (image-dired-sane-db-file)
   (save-excursion
     (let (end buf (tags ""))
       (setq buf (find-file image-dired-db-file))
@@ -1004,19 +1022,16 @@ With prefix argument ARG, remove tag from file at point."
 
 (defun image-dired-track-original-file ()
   "Track the original file in the associated dired buffer.
-See documentation for `image-dired-toggle-movement-tracking'.  Interactive
-use only useful if `image-dired-track-movement' is nil."
+See documentation for `image-dired-toggle-movement-tracking'.
+Interactive use only useful if `image-dired-track-movement' is nil."
   (interactive)
   (let ((old-buf (current-buffer))
         (dired-buf (image-dired-associated-dired-buffer))
         (file-name (image-dired-original-file-name)))
     (when (and (buffer-live-p dired-buf) file-name)
-      (setq file-name (file-name-nondirectory file-name))
       (set-buffer dired-buf)
-      (goto-char (point-min))
-      (if (not (search-forward file-name nil t))
+      (if (not (dired-goto-file file-name))
           (message "Could not track file")
-        (dired-move-to-filename)
         (set-window-point
          (image-dired-get-buffer-window dired-buf) (point)))
       (set-buffer old-buf))))
@@ -1033,8 +1048,8 @@ position in the other buffer."
 
 (defun image-dired-track-thumbnail ()
   "Track current dired file's thumb in `image-dired-thumbnail-buffer'.
-This is almost the same as what `image-dired-track-original-file' does, but
-the other way around."
+This is almost the same as what `image-dired-track-original-file' does,
+but the other way around."
   (let ((file (dired-get-filename))
         (old-buf (current-buffer))
         prop-val found)
@@ -1057,8 +1072,8 @@ the other way around."
 
 (defun image-dired-dired-next-line (&optional arg)
   "Call `dired-next-line', then track thumbnail.
-This can safely replace `dired-next-line'.  With prefix argument, move
-ARG lines."
+This can safely replace `dired-next-line'.
+With prefix argument, move ARG lines."
   (interactive "P")
   (dired-next-line (or arg 1))
   (if image-dired-track-movement
@@ -1066,8 +1081,8 @@ ARG lines."
 
 (defun image-dired-dired-previous-line (&optional arg)
   "Call `dired-previous-line', then track thumbnail.
-This can safely replace `dired-previous-line'.  With prefix argument,
-move ARG lines."
+This can safely replace `dired-previous-line'.
+With prefix argument, move ARG lines."
   (interactive "P")
   (dired-previous-line (or arg 1))
   (if image-dired-track-movement
@@ -1118,7 +1133,7 @@ image."
 (defun image-dired-next-line ()
   "Move to next line and display properties."
   (interactive)
-  (next-line 1)
+  (forward-line 1)
   ;; If we end up in an empty spot, back up to the next thumbnail.
   (if (not (image-dired-image-at-point-p))
       (image-dired-backward-image))
@@ -1130,7 +1145,7 @@ image."
 (defun image-dired-previous-line ()
   "Move to previous line and display properties."
   (interactive)
-  (previous-line 1)
+  (forward-line -1)
   ;; If we end up in an empty spot, back up to the next
   ;; thumbnail. This should only happen if the user deleted a
   ;; thumbnail and did not refresh, so it is not very common. But we
@@ -1144,7 +1159,7 @@ image."
 (defun image-dired-format-properties-string (buf file props comment)
   "Format display properties.
 BUF is the associated dired buffer, FILE is the original image file
-name, PROPS is a list of tags and COMMENT is the image files's
+name, PROPS is a list of tags and COMMENT is the image file's
 comment."
   (format-spec
    image-dired-display-properties-format
@@ -1165,7 +1180,7 @@ comment."
                     ", "))
             (comment (get-text-property (point) 'comment)))
         (if file-name
-            (message
+             (message "%s"
              (image-dired-format-properties-string
               dired-buf
               file-name
@@ -1180,8 +1195,7 @@ comment."
 
 (defun image-dired-modify-mark-on-thumb-original-file (command)
   "Modify mark in dired buffer.
-This is quite ugly but I don't know how to implemented in a better
-way.  COMMAND is one of 'mark for marking file in dired, 'unmark for
+COMMAND is one of 'mark for marking file in dired, 'unmark for
 unmarking file in dired or 'flag for flagging file for delete in
 dired."
   (let ((file-name (image-dired-original-file-name))
@@ -1189,10 +1203,8 @@ dired."
     (if (not (and dired-buf file-name))
         (message "No image, or image with correct properties, at point.")
     (with-current-buffer dired-buf
-        (message file-name)
-        (setq file-name (file-name-nondirectory file-name))
-        (goto-char (point-min))
-        (if (search-forward file-name nil t)
+        (message "%s" file-name)
+        (if (dired-goto-file file-name)
             (cond ((eq command 'mark) (dired-mark 1))
                   ((eq command 'unmark) (dired-unmark 1))
                   ((eq command 'toggle)
@@ -1572,10 +1584,12 @@ Note that n, p and <down> and <up> will be hijacked and bound to
     [menu-bar image-dired image-dired-next-line-and-display]
     '("Display thumb for next file" . image-dired-next-line-and-display)))
 
+(declare-function clear-image-cache "image.c" (&optional filter))
+
 (defun image-dired-create-thumbs (&optional arg)
   "Create thumbnail images for all marked files in dired.
 With prefix argument ARG, create thumbnails even if they already exist
-\(i.e.  use this to refresh your thumbnails)."
+\(i.e. use this to refresh your thumbnails)."
   (interactive "P")
   (let (curr-file thumb-name files count)
     (setq files (dired-get-marked-files))
@@ -1835,7 +1849,7 @@ With prefix argument ARG, display image in its original size."
   (image-dired-display-image (dired-get-filename) arg))
 
 (defun image-dired-image-at-point-p ()
-  "Return true if there is a image-dired thumbnail at point."
+  "Return true if there is an image-dired thumbnail at point."
   (get-text-property (point) 'image-dired-thumbnail))
 
 (defun image-dired-rotate-thumbnail (degrees)
@@ -2035,9 +2049,10 @@ function.  The result is a couple of new files in
 
 (defun image-dired-write-comments (file-comments)
   "Write file comments to database.
-Write file comments to one or more files.  FILE-COMMENTS is an alist on
-the following form:
+Write file comments to one or more files.
+FILE-COMMENTS is an alist on the following form:
  ((FILE . COMMENT) ... )"
+  (image-dired-sane-db-file)
   (let (end comment-beg-pos comment-end-pos file comment)
     (with-temp-file image-dired-db-file
       (insert-file-contents image-dired-db-file)
@@ -2098,8 +2113,7 @@ the following form:
 
 (defun image-dired-read-comment (&optional file)
   "Read comment for an image.
-Read comment for an image, optionally using old comment from FILE
-as initial value."
+Optionally use old comment from FILE as initial value."
   (let ((comment
          (read-string
           "Comment: "
@@ -2108,6 +2122,7 @@ as initial value."
 
 (defun image-dired-get-comment (file)
   "Get comment for file FILE."
+  (image-dired-sane-db-file)
   (save-excursion
     (let (end buf comment-beg-pos comment-end-pos comment)
       (setq buf (find-file image-dired-db-file))
@@ -2134,8 +2149,9 @@ A `tag' is a keyword, a piece of meta data, associated with an
 image file and stored in image-dired's database file.  This command
 lets you input a regexp and this will be matched against all tags
 on all image files in the database file.  The files that have a
-matching tags will be marked in the dired buffer."
+matching tag will be marked in the dired buffer."
   (interactive)
+  (image-dired-sane-db-file)
   (let ((tag (read-string "Mark tagged files (regexp): "))
         (hits 0)
         files buf)
@@ -2148,7 +2164,7 @@ matching tags will be marked in the dired buffer."
         (setq files (append (list (match-string 1)) files)))
       (kill-buffer buf)
       ;; Mark files
-      (mapcar
+      (mapc
        ;; I tried using `dired-mark-files-regexp' but it was
        ;; waaaay to slow.
        (lambda (curr-file)
@@ -2217,7 +2233,7 @@ non-nil."
                  ", "))
          (comment (image-dired-get-comment file)))
     (if file-name
-        (message
+        (message "%s"
          (image-dired-format-properties-string
           dired-buf
           file-name
@@ -2300,6 +2316,7 @@ image-dired-file-comment-list:
 
 (defun image-dired-create-gallery-lists ()
   "Create temporary lists used by `image-dired-gallery-generate'."
+  (image-dired-sane-db-file)
   (let ((buf (find-file image-dired-db-file))
         end beg file row-tags)
     (setq image-dired-tag-file-list nil)
@@ -2343,7 +2360,7 @@ image-dired-file-comment-list:
   "Generate gallery pages.
 First we create a couple of Lisp structures from the database to make
 it easier to generate, then HTML-files are created in
-`image-dired-gallery-dir'"
+`image-dired-gallery-dir'."
   (interactive)
   (if (eq 'per-directory image-dired-thumbnail-storage)
       (error "Currently, gallery generation is not supported \