X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/932fb767f54c27e7fe185f8d23ba4b734d569ed7..ec38bb4664eacfe1d91ae56c10aa03a5d6d1ca96:/lisp/thumbs.el diff --git a/lisp/thumbs.el b/lisp/thumbs.el index fd3cb13de9..0fa448d4d7 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -1,6 +1,6 @@ ;;; thumbs.el --- Thumbnails previewer for images files -;; Copyright 2004, 2005 Free Software Foundation, Inc +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. ;; Author: Jean-Philippe Theberge ;; Keywords: Multimedia @@ -19,8 +19,8 @@ ;; 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., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;; ;; Thanks: Alex Schroeder for maintaining the package at some time ;; The peoples at #emacs@freenode.net for numerous help @@ -65,8 +65,7 @@ :version "22.1" :group 'multimedia) -(defcustom thumbs-thumbsdir - (expand-file-name "~/.emacs-thumbs") +(defcustom thumbs-thumbsdir "~/.emacs-thumbs" "*Directory to store thumbnails." :type 'directory :group 'thumbs) @@ -78,17 +77,17 @@ (defcustom thumbs-per-line 5 "*Number of thumbnails per line to show in directory." - :type 'string + :type 'integer :group 'thumbs) (defcustom thumbs-thumbsdir-max-size 50000000 "Max size for thumbnails directory. -When it reach that size (in bytes), a warning is send." - :type 'string +When it reaches that size (in bytes), a warning is sent." + :type 'integer :group 'thumbs) (defcustom thumbs-conversion-program - (if (equal 'windows-nt system-type) + (if (eq system-type 'windows-nt) "convert.exe" (or (executable-find "convert") "/usr/X11R6/bin/convert")) @@ -105,32 +104,31 @@ It must be 'convert'." (defcustom thumbs-relief 5 "*Size of button-like border around thumbnails." - :type 'string + :type 'integer :group 'thumbs) (defcustom thumbs-margin 2 "*Size of the margin around thumbnails. This is where you see the cursor." - :type 'string + :type 'integer :group 'thumbs) (defcustom thumbs-thumbsdir-auto-clean t "If set, delete older file in the thumbnails directory. Deletion is done at load time when the directory size is bigger -than 'thumbs-thumbsdir-max-size'." +than `thumbs-thumbsdir-max-size'." :type 'boolean :group 'thumbs) (defcustom thumbs-image-resizing-step 10 - "Step by wich to resize image." - :type 'string + "Step by which to resize image." + :type 'integer :group 'thumbs) -(defcustom thumbs-temp-dir - "/tmp/" +(defcustom thumbs-temp-dir temporary-file-directory "Temporary directory to use. -Leaving it to default '/tmp/' can let another user -see some of your images." +Defaults to `temporary-file-directory'. Leaving it to +this value can let another user see some of your images." :type 'directory :group 'thumbs) @@ -140,56 +138,66 @@ see some of your images." :group 'thumbs) ;; Initialize some variable, for later use. -(defvar thumbs-temp-file - (concat thumbs-temp-dir thumbs-temp-prefix) - "Temporary filesname for images.") - -(defvar thumbs-current-tmp-filename - nil +(defvar thumbs-current-tmp-filename nil "Temporary filename of current image.") -(defvar thumbs-current-image-filename - nil +(make-variable-buffer-local 'thumbs-current-tmp-filename) + +(defvar thumbs-current-image-filename nil "Filename of current image.") -(defvar thumbs-current-image-size - nil - "Size of current image.") -(defvar thumbs-image-num - nil - "Number of current image.") -(defvar thumbs-current-dir - nil - "Current directory.") -(defvar thumbs-markedL - nil - "List of marked files.") +(make-variable-buffer-local 'thumbs-current-image-filename) -;; Make sure auto-image-file-mode is ON. -(auto-image-file-mode t) +(defvar thumbs-current-image-size nil + "Size of current image.") -;; Create the thumbs directory if it does not exists. -(setq thumbs-thumbsdir (expand-file-name thumbs-thumbsdir)) +(defvar thumbs-image-num nil + "Number of current image.") +(make-variable-buffer-local 'thumbs-image-num) -(when (not (file-directory-p thumbs-thumbsdir)) - (progn - (make-directory thumbs-thumbsdir) - (message "Creating thumbnails directory"))) +(defvar thumbs-current-dir nil + "Current directory.") -(defvar thumbs-gensym-counter 0) +(defvar thumbs-markedL nil + "List of marked files.") -(defun thumbs-gensym (&optional arg) - "Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"Thumbs\"." - (let ((prefix (if (stringp arg) arg "Thumbs")) - (num (if (integerp arg) arg - (prog1 - thumbs-gensym-counter - (setq thumbs-gensym-counter (1+ thumbs-gensym-counter)))))) - (make-symbol (format "%s%d" prefix num)))) +(defalias 'thumbs-gensym + (if (fboundp 'gensym) + 'gensym + ;; Copied from cl-macs.el + (defvar thumbs-gensym-counter 0) + (lambda (&optional prefix) + "Generate a new uninterned symbol. +The name is made by appending a number to PREFIX, default \"G\"." + (let ((pfix (if (stringp prefix) prefix "G")) + (num (if (integerp prefix) prefix + (prog1 thumbs-gensym-counter + (setq thumbs-gensym-counter + (1+ thumbs-gensym-counter)))))) + (make-symbol (format "%s%d" pfix num)))))) + +(defsubst thumbs-temp-dir () + (file-name-as-directory (expand-file-name thumbs-temp-dir))) + +(defun thumbs-temp-file () + "Return a unique temporary filename for an image." + (format "%s%s-%s.jpg" + (thumbs-temp-dir) + thumbs-temp-prefix + (thumbs-gensym "T"))) + +(defun thumbs-thumbsdir () + "Return the current thumbnails directory (from `thumbs-thumbsdir'). +Create the thumbnails directory if it does not exist." + (let ((thumbs-thumbsdir (file-name-as-directory + (expand-file-name thumbs-thumbsdir)))) + (unless (file-directory-p thumbs-thumbsdir) + (make-directory thumbs-thumbsdir) + (message "Creating thumbnails directory")) + thumbs-thumbsdir)) (defun thumbs-cleanup-thumbsdir () "Clean the thumbnails directory. -If the total size of all files in 'thumbs-thumbsdir' is bigger than -'thumbs-thumbsdir-max-size', files are deleted until the max size is +If the total size of all files in `thumbs-thumbsdir' is bigger than +`thumbs-thumbsdir-max-size', files are deleted until the max size is reached." (let* ((filesL (sort @@ -197,8 +205,8 @@ reached." (lambda (f) (let ((fattribsL (file-attributes f))) `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f))) - (directory-files thumbs-thumbsdir t (image-file-name-regexp))) - '(lambda (l1 l2) (time-less-p (car l1)(car l2))))) + (directory-files (thumbs-thumbsdir) t (image-file-name-regexp))) + '(lambda (l1 l2) (time-less-p (car l1) (car l2))))) (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL)))) (while (> dirsize thumbs-thumbsdir-max-size) (progn @@ -217,11 +225,11 @@ reached." FILEIN is the input file, FILEOUT is the output file, ACTION is the command to send to convert. -Optional argument are: +Optional arguments are: ARG any arguments to the ACTION command, -OUTPUT-FORMAT is the file format to output, default is jpeg +OUTPUT-FORMAT is the file format to output (default is jpeg), ACTION-PREFIX is the symbol to place before the ACTION command - (default to '-' but can sometime be '+')." + (defaults to '-' but can sometimes be '+')." (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\"" thumbs-conversion-program (or action-prefix "-") @@ -241,7 +249,7 @@ ACTION-PREFIX is the symbol to place before the ACTION command (round (- n (/ (* d n) 100)))) (defun thumbs-increment-image-size (s) - "Increment S (a cons of width x heigh)." + "Increment S (a cons of width x height)." (cons (thumbs-increment-image-size-element (car s) thumbs-image-resizing-step) @@ -249,7 +257,7 @@ ACTION-PREFIX is the symbol to place before the ACTION command thumbs-image-resizing-step))) (defun thumbs-decrement-image-size (s) - "Decrement S (a cons of width x heigh)." + "Decrement S (a cons of width x height)." (cons (thumbs-decrement-image-size-element (car s) thumbs-image-resizing-step) @@ -258,14 +266,14 @@ ACTION-PREFIX is the symbol to place before the ACTION command (defun thumbs-resize-image (&optional increment size) "Resize image in current buffer. -if INCREMENT is set, make the image bigger, else smaller. +If INCREMENT is set, make the image bigger, else smaller. Or, alternatively, a SIZE may be specified." (interactive) ;; cleaning of old temp file (condition-case nil (apply 'delete-file (directory-files - thumbs-temp-dir t + (thumbs-temp-dir) t thumbs-temp-prefix)) (error nil)) (let ((buffer-read-only nil) @@ -276,7 +284,7 @@ Or, alternatively, a SIZE may be specified." thumbs-current-image-size) (thumbs-decrement-image-size thumbs-current-image-size)))) - (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym)))) + (tmp (thumbs-temp-file))) (erase-buffer) (thumbs-call-convert thumbs-current-image-filename tmp "sample" @@ -286,7 +294,7 @@ Or, alternatively, a SIZE may be specified." (setq thumbs-current-tmp-filename tmp))) (defun thumbs-resize-interactive (width height) - "Resize Image interactively to specified WIDTH and HEIGHT." + "Resize image interactively to specified WIDTH and HEIGHT." (interactive "nWidth: \nnHeight: ") (thumbs-resize-image nil (cons width height))) @@ -302,18 +310,21 @@ Or, alternatively, a SIZE may be specified." (defun thumbs-thumbname (img) "Return a thumbnail name for the image IMG." - (concat thumbs-thumbsdir "/" - (subst-char-in-string - ?\ ?\_ - (apply - 'concat - (split-string - (expand-file-name img) "/"))))) + (convert-standard-filename + (let ((filename (expand-file-name img))) + (format "%s%08x-%s.jpg" + (thumbs-thumbsdir) + (sxhash filename) + (subst-char-in-string + ?\s ?\_ + (apply + 'concat + (split-string filename "/"))))))) (defun thumbs-make-thumb (img) "Create the thumbnail for IMG." - (let* ((fn (expand-file-name img)) - (tn (thumbs-thumbname img))) + (let ((fn (expand-file-name img)) + (tn (thumbs-thumbname img))) (if (or (not (file-exists-p tn)) ;; This is not the right fix, but I don't understand ;; the external program or why it produces a geometry @@ -349,19 +360,19 @@ Or, alternatively, a SIZE may be specified." "Insert image IMG at point. TYPE and RELIEF will be used in constructing the image; see `image' in the emacs-lisp manual for further documentation. -if MARKED is non-nil, the image is marked." +If MARKED is non-nil, the image is marked." (let ((i `(image :type ,type :file ,img :relief ,relief :conversion ,(if marked 'disabled) :margin ,thumbs-margin))) (insert-image i) - (setq thumbs-current-image-size - (image-size i t)))) + (set (make-local-variable 'thumbs-current-image-size) + (image-size i t)))) (defun thumbs-insert-thumb (img &optional marked) "Insert the thumbnail for IMG at point. -if MARKED is non-nil, the image is marked" +If MARKED is non-nil, the image is marked." (thumbs-insert-image (thumbs-make-thumb img) 'jpeg thumbs-relief marked) (put-text-property (1- (point)) (point) @@ -378,8 +389,9 @@ if MARKED is non-nil, the image is marked" (unless (bobp) (newline)))) (defun thumbs-show-thumbs-list (L &optional buffer-name same-window) - (when (not (display-images-p)) - (error "Images are not supported in this Emacs session")) + (unless (and (display-images-p) + (image-type-available-p 'jpeg)) + (error "Required image type is not supported in this Emacs session")) (funcall (if same-window 'switch-to-buffer 'pop-to-buffer) (or buffer-name "*THUMB-View*")) (let ((inhibit-read-only t)) @@ -387,8 +399,7 @@ if MARKED is non-nil, the image is marked" (thumbs-mode) (thumbs-do-thumbs-insertion L) (goto-char (point-min)) - (setq thumbs-current-dir default-directory) - (make-variable-buffer-local 'thumbs-current-dir))) + (set (make-local-variable 'thumbs-current-dir) default-directory))) ;;;###autoload (defun thumbs-show-all-from-dir (dir &optional reg same-window) @@ -403,7 +414,7 @@ and SAME-WINDOW to show thumbs in the same window." ;;;###autoload (defun thumbs-dired-show-marked () - "In Dired, make a thumbs buffer with all marked files." + "In dired, make a thumbs buffer with all marked files." (interactive) (thumbs-show-thumbs-list (dired-get-marked-files) nil t)) @@ -426,16 +437,12 @@ and SAME-WINDOW to show thumbs in the same window." (setq thumbs-current-image-filename img thumbs-current-tmp-filename nil thumbs-image-num (or num 0)) - (make-variable-buffer-local 'thumbs-current-image-filename) - (make-variable-buffer-local 'thumbs-current-tmp-filename) - (make-variable-buffer-local 'thumbs-current-image-size) - (make-variable-buffer-local 'thumbs-image-num) (delete-region (point-min)(point-max)) (thumbs-insert-image img (thumbs-image-type img) 0))) (defun thumbs-find-image-at-point (&optional img otherwin) "Display image IMG for thumbnail at point. -use another window it OTHERWIN is t." +Use another window if OTHERWIN is t." (interactive) (let* ((i (or img (thumbs-current-image)))) (thumbs-find-image i (point) otherwin))) @@ -499,7 +506,7 @@ Open another window." (nreverse list)))) (defun thumbs-delete-images () - "Delete the image at point (and it's thumbnail) (or marked files if any)." + "Delete the image at point (and its thumbnail) (or marked files if any)." (interactive) (let ((files (or thumbs-markedL (list (thumbs-current-image))))) (if (yes-or-no-p (format "Really delete %d files? " (length files))) @@ -520,7 +527,7 @@ Open another window." (delq x thumbs-markedL))))))))) (defun thumbs-rename-images (newfile) - "Rename the image at point (and it's thumbnail) (or marked files if any)." + "Rename the image at point (and its thumbnail) (or marked files if any)." (interactive "FRename to file or directory: ") (let ((files (or thumbs-markedL (list (thumbs-current-image)))) failures) @@ -558,11 +565,7 @@ Open another window." (defun thumbs-kill-buffer () "Kill the current buffer." (interactive) - (let ((buffer (current-buffer))) - (condition-case nil - (delete-window (selected-window)) - (error nil)) - (kill-buffer buffer))) + (quit-window t (selected-window))) (defun thumbs-show-image-num (num) "Show the image with number NUM." @@ -574,7 +577,7 @@ Open another window." thumbs-current-image-filename i)))) (defun thumbs-next-image () - "Show next image." + "Show the next image." (interactive) (let* ((i (1+ thumbs-image-num)) (list (thumbs-file-alist)) @@ -635,11 +638,11 @@ ACTION and ARG should be a valid convert command." ;; cleaning of old temp file (mapc 'delete-file (directory-files - thumbs-temp-dir + (thumbs-temp-dir) t thumbs-temp-prefix)) (let ((buffer-read-only nil) - (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym)))) + (tmp (thumbs-temp-file))) (erase-buffer) (thumbs-call-convert thumbs-current-image-filename tmp @@ -754,9 +757,8 @@ ACTION and ARG should be a valid convert command." (define-derived-mode thumbs-mode fundamental-mode "thumbs" "Preview images in a thumbnails buffer" - (make-variable-buffer-local 'thumbs-markedL) (setq buffer-read-only t) - (setq thumbs-markedL nil)) + (set (make-local-variable 'thumbs-markedL) nil)) (defvar thumbs-view-image-mode-map (let ((map (make-sparse-keymap))) @@ -782,7 +784,7 @@ ACTION and ARG should be a valid convert command." ;;;###autoload (defun thumbs-dired-setroot () - "In dired, Call the setroot program on the image at point." + "In dired, call the setroot program on the image at point." (interactive) (thumbs-call-setroot-command (dired-get-filename))) @@ -793,7 +795,5 @@ ACTION and ARG should be a valid convert command." (provide 'thumbs) +;; arch-tag: f9ac1ef8-83fc-42c0-8069-1fae43fd2e5c ;;; thumbs.el ends here - - -;;; arch-tag: f9ac1ef8-83fc-42c0-8069-1fae43fd2e5c