Fix quoting problem in cc-engine debug message

[gnu-emacs] / lisp / image-dired.el

diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index a74ddd312d5f708cb272f3f4072bc92550e8eae1..a8274f52521913136025cd3b2431e6bb62be8011 100644 (file)
--- 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
 ;;
 ;;; 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-2016 Free Software Foundation, Inc.

 ;;
 ;; Version: 0.4.11
 ;; Keywords: multimedia
 ;;
 ;; Version: 0.4.11
 ;; Keywords: multimedia


@@ -156,8 +156,9 @@
 (require 'format-spec)
 (require 'widget)
 
 (require 'format-spec)
 (require 'widget)
 

+(require 'cl-lib)
+

 (eval-when-compile
 (eval-when-compile

-  (require 'cl)

   (require 'wid-edit))
 
 (defgroup image-dired nil
   (require 'wid-edit))
 
 (defgroup image-dired nil


@@ -187,19 +188,19 @@ that allows sharing of thumbnails across different programs."
   :group 'image-dired)
 
 (defcustom image-dired-db-file
   :group 'image-dired)
 
 (defcustom image-dired-db-file

-  (locate-user-emacs-file "image-dired/.image-dired_db")
+  (expand-file-name ".image-dired_db" image-dired-dir)

   "Database file where file names and their associated tags are stored."
   :type 'string
   :group 'image-dired)
 
 (defcustom image-dired-temp-image-file
   "Database file where file names and their associated tags are stored."
   :type 'string
   :group 'image-dired)
 
 (defcustom image-dired-temp-image-file

-  (locate-user-emacs-file "image-dired/.image-dired_temp")
+  (expand-file-name ".image-dired_temp" image-dired-dir)

   "Name of temporary image file used by various commands."
   :type 'string
   :group 'image-dired)
 
 (defcustom image-dired-gallery-dir
   "Name of temporary image file used by various commands."
   :type 'string
   :group 'image-dired)
 
 (defcustom image-dired-gallery-dir

-  (locate-user-emacs-file "image-dired/.image-dired_gallery")
+  (expand-file-name ".image-dired_gallery" image-dired-dir)

   "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."
   "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."


@@ -344,7 +345,7 @@ original image file name and %t which is replaced by
   :group 'image-dired)
 
 (defcustom image-dired-temp-rotate-image-file
   :group 'image-dired)
 
 (defcustom image-dired-temp-rotate-image-file

-  (locate-user-emacs-file "image-dired/.image-dired_rotate_temp")
+  (expand-file-name ".image-dired_rotate_temp" image-dired-dir)

   "Temporary file for rotate operations."
   :type 'string
   :group 'image-dired)
   "Temporary file for rotate operations."
   :type 'string
   :group 'image-dired)


@@ -384,7 +385,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
   "%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)
 by the image file name and %t which is replaced by the tag name."
   :type 'string
   :group 'image-dired)


@@ -469,7 +470,7 @@ For more information, see the documentation for
 If non-nil, using `image-dired-next-line-and-display' and
 `image-dired-previous-line-and-display' will leave a trail of thumbnail
 images in the thumbnail buffer.  If you enable this and want to clean
 If non-nil, using `image-dired-next-line-and-display' and
 `image-dired-previous-line-and-display' will leave a trail of thumbnail
 images in the thumbnail buffer.  If you enable this and want to clean

-the thumbnail buffer because it is filled with too many thumbmnails,
+the thumbnail buffer because it is filled with too many thumbnails,

 just call `image-dired-display-thumb' to display only the image at point.
 This value can be toggled using `image-dired-toggle-append-browsing'."
   :type 'boolean
 just call `image-dired-display-thumb' to display only the image at point.
 This value can be toggled using `image-dired-toggle-append-browsing'."
   :type 'boolean


@@ -516,6 +517,14 @@ before warning the user."
   :type 'integer
   :group 'image-dired)
 
   :type 'integer
   :group 'image-dired)
 

+(defmacro image-dired--with-db-file (&rest body)
+  "Run BODY in a temp buffer containing `image-dired-db-file'.
+Return the last form in BODY."
+  `(with-temp-buffer
+     (if (file-exists-p image-dired-db-file)
+        (insert-file-contents image-dired-db-file))
+     ,@body))
+

 (defun image-dired-dir ()
   "Return the current thumbnails directory (from variable `image-dired-dir').
 Create the thumbnails directory if it does not exist."
 (defun image-dired-dir ()
   "Return the current thumbnails directory (from variable `image-dired-dir').
 Create the thumbnails directory if it does not exist."


@@ -551,7 +560,7 @@ Create the thumbnails directory if it does not exist."
     ))
 
 (defun image-dired-insert-thumbnail (file original-file-name
     ))
 
 (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)
   "Insert thumbnail image FILE.
 Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER."
   (let (beg end)


@@ -594,14 +603,14 @@ according to the Thumbnail Managing Standard."
                  (md5 (file-name-as-directory (file-name-directory f)))))
            (format "%s%s%s.thumb.%s"
                    (file-name-as-directory (expand-file-name (image-dired-dir)))
                  (md5 (file-name-as-directory (file-name-directory f)))))
            (format "%s%s%s.thumb.%s"
                    (file-name-as-directory (expand-file-name (image-dired-dir)))

-                   (file-name-sans-extension (file-name-nondirectory f))
+                   (file-name-base f)

                    (if md5-hash (concat "_" md5-hash) "")
                    (file-name-extension f))))
         ((eq 'per-directory image-dired-thumbnail-storage)
          (let ((f (expand-file-name file)))
            (format "%s.image-dired/%s.thumb.%s"
                    (file-name-directory f)
                    (if md5-hash (concat "_" md5-hash) "")
                    (file-name-extension f))))
         ((eq 'per-directory image-dired-thumbnail-storage)
          (let ((f (expand-file-name file)))
            (format "%s.image-dired/%s.thumb.%s"
                    (file-name-directory f)

-                   (file-name-sans-extension (file-name-nondirectory f))
+                   (file-name-base f)

                    (file-name-extension f))))))
 
 (defun image-dired-create-thumb (original-file thumbnail-file)
                    (file-name-extension f))))))
 
 (defun image-dired-create-thumb (original-file thumbnail-file)


@@ -645,21 +654,27 @@ previous -ARG, if ARG<0) files."
           (image-file (dired-get-filename nil t))
           thumb-file
           overlay)
           (image-file (dired-get-filename nil t))
           thumb-file
           overlay)

-     (when (and image-file (string-match-p (image-file-name-regexp) image-file))
+     (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.
        (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))
+       (let* ((cur-ovs (overlays-in (point) (1+ (point))))
+              (thumb-ov (car (cl-remove-if-not
+                              (lambda (ov) (overlay-get ov 'thumb-file))
+                              cur-ovs))))
+         (if thumb-ov
+             (delete-overlay thumb-ov)

           (put-image thumb-file image-pos)
           (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)))
+          (setq overlay
+                 (cl-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.
           (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))
+  (add-hook 'dired-after-readin-hook
+            'image-dired-dired-after-readin-hook nil t))

 
 (defun image-dired-dired-after-readin-hook ()
   "Relocate existing thumbnail overlays in dired buffer after reverting.
 
 (defun image-dired-dired-after-readin-hook ()
   "Relocate existing thumbnail overlays in dired buffer after reverting.


@@ -774,13 +789,12 @@ calling `image-dired-restore-window-configuration'."
     (dired dir)
     (delete-other-windows)
     (when (not arg)
     (dired dir)
     (delete-other-windows)
     (when (not arg)

-      (split-window-horizontally)
+      (split-window-right)

       (setq truncate-lines t)
       (save-excursion
         (other-window 1)
         (switch-to-buffer buf)
       (setq truncate-lines t)
       (save-excursion
         (other-window 1)
         (switch-to-buffer buf)

-        (split-window-vertically)
-        (other-window 1)
+        (select-window (split-window-below))

         (switch-to-buffer buf2)
         (other-window -2)))))
 
         (switch-to-buffer buf2)
         (other-window -2)))))
 


@@ -816,7 +830,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))
 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)))
     (if arg
         (setq files (list (dired-get-filename)))
       (setq files (dired-get-marked-files)))


@@ -867,13 +881,13 @@ displayed."
         (progn
           (image-dired-display-thumbs)
           (pop-to-buffer image-dired-thumbnail-buffer))
         (progn
           (image-dired-display-thumbs)
           (pop-to-buffer image-dired-thumbnail-buffer))

-      (message "Cancelled."))))
+      (message "Canceled."))))

 
 ;;;###autoload
 (defalias 'image-dired 'image-dired-show-all-from-dir)
 
 ;;;###autoload
 
 ;;;###autoload
 (defalias 'image-dired 'image-dired-show-all-from-dir)
 
 ;;;###autoload

-(defalias 'tumme 'image-dired-show-all-from-dir)
+(define-obsolete-function-alias 'tumme 'image-dired "24.4")

 
 (defun image-dired-sane-db-file ()
   "Check if `image-dired-db-file' exists.
 
 (defun image-dired-sane-db-file ()
   "Check if `image-dired-db-file' exists.


@@ -898,83 +912,76 @@ FILE-TAGS is an alist in the following form:
  ((FILE . TAG) ... )"
   (image-dired-sane-db-file)
   (let (end file tag)
  ((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)
-      (dolist (elt file-tags)
-       (setq file (car elt)
-             tag (cdr elt))
-       (goto-char (point-min))
-       (if (search-forward-regexp (format "^%s.*$" file) nil t)
-           (progn
-             (setq end (point))
-             (beginning-of-line)
-             (when (not (search-forward (format ";%s" tag) end t))
-               (end-of-line)
-               (insert (format ";%s" tag))))
-         (goto-char (point-max))
-         (insert (format "\n%s;%s" file tag)))))))
+    (image-dired--with-db-file
+     (setq buffer-file-name image-dired-db-file)
+     (dolist (elt file-tags)
+       (setq file (car elt)
+            tag (cdr elt))
+       (goto-char (point-min))
+       (if (search-forward-regexp (format "^%s.*$" file) nil t)
+          (progn
+            (setq end (point))
+            (beginning-of-line)
+            (when (not (search-forward (format ";%s" tag) end t))
+              (end-of-line)
+              (insert (format ";%s" tag))))
+        (goto-char (point-max))
+        (insert (format "\n%s;%s" file tag))))
+     (save-buffer))))

 
 (defun image-dired-remove-tag (files tag)
   "For all FILES, remove TAG from the image database."
   (image-dired-sane-db-file)
 
 (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))
-      (if (not (listp files))
-          (if (stringp files)
-              (setq files (list files))
-            (error "Files must be a string or a list of strings!")))
-      (mapc
-       (lambda (file)
-         (goto-char (point-min))
-         (when (search-forward-regexp
-                (format "^%s" file) nil t)
-           (end-of-line)
-           (setq end (point))
-           (beginning-of-line)
-           (when (search-forward-regexp (format "\\(;%s\\)" tag) end t)
-             (delete-region (match-beginning 1) (match-end 1))
-             ;; Check if file should still be in the database. If
-             ;; it has no tags or comments, it will be removed.
-             (end-of-line)
-             (setq end (point))
-             (beginning-of-line)
-             (when (not (search-forward ";" end t))
-               (kill-line 1)
-               ;; If on empty line at end of buffer
-               (when (and (eobp)
-                          (looking-at "^$"))
-                 (delete-char -1))))))
-       files)
-      (save-buffer)
-      (kill-buffer buf))))
+  (image-dired--with-db-file
+   (setq buffer-file-name image-dired-db-file)
+   (let (end)
+     (unless (listp files)
+       (if (stringp files)
+          (setq files (list files))
+        (error "Files must be a string or a list of strings!")))
+     (dolist (file files)
+       (goto-char (point-min))
+       (when (search-forward-regexp (format "^%s" file) nil t)
+        (end-of-line)
+        (setq end (point))
+        (beginning-of-line)
+        (when (search-forward-regexp (format "\\(;%s\\)" tag) end t)
+          (delete-region (match-beginning 1) (match-end 1))
+          ;; Check if file should still be in the database. If
+          ;; it has no tags or comments, it will be removed.
+          (end-of-line)
+          (setq end (point))
+          (beginning-of-line)
+          (when (not (search-forward ";" end t))
+            (kill-line 1)
+            ;; If on empty line at end of buffer
+            (and (eobp)
+                 (looking-at "^$")
+                 (delete-char -1)))))))
+   (save-buffer)))

 
 (defun image-dired-list-tags (file)
   "Read all tags for image FILE from the image database."
   (image-dired-sane-db-file)
 
 (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))
-      (goto-char (point-min))
-      (when (search-forward-regexp
-             (format "^%s" file) nil t)
-        (end-of-line)
-        (setq end (point))
-        (beginning-of-line)
-        (if (search-forward ";" end t)
-            (if (search-forward "comment:" end t)
-                (if (search-forward ";" end t)
-                    (setq tags (buffer-substring (point) end)))
-              (setq tags (buffer-substring (point) end)))))
-      (kill-buffer buf)
-      (split-string tags ";"))))
+  (image-dired--with-db-file
+   (let (end (tags ""))
+     (when (search-forward-regexp (format "^%s" file) nil t)
+       (end-of-line)
+       (setq end (point))
+       (beginning-of-line)
+       (if (search-forward ";" end t)
+          (if (search-forward "comment:" end t)
+              (if (search-forward ";" end t)
+                  (setq tags (buffer-substring (point) end)))
+            (setq tags (buffer-substring (point) end)))))
+     (split-string tags ";"))))

 
 ;;;###autoload
 (defun image-dired-tag-files (arg)
   "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): "))
 
 ;;;###autoload
 (defun image-dired-tag-files (arg)
   "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)))
     (if arg
         (setq files (list (dired-get-filename)))
       (setq files (dired-get-marked-files)))


@@ -1032,16 +1039,14 @@ With prefix argument ARG, remove tag from file at point."
 See documentation for `image-dired-toggle-movement-tracking'.
 Interactive use only useful if `image-dired-track-movement' is nil."
   (interactive)
 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)
-      (set-buffer dired-buf)
-      (if (not (dired-goto-file file-name))
-          (message "Could not track file")
-        (set-window-point
-         (image-dired-get-buffer-window dired-buf) (point)))
-      (set-buffer old-buf))))
+  (let* ((dired-buf (image-dired-associated-dired-buffer))
+         (file-name (image-dired-original-file-name))
+         (window (image-dired-get-buffer-window dired-buf)))
+    (and (buffer-live-p dired-buf) file-name
+         (with-current-buffer dired-buf
+           (if (not (dired-goto-file file-name))
+               (message "Could not track file")
+             (if window (set-window-point window (point))))))))

 
 (defun image-dired-toggle-movement-tracking ()
   "Turn on and off `image-dired-track-movement'.
 
 (defun image-dired-toggle-movement-tracking ()
   "Turn on and off `image-dired-track-movement'.


@@ -1058,24 +1063,22 @@ position in the other buffer."
 This is almost the same as what `image-dired-track-original-file' does,
 but the other way around."
   (let ((file (dired-get-filename))
 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)
+        prop-val found window)

     (when (get-buffer image-dired-thumbnail-buffer)
     (when (get-buffer image-dired-thumbnail-buffer)

-      (set-buffer image-dired-thumbnail-buffer)
-      (goto-char (point-min))
-      (while (and (not (eobp))
-                  (not found))
-        (if (and (setq prop-val
-                       (get-text-property (point) 'original-file-name))
-                 (string= prop-val file))
-            (setq found t))
-        (if (not found)
-            (forward-char 1)))
-      (when found
-        (set-window-point
-         (image-dired-thumbnail-window) (point))
-        (image-dired-display-thumb-properties))
-      (set-buffer old-buf))))
+      (with-current-buffer image-dired-thumbnail-buffer
+        (goto-char (point-min))
+        (while (and (not (eobp))
+                    (not found))
+          (if (and (setq prop-val
+                         (get-text-property (point) 'original-file-name))
+                   (string= prop-val file))
+              (setq found t))
+          (if (not found)
+              (forward-char 1)))
+        (when found
+          (if (setq window (image-dired-thumbnail-window))
+              (set-window-point window (point)))
+          (image-dired-display-thumb-properties))))))

 
 (defun image-dired-dired-next-line (&optional arg)
   "Call `dired-next-line', then track thumbnail.
 
 (defun image-dired-dired-next-line (&optional arg)
   "Call `dired-next-line', then track thumbnail.


@@ -1202,8 +1205,8 @@ comment."
 
 (defun image-dired-modify-mark-on-thumb-original-file (command)
   "Modify mark in dired buffer.
 
 (defun image-dired-modify-mark-on-thumb-original-file (command)
   "Modify mark in dired buffer.

-COMMAND is one of 'mark for marking file in dired, 'unmark for
-unmarking file in dired or 'flag for flagging file for delete in
+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))
         (dired-buf (image-dired-associated-dired-buffer)))
 dired."
   (let ((file-name (image-dired-original-file-name))
         (dired-buf (image-dired-associated-dired-buffer)))


@@ -1598,14 +1601,14 @@ 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")
 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)
        (setq thumb-name (image-dired-thumb-name curr-file))
        ;; If the user overrides the exist check, we must clear the
        ;; image cache so that if the user wants to display the
     (setq files (dired-get-marked-files))
     (mapcar
      (lambda (curr-file)
        (setq thumb-name (image-dired-thumb-name curr-file))
        ;; If the user overrides the exist check, we must clear the
        ;; image cache so that if the user wants to display the

-       ;; thumnail, it is not fetched from cache.
+       ;; thumbnail, it is not fetched from cache.

        (if arg
            (clear-image-cache))
        (if (or (not (file-exists-p thumb-name))
        (if arg
            (clear-image-cache))
        (if (or (not (file-exists-p thumb-name))


@@ -1906,8 +1909,8 @@ 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))
   (if (not (image-dired-image-at-point-p))
       (message "No image at point")
     (let ((file (image-dired-original-file-name))

-          command temp-file)
-      (if (not (string-match "\.[jJ][pP[eE]?[gG]$" file))
+          command)
+      (if (not (string-match "\\.[jJ][pP[eE]?[gG]$" file))

           (error "Only JPEG images can be rotated!"))
       (setq command (format-spec
                      image-dired-cmd-rotate-original-options
           (error "Only JPEG images can be rotated!"))
       (setq command (format-spec
                      image-dired-cmd-rotate-original-options


@@ -1947,7 +1950,7 @@ for traceability.  The format of the returned file name is
 YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg.  Used from
 `image-dired-copy-with-exif-file-name'."
   (let (data no-exif-data-found)
 YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg.  Used from
 `image-dired-copy-with-exif-file-name'."
   (let (data no-exif-data-found)

-    (if (not (string-match "\.[Jj][Pp][Ee]?[Gg]$" (expand-file-name file)))
+    (if (not (string-match "\\.[Jj][Pp][Ee]?[Gg]$" (expand-file-name file)))

         (progn
           (setq no-exif-data-found t)
           (setq data
         (progn
           (setq no-exif-data-found t)
           (setq data


@@ -2043,7 +2046,7 @@ function.  The result is a couple of new files in
      files)))
 
 (defun image-dired-display-next-thumbnail-original ()
      files)))
 
 (defun image-dired-display-next-thumbnail-original ()

-  "In thubnail buffer, move to next thumbnail and display the image."
+  "In thumbnail buffer, move to next thumbnail and display the image."

   (interactive)
   (image-dired-forward-image)
   (image-dired-display-thumbnail-original-image))
   (interactive)
   (image-dired-forward-image)
   (image-dired-display-thumbnail-original-image))


@@ -2061,34 +2064,35 @@ 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)
  ((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)
-      (dolist (elt file-comments)
-       (setq file (car elt)
-             comment (cdr elt))
-       (goto-char (point-min))
-       (if (search-forward-regexp (format "^%s.*$" file) nil t)
-           (progn
-             (setq end (point))
-             (beginning-of-line)
-             ;; Delete old comment, if any
-             (when (search-forward ";comment:" end t)
-               (setq comment-beg-pos (match-beginning 0))
-               ;; Any tags after the comment?
-               (if (search-forward ";" end t)
-                   (setq comment-end-pos (- (point) 1))
-                 (setq comment-end-pos end))
-               ;; Delete comment tag and comment
-               (delete-region comment-beg-pos comment-end-pos))
-             ;; Insert new comment
-             (beginning-of-line)
-             (unless (search-forward ";" end t)
-               (end-of-line)
-               (insert ";"))
-             (insert (format "comment:%s;" comment)))
-         ;; File does not exist in database - add it.
-         (goto-char (point-max))
-         (insert (format "\n%s;comment:%s" file comment)))))))
+    (image-dired--with-db-file
+     (setq buffer-file-name image-dired-db-file)
+     (dolist (elt file-comments)
+       (setq file (car elt)
+            comment (cdr elt))
+       (goto-char (point-min))
+       (if (search-forward-regexp (format "^%s.*$" file) nil t)
+          (progn
+            (setq end (point))
+            (beginning-of-line)
+            ;; Delete old comment, if any
+            (when (search-forward ";comment:" end t)
+              (setq comment-beg-pos (match-beginning 0))
+              ;; Any tags after the comment?
+              (if (search-forward ";" end t)
+                  (setq comment-end-pos (- (point) 1))
+                (setq comment-end-pos end))
+              ;; Delete comment tag and comment
+              (delete-region comment-beg-pos comment-end-pos))
+            ;; Insert new comment
+            (beginning-of-line)
+            (unless (search-forward ";" end t)
+              (end-of-line)
+              (insert ";"))
+            (insert (format "comment:%s;" comment)))
+        ;; File does not exist in database - add it.
+        (goto-char (point-max))
+        (insert (format "\n%s;comment:%s" file comment))))
+     (save-buffer))))

 
 (defun image-dired-update-property (prop value)
   "Update text property PROP with value VALUE at point."
 
 (defun image-dired-update-property (prop value)
   "Update text property PROP with value VALUE at point."


@@ -2130,24 +2134,20 @@ Optionally use old comment from FILE as initial value."
 (defun image-dired-get-comment (file)
   "Get comment for file FILE."
   (image-dired-sane-db-file)
 (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))
-      (goto-char (point-min))
-      (when (search-forward-regexp
-             (format "^%s" file) nil t)
-        (end-of-line)
-        (setq end (point))
-        (beginning-of-line)
-        (cond ((search-forward ";comment:" end t)
-               (setq comment-beg-pos (point))
-               (if (search-forward ";" end t)
-                   (setq comment-end-pos (- (point) 1))
-                 (setq comment-end-pos end))
-               (setq comment (buffer-substring
-                              comment-beg-pos comment-end-pos)))))
-      (kill-buffer buf)
-      comment)))
+  (image-dired--with-db-file
+   (let (end comment-beg-pos comment-end-pos comment)
+     (when (search-forward-regexp (format "^%s" file) nil t)
+       (end-of-line)
+       (setq end (point))
+       (beginning-of-line)
+       (when (search-forward ";comment:" end t)
+        (setq comment-beg-pos (point))
+        (if (search-forward ";" end t)
+            (setq comment-end-pos (- (point) 1))
+          (setq comment-end-pos end))
+        (setq comment (buffer-substring
+                       comment-beg-pos comment-end-pos))))
+     comment)))

 
 ;;;###autoload
 (defun image-dired-mark-tagged-files ()
 
 ;;;###autoload
 (defun image-dired-mark-tagged-files ()


@@ -2161,32 +2161,26 @@ matching tag will be marked in the dired buffer."
   (image-dired-sane-db-file)
   (let ((tag (read-string "Mark tagged files (regexp): "))
         (hits 0)
   (image-dired-sane-db-file)
   (let ((tag (read-string "Mark tagged files (regexp): "))
         (hits 0)

-        files buf)
-    (save-excursion
-      (setq buf (find-file image-dired-db-file))
-      (goto-char (point-min))
-      ;; Collect matches
-      (while (search-forward-regexp
-              (concat "\\(^[^;\n]+\\);.*" tag ".*$") nil t)
-        (setq files (append (list (match-string 1)) files)))
-      (kill-buffer buf)
-      ;; Mark files
-      (mapc
-       ;; I tried using `dired-mark-files-regexp' but it was
-       ;; waaaay to slow.
-       (lambda (curr-file)
-         ;; Don't bother about hits found in other directories than
-         ;; the current one.
-         (when (string= (file-name-as-directory
-                         (expand-file-name default-directory))
-                      (file-name-as-directory
-                       (file-name-directory curr-file)))
-           (setq curr-file (file-name-nondirectory curr-file))
-           (goto-char (point-min))
-           (when (search-forward-regexp (format "\\s %s$" curr-file) nil t)
-             (setq hits (+ hits 1))
-             (dired-mark 1))))
-       files))
+        files)
+    (image-dired--with-db-file
+     ;; Collect matches
+     (while (search-forward-regexp
+            (concat "\\(^[^;\n]+\\);.*" tag ".*$") nil t)
+       (push (match-string 1) files)))
+    ;; Mark files
+    (dolist (curr-file files)
+      ;; I tried using `dired-mark-files-regexp' but it was waaaay to
+      ;; slow.  Don't bother about hits found in other directories
+      ;; than the current one.
+      (when (string= (file-name-as-directory
+                     (expand-file-name default-directory))
+                    (file-name-as-directory
+                     (file-name-directory curr-file)))
+       (setq curr-file (file-name-nondirectory curr-file))
+       (goto-char (point-min))
+       (when (search-forward-regexp (format "\\s %s$" curr-file) nil t)
+         (setq hits (+ hits 1))
+         (dired-mark 1))))

     (message "%d files with matching tag marked." hits)))
 
 (defun image-dired-mouse-display-image (event)
     (message "%d files with matching tag marked." hits)))
 
 (defun image-dired-mouse-display-image (event)


@@ -2194,26 +2188,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")
 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")
 
 (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)
   (image-dired-display-thumb-properties))
 
 (defun image-dired-mouse-toggle-mark (event)


@@ -2221,11 +2214,10 @@ non-nil."
 Track this in associated dired buffer if `image-dired-track-movement' is
 non-nil."
   (interactive "e")
 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 ()
   (image-dired-toggle-mark-thumb-original-file))
 
 (defun image-dired-dired-display-properties ()


@@ -2324,29 +2316,26 @@ 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)
 (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)
-    (setq image-dired-file-tag-list nil)
-    (setq image-dired-file-comment-list nil)
-    (goto-char (point-min))
-    (while (search-forward-regexp "^." nil t)
-      (end-of-line)
-      (setq end (point))
-      (beginning-of-line)
-      (setq beg (point))
-      (if (not (search-forward ";" end nil))
-          (error "Something is really wrong, check format of database"))
-      (setq row-tags (split-string
-                      (buffer-substring beg end) ";"))
-      (setq file (car row-tags))
-      (mapc
-       (lambda (x)
-         (if (not (string-match "^comment:\\(.*\\)" x))
-             (image-dired-add-to-tag-file-lists x file)
-           (image-dired-add-to-file-comment-list file (match-string 1 x))))
-       (cdr row-tags)))
-    (kill-buffer buf))
+  (image-dired--with-db-file
+   (let (end beg file row-tags)
+     (setq image-dired-tag-file-list nil)
+     (setq image-dired-file-tag-list nil)
+     (setq image-dired-file-comment-list nil)
+     (goto-char (point-min))
+     (while (search-forward-regexp "^." nil t)
+       (end-of-line)
+       (setq end (point))
+       (beginning-of-line)
+       (setq beg (point))
+       (unless (search-forward ";" end nil)
+        (error "Something is really wrong, check format of database"))
+       (setq row-tags (split-string
+                      (buffer-substring beg end) ";"))
+       (setq file (car row-tags))
+       (dolist (x (cdr row-tags))
+        (if (not (string-match "^comment:\\(.*\\)" x))
+            (image-dired-add-to-tag-file-lists x file)
+          (image-dired-add-to-file-comment-list file (match-string 1 x)))))))

   ;; Sort tag-file list
   (setq image-dired-tag-file-list
         (sort image-dired-tag-file-list
   ;; Sort tag-file list
   (setq image-dired-tag-file-list
         (sort image-dired-tag-file-list


@@ -2374,7 +2363,8 @@ 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)
 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
+       (index-file (format "%s/index.html" image-dired-gallery-dir))
+        count tag tag-file

         comment file-tags tag-link tag-link-list)
     ;; Make sure gallery root exist
     (if (file-exists-p image-dired-gallery-dir)
         comment file-tags tag-link tag-link-list)
     ;; Make sure gallery root exist
     (if (file-exists-p image-dired-gallery-dir)


@@ -2382,85 +2372,75 @@ when using per-directory thumbnail file storage"))
             (error "Variable image-dired-gallery-dir is not a directory"))
       (make-directory image-dired-gallery-dir))
     ;; Open index file
             (error "Variable image-dired-gallery-dir is not a directory"))
       (make-directory image-dired-gallery-dir))
     ;; Open index file

-    (setq index-buf (find-file
-                     (format "%s/index.html" image-dired-gallery-dir)))
-    (erase-buffer)
-    (insert "<html>\n")
-    (insert "  <body>\n")
-    (insert "   <h2>Image-Dired Gallery</h2>\n")
-    (insert (format "<p>\n    Gallery generated %s\n   <p>\n"
-                    (current-time-string)))
-    (insert "   <h3>Tag index</h3>\n")
-    (setq count 1)
-    ;; Pre-generate list of all tag links
-    (mapc
-     (lambda (curr)
-       (setq tag (car curr))
-       (when (not (member tag image-dired-gallery-hidden-tags))
-         (setq tag-link (format "<a href=\"%d.html\">%s</a>" count tag))
-         (if tag-link-list
-             (setq tag-link-list
-                   (append tag-link-list (list (cons tag tag-link))))
-           (setq tag-link-list (list (cons tag tag-link))))
-         (setq count (1+ count))))
-     tags)
-    (setq count 1)
-    ;; Main loop where we generated thumbnail pages per tag
-    (mapc
-     (lambda (curr)
-       (setq tag (car curr))
-       ;; Don't display hidden tags
-       (when (not (member tag image-dired-gallery-hidden-tags))
-         ;; Insert link to tag page in index
-         (insert (format "    %s<br>\n" (cdr (assoc tag tag-link-list))))
-         ;; Open per-tag file
-         (setq tag-buf (find-file
-                        (format "%s/%s.html" image-dired-gallery-dir count)))
-         (erase-buffer)
-         (insert "<html>\n")
-         (insert "  <body>\n")
-         (insert "  <p><a href=\"index.html\">Index</a></p>\n")
-         (insert (format "  <h2>Images with tag &quot;%s&quot;</h2>" tag))
-         ;; Main loop for files per tag page
-         (mapc
-          (lambda (file)
-            (when (not (image-dired-hidden-p file))
-              ;; Insert thumbnail with link to full image
-              (insert
-               (format "<a href=\"%s/%s\"><img src=\"%s/%s\"%s></a>\n"
-                       image-dired-gallery-image-root-url
-                      (file-name-nondirectory file)
-                       image-dired-gallery-thumb-image-root-url
-                       (file-name-nondirectory (image-dired-thumb-name file)) file))
-              ;; Insert comment, if any
-              (if (setq comment (cdr (assoc file image-dired-file-comment-list)))
-                  (insert (format "<br>\n%s<br>\n" comment))
-                (insert "<br>\n"))
-              ;; Insert links to other tags, if any
-              (when (> (length
-                        (setq file-tags (assoc file image-dired-file-tag-list))) 2)
-                (insert "[ ")
-                (mapc
-                 (lambda (extra-tag)
-                   ;; Only insert if not file name or the main tag
-                   (if (and (not (equal extra-tag tag))
-                            (not (equal extra-tag file)))
-                       (insert
-                        (format "%s " (cdr (assoc extra-tag tag-link-list))))))
-                 file-tags)
-                (insert "]<br>\n"))))
-          (cdr curr))
-         (insert "  <p><a href=\"index.html\">Index</a></p>\n")
-         (insert "  </body>\n")
-         (insert "</html>\n")
-         (save-buffer)
-         (kill-buffer tag-buf)
-         (setq count (1+ count))))
-       tags)
-    (insert "  </body>\n")
-    (insert "</html>")
-    (save-buffer)
-    (kill-buffer index-buf)))
+    (with-temp-file index-file
+      (if (file-exists-p index-file)
+         (insert-file-contents index-file))
+      (insert "<html>\n")
+      (insert "  <body>\n")
+      (insert "   <h2>Image-Dired Gallery</h2>\n")
+      (insert (format "<p>\n    Gallery generated %s\n   <p>\n"
+                     (current-time-string)))
+      (insert "   <h3>Tag index</h3>\n")
+      (setq count 1)
+      ;; Pre-generate list of all tag links
+      (dolist (curr tags)
+       (setq tag (car curr))
+       (when (not (member tag image-dired-gallery-hidden-tags))
+         (setq tag-link (format "<a href=\"%d.html\">%s</a>" count tag))
+         (if tag-link-list
+             (setq tag-link-list
+                   (append tag-link-list (list (cons tag tag-link))))
+           (setq tag-link-list (list (cons tag tag-link))))
+         (setq count (1+ count))))
+      (setq count 1)
+      ;; Main loop where we generated thumbnail pages per tag
+      (dolist (curr tags)
+       (setq tag (car curr))
+       ;; Don't display hidden tags
+       (when (not (member tag image-dired-gallery-hidden-tags))
+         ;; Insert link to tag page in index
+         (insert (format "    %s<br>\n" (cdr (assoc tag tag-link-list))))
+         ;; Open per-tag file
+         (setq tag-file (format "%s/%s.html" image-dired-gallery-dir count))
+         (with-temp-file tag-file
+           (if (file-exists-p tag-file)
+               (insert-file-contents tag-file))
+           (erase-buffer)
+           (insert "<html>\n")
+           (insert "  <body>\n")
+           (insert "  <p><a href=\"index.html\">Index</a></p>\n")
+           (insert (format "  <h2>Images with tag &quot;%s&quot;</h2>" tag))
+           ;; Main loop for files per tag page
+           (dolist (file (cdr curr))
+             (unless (image-dired-hidden-p file)
+               ;; Insert thumbnail with link to full image
+               (insert
+                (format "<a href=\"%s/%s\"><img src=\"%s/%s\"%s></a>\n"
+                        image-dired-gallery-image-root-url
+                        (file-name-nondirectory file)
+                        image-dired-gallery-thumb-image-root-url
+                        (file-name-nondirectory (image-dired-thumb-name file)) file))
+               ;; Insert comment, if any
+               (if (setq comment (cdr (assoc file image-dired-file-comment-list)))
+                   (insert (format "<br>\n%s<br>\n" comment))
+                 (insert "<br>\n"))
+               ;; Insert links to other tags, if any
+               (when (> (length
+                         (setq file-tags (assoc file image-dired-file-tag-list))) 2)
+                 (insert "[ ")
+                 (dolist (extra-tag file-tags)
+                   ;; Only insert if not file name or the main tag
+                   (if (and (not (equal extra-tag tag))
+                            (not (equal extra-tag file)))
+                       (insert
+                        (format "%s " (cdr (assoc extra-tag tag-link-list))))))
+                 (insert "]<br>\n"))))
+           (insert "  <p><a href=\"index.html\">Index</a></p>\n")
+           (insert "  </body>\n")
+           (insert "</html>\n"))
+         (setq count (1+ count))))
+      (insert "  </body>\n")
+      (insert "</html>"))))

 
 (defun image-dired-kill-buffer-and-window ()
   "Kill the current buffer and, if possible, also the window."
 
 (defun image-dired-kill-buffer-and-window ()
   "Kill the current buffer and, if possible, also the window."


@@ -2474,6 +2454,8 @@ when using per-directory thumbnail file storage"))
 (defvar image-dired-widget-list nil
   "List to keep track of meta data in edit buffer.")
 
 (defvar image-dired-widget-list nil
   "List to keep track of meta data in edit buffer.")
 

+(declare-function widget-forward "wid-edit" (arg))
+

 ;;;###autoload
 (defun image-dired-dired-edit-comment-and-tags ()
   "Edit comment and tags of current or marked image files.
 ;;;###autoload
 (defun image-dired-dired-edit-comment-and-tags ()
   "Edit comment and tags of current or marked image files.


@@ -2533,7 +2515,7 @@ the operation by activating the Cancel button.\n\n")
     (widget-insert "\n")
     (widget-create 'push-button
                  :notify
     (widget-insert "\n")
     (widget-create 'push-button
                  :notify

-                 (lambda (&rest ignore)
+                 (lambda (&rest _ignore)

                    (image-dired-save-information-from-widgets)
                    (bury-buffer)
                    (message "Done."))
                    (image-dired-save-information-from-widgets)
                    (bury-buffer)
                    (message "Done."))


@@ -2541,7 +2523,7 @@ the operation by activating the Cancel button.\n\n")
     (widget-insert " ")
     (widget-create 'push-button
                    :notify
     (widget-insert " ")
     (widget-create 'push-button
                    :notify

-                   (lambda (&rest ignore)
+                   (lambda (&rest _ignore)

                      (bury-buffer)
                      (message "Operation canceled."))
                    "Cancel")
                      (bury-buffer)
                      (message "Operation canceled."))
                    "Cancel")


@@ -2590,9 +2572,9 @@ tags to their respective image file.  Internal function used by
 ;;               (let ((fattribs (file-attributes f)))
 ;;                 ;; Get last access time and file size
 ;;                 `(,(nth 4 fattribs) ,(nth 7 fattribs) ,f)))
 ;;               (let ((fattribs (file-attributes f)))
 ;;                 ;; Get last access time and file size
 ;;                 `(,(nth 4 fattribs) ,(nth 7 fattribs) ,f)))

-;;             (directory-files (image-dired-dir) t ".+\.thumb\..+$"))
+;;             (directory-files (image-dired-dir) t ".+\\.thumb\\..+$"))

 ;;            ;; Sort function. Compare time between two files.
 ;;            ;; Sort function. Compare time between two files.

-;;            '(lambda (l1 l2)
+;;            (lambda (l1 l2)

 ;;               (time-less-p (car l1) (car l2)))))
 ;;          (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files))))
 ;;     (while (> dirsize image-dired-dir-max-size)
 ;;               (time-less-p (car l1) (car l2)))))
 ;;          (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files))))
 ;;     (while (> dirsize image-dired-dir-max-size)


@@ -2622,5 +2604,4 @@ tags to their respective image file.  Internal function used by
 
 (provide 'image-dired)
 
 
 (provide 'image-dired)
 

-;; arch-tag: 9d11411d-331f-4380-8b44-8adfe3a0343e

 ;;; image-dired.el ends here
 ;;; image-dired.el ends here