X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e7dbdb6dfc3ffdc25f8d32a43683500f596d9784..1a27c64e1cf94e374cac95137b438b1651739074:/lisp/image-dired.el diff --git a/lisp/image-dired.el b/lisp/image-dired.el index f006e2e9ed..565448c854 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -157,6 +157,7 @@ (require 'widget) (eval-when-compile + (require 'cl) (require 'wid-edit)) (defgroup image-dired nil @@ -186,19 +187,19 @@ that allows sharing of thumbnails across different programs." :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 - (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 - (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." @@ -343,7 +344,7 @@ original image file name and %t which is replaced by :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) @@ -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 () @@ -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))))