X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/c0511b57692c7a27d3632c34653dab5cfed629ef..f95bbe5a67e03fe6d05cbfb4d0c9151a754d6ccd:/lisp/image-dired.el diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 354e16b0bf..67b023dfd7 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-2013 Free Software Foundation, Inc. +;; Copyright (C) 2005-2016 Free Software Foundation, Inc. ;; ;; Version: 0.4.11 ;; Keywords: multimedia @@ -156,8 +156,9 @@ (require 'format-spec) (require 'widget) +(require 'cl-lib) + (eval-when-compile - (require 'cl-lib) (require 'wid-edit)) (defgroup image-dired nil @@ -657,9 +658,12 @@ previous -ARG, if ARG<0) files." (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)) + (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) (setq overlay (cl-loop for o in (overlays-in (point) (1+ (point))) @@ -877,13 +881,13 @@ displayed." (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 -(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. @@ -1035,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) - (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'. @@ -1061,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)) - (old-buf (current-buffer)) - prop-val found) + prop-val found window) (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. @@ -1143,7 +1143,8 @@ image." (defun image-dired-next-line () "Move to next line and display properties." (interactive) - (forward-line 1) + (let ((goal-column (current-column))) + (next-line)) ;; 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)) @@ -1155,7 +1156,8 @@ image." (defun image-dired-previous-line () "Move to previous line and display properties." (interactive) - (forward-line -1) + (let ((goal-column (current-column))) + (previous-line)) ;; 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 @@ -1205,8 +1207,8 @@ comment." (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))) @@ -1910,7 +1912,7 @@ overwritten. This confirmation can be turned off using (message "No image at point") (let ((file (image-dired-original-file-name)) command) - (if (not (string-match "\.[jJ][pP[eE]?[gG]$" file)) + (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 @@ -1950,7 +1952,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) - (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 @@ -2572,7 +2574,7 @@ 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))) -;; (directory-files (image-dired-dir) t ".+\.thumb\..+$")) +;; (directory-files (image-dired-dir) t ".+\\.thumb\\..+$")) ;; ;; Sort function. Compare time between two files. ;; (lambda (l1 l2) ;; (time-less-p (car l1) (car l2)))))