(font-lock-keyword-face, font-lock-set-defaults, font-lock-string-face):

[gnu-emacs] / lisp / thumbs.el

diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 8bba647a2ad3845090a2bcab08232dfddff1f943..0fa448d4d7a1e5aa8f8e7fac78e6837938344704 100644 (file)
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -1,15 +1,10 @@
 ;;; thumbs.el --- Thumbnails previewer for images files
 ;;; thumbs.el --- Thumbnails previewer for images files

-;;;
+
+;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.
+

 ;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca>
 ;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca>

-;;
-;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some time
-;;         The peoples at #emacs@freenode.net for numerous help
-;;         RMS for emacs and the GNU project.
-;;

 ;; Keywords: Multimedia
 
 ;; Keywords: Multimedia
 

-(defconst thumbs-version "2.0")
-

 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; This file is part of GNU Emacs.
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify


@@ -24,14 +19,19 @@
 
 ;; 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
 
 ;; 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 <alex@gnu.org> for maintaining the package at some time
+;;         The peoples at #emacs@freenode.net for numerous help
+;;         RMS for emacs and the GNU project.
+;;

 
 ;;; Commentary:
 
 ;; This package create two new mode: thumbs-mode and
 
 ;;; Commentary:
 
 ;; This package create two new mode: thumbs-mode and

-;; thumbs-view-image-mode. It is used for images browsing and viewing
-;; from within emacs. Minimal image manipulation functions are also
+;; thumbs-view-image-mode.  It is used for images browsing and viewing
+;; from within Emacs.  Minimal image manipulation functions are also

 ;; available via external programs.
 ;;
 ;; The 'convert' program from 'ImageMagick'
 ;; available via external programs.
 ;;
 ;; The 'convert' program from 'ImageMagick'


@@ -58,23 +58,14 @@
 
 (require 'dired)
 
 
 (require 'dired)
 

-;; Abort if in-line imaging isn't supported (i.e. Emacs-20.7)
-
-(when (not (display-images-p))
-  (error "Your Emacs version (%S) doesn't support in-line images,
-was not compiled with image support or is run in console mode.
-Upgrade to Emacs 21.1 or newer, compile it with image support
-or use a window-system"
-        emacs-version))
-

 ;; CUSTOMIZATIONS
 
 (defgroup thumbs nil
   "Thumbnails previewer."
 ;; CUSTOMIZATIONS
 
 (defgroup thumbs nil
   "Thumbnails previewer."

+  :version "22.1"

   :group 'multimedia)
 
   :group 'multimedia)
 

-(defcustom thumbs-thumbsdir
-  (expand-file-name "~/.emacs-thumbs")
+(defcustom thumbs-thumbsdir "~/.emacs-thumbs"

   "*Directory to store thumbnails."
   :type 'directory
   :group 'thumbs)
   "*Directory to store thumbnails."
   :type 'directory
   :group 'thumbs)


@@ -86,17 +77,17 @@ or use a window-system"
 
 (defcustom thumbs-per-line 5
   "*Number of thumbnails per line to show in directory."
 
 (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.
   :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
   :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"))
       "convert.exe"
     (or (executable-find "convert")
        "/usr/X11R6/bin/convert"))


@@ -113,32 +104,31 @@ It must be 'convert'."
 
 (defcustom thumbs-relief 5
   "*Size of button-like border around thumbnails."
 
 (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."
   :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
   :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
   :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)
 
   :group 'thumbs)
 

-(defcustom thumbs-temp-dir
-  "/tmp/"
+(defcustom thumbs-temp-dir temporary-file-directory

   "Temporary directory to use.
   "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)
 
   :type 'directory
   :group 'thumbs)
 


@@ -148,68 +138,66 @@ see some of your images."
   :group 'thumbs)
 
 ;; Initialize some variable, for later use.
   :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.")
   "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.")
   "Filename of current image.")

-(defvar thumbs-current-image-size
-  nil
+(make-variable-buffer-local 'thumbs-current-image-filename)
+
+(defvar thumbs-current-image-size nil

   "Size of current image.")
   "Size of current image.")

-(defvar thumbs-image-num
-  nil
+
+(defvar thumbs-image-num nil

   "Number of current image.")
   "Number of current image.")

-(defvar thumbs-current-dir
-  nil
+(make-variable-buffer-local 'thumbs-image-num)
+
+(defvar thumbs-current-dir nil

   "Current directory.")
   "Current directory.")

-(defvar thumbs-markedL
-  nil
+
+(defvar thumbs-markedL nil

   "List of marked files.")
 
   "List of marked files.")
 

-;; Make sure auto-image-file-mode is ON.
-(auto-image-file-mode t)
-
-;; Create the thumbs directory if it does not exists.
-(setq thumbs-thumbsdir (expand-file-name thumbs-thumbsdir))
-
-(when (not (file-directory-p thumbs-thumbsdir))
-  (progn
-    (make-directory thumbs-thumbsdir)
-    (message "Creating thumbnails directory")))
-
-(when (not (fboundp 'ignore-errors))
-  (defmacro ignore-errors (&rest body)
-    "Execute FORMS; if anz error occurs, return nil.
-Otherwise, return result of last FORM."
-    (let ((err (thumbs-gensym)))
-      (list 'condition-case err (cons 'progn body) '(error nil)))))
-
-(when (not (fboundp 'caddar))
-  (defun caddar (x)
-    "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
-    (car (cdr (cdr (car x))))))
-
-(defvar thumbs-gensym-counter 0)
-
-(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.
 
 (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
 reached."
   (let* ((filesL
          (sort


@@ -217,14 +205,14 @@ reached."
            (lambda (f)
              (let ((fattribsL (file-attributes f)))
                `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f)))
            (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
         (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL))))
     (while (> dirsize thumbs-thumbsdir-max-size)
       (progn

-       (message "Deleting file %s" (caddar filesL)))
-      (delete-file (caddar filesL))
-      (setq dirsize (- dirsize (cadar filesL)))
+       (message "Deleting file %s" (cadr (cdar filesL))))
+      (delete-file (cadr (cdar filesL)))
+      (setq dirsize (- dirsize (car (cdar filesL))))

       (setq filesL (cdr filesL)))))
 
 ;; Check the thumbsnail directory size and clean it if necessary.
       (setq filesL (cdr filesL)))))
 
 ;; Check the thumbsnail directory size and clean it if necessary.


@@ -237,11 +225,11 @@ reached."
 FILEIN is the input file,
 FILEOUT is the output file,
 ACTION is the command to send to convert.
 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,
 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
 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 "-")
   (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\""
                         thumbs-conversion-program
                         (or action-prefix "-")


@@ -261,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)
   (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)
   (cons
    (thumbs-increment-image-size-element (car s)
                                        thumbs-image-resizing-step)


@@ -269,7 +257,7 @@ ACTION-PREFIX is the symbol to place before the ACTION command
                                        thumbs-image-resizing-step)))
 
 (defun thumbs-decrement-image-size (s)
                                        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)
   (cons
    (thumbs-decrement-image-size-element (car s)
                                        thumbs-image-resizing-step)


@@ -278,15 +266,16 @@ ACTION-PREFIX is the symbol to place before the ACTION command
 
 (defun thumbs-resize-image (&optional increment size)
   "Resize image in current buffer.
 
 (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
 Or, alternatively, a SIZE may be specified."
   (interactive)
   ;; cleaning of old temp file

-  (ignore-errors
+  (condition-case nil

     (apply 'delete-file
           (directory-files
     (apply 'delete-file
           (directory-files

-           thumbs-temp-dir t
-           thumbs-temp-prefix)))
+           (thumbs-temp-dir) t
+           thumbs-temp-prefix))
+    (error nil))

   (let ((buffer-read-only nil)
        (x (if size
               size
   (let ((buffer-read-only nil)
        (x (if size
               size


@@ -295,7 +284,7 @@ Or, alternatively, a SIZE may be specified."
                  thumbs-current-image-size)
               (thumbs-decrement-image-size
                thumbs-current-image-size))))
                  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"
     (erase-buffer)
     (thumbs-call-convert thumbs-current-image-filename
                         tmp "sample"


@@ -305,7 +294,7 @@ Or, alternatively, a SIZE may be specified."
     (setq thumbs-current-tmp-filename tmp)))
 
 (defun thumbs-resize-interactive (width height)
     (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)))
 
   (interactive "nWidth: \nnHeight: ")
   (thumbs-resize-image nil (cons width height)))
 


@@ -319,34 +308,29 @@ Or, alternatively, a SIZE may be specified."
   (interactive)
   (thumbs-resize-image t))
 
   (interactive)
   (thumbs-resize-image t))
 

-(defun thumbs-subst-char-in-string (orig rep string)
-  "Replace occurrences of character ORIG with character REP in STRING.
-Return the resulting (new) string.  -- (defun borowed to Dave Love)"
-  (let ((string (copy-sequence string))
-       (l (length string))
-       (i 0))
-    (while (< i l)
-      (if (= (aref string i) orig)
-         (aset string i rep))
-      (setq i (1+ i)))
-    string))
-

 (defun thumbs-thumbname (img)
   "Return a thumbnail name for the image IMG."
 (defun thumbs-thumbname (img)
   "Return a thumbnail name for the image IMG."

-  (concat thumbs-thumbsdir "/"
-         (thumbs-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."
 
 (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))
     (if (or (not (file-exists-p tn))

-           (not (equal (thumbs-file-size tn) thumbs-geometry)))
+           ;;  This is not the right fix, but I don't understand
+           ;;  the external program or why it produces a geometry
+           ;;  unequal to the one requested -- rms.
+;;;        (not (equal (thumbs-file-size tn) thumbs-geometry))
+           )

        (thumbs-call-convert fn tn "sample" thumbs-geometry))
     tn))
 
        (thumbs-call-convert fn tn "sample" thumbs-geometry))
     tn))
 


@@ -376,48 +360,46 @@ Return the resulting (new) string.  -- (defun borowed to Dave Love)"
   "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.
   "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)
   (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.
 
 (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-insert-image

-   (thumbs-make-thumb img) 'jpeg thumbs-relief marked))
+   (thumbs-make-thumb img) 'jpeg thumbs-relief marked)
+  (put-text-property (1- (point)) (point)
+                    'thumb-image-file img))

 
 (defun thumbs-do-thumbs-insertion (L)
   "Insert all thumbs in list L."
 
 (defun thumbs-do-thumbs-insertion (L)
   "Insert all thumbs in list L."

-  (setq thumbs-fileL nil)

   (let ((i 0))
   (let ((i 0))

-    (while L
+    (dolist (img L)
+      (thumbs-insert-thumb img
+                          (member img thumbs-markedL))

       (when (= 0 (mod (setq i (1+ i)) thumbs-per-line))
       (when (= 0 (mod (setq i (1+ i)) thumbs-per-line))

-       (newline))
-      (setq thumbs-fileL (cons (cons (point)
-                                    (car L))
-                              thumbs-fileL))
-      (thumbs-insert-thumb (car L)
-                          (member (car L) thumbs-markedL))
-      (setq L (cdr L)))))
+       (newline)))
+    (unless (bobp) (newline))))

 
 (defun thumbs-show-thumbs-list (L &optional buffer-name same-window)
 
 (defun thumbs-show-thumbs-list (L &optional buffer-name same-window)

+  (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))
     (erase-buffer)
     (thumbs-mode)
   (funcall (if same-window 'switch-to-buffer 'pop-to-buffer)
           (or buffer-name "*THUMB-View*"))
   (let ((inhibit-read-only t))
     (erase-buffer)
     (thumbs-mode)

-    (make-variable-buffer-local 'thumbs-fileL)
-    (setq thumbs-fileL nil)

     (thumbs-do-thumbs-insertion L)
     (goto-char (point-min))
     (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)
 
 ;;;###autoload
 (defun thumbs-show-all-from-dir (dir &optional reg same-window)


@@ -432,7 +414,7 @@ and SAME-WINDOW to show thumbs in the same window."
 
 ;;;###autoload
 (defun thumbs-dired-show-marked ()
 
 ;;;###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))
 
   (interactive)
   (thumbs-show-thumbs-list (dired-get-marked-files) nil t))
 


@@ -445,7 +427,7 @@ and SAME-WINDOW to show thumbs in the same window."
 ;;;###autoload
 (defalias 'thumbs 'thumbs-show-all-from-dir)
 
 ;;;###autoload
 (defalias 'thumbs 'thumbs-show-all-from-dir)
 

-(defun thumbs-find-image (img L &optional num otherwin)
+(defun thumbs-find-image (img &optional num otherwin)

   (funcall
    (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer)
    (concat "*Image: " (file-name-nondirectory img) " - "
   (funcall
    (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer)
    (concat "*Image: " (file-name-nondirectory img) " - "


@@ -455,23 +437,15 @@ 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))
     (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)
-    (make-variable-buffer-local 'thumbs-fileL)
-    (setq thumbs-fileL L)

     (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.
     (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)
   (interactive)

-  (let* ((L thumbs-fileL)
-        (n (point))
-        (i (or img (cdr (assoc n L)))))
-    (thumbs-find-image i L n otherwin)))
+  (let* ((i (or img (thumbs-current-image))))
+    (thumbs-find-image i (point) otherwin)))

 
 (defun thumbs-find-image-at-point-other-window ()
   "Display image for thumbnail at point in the preview buffer.
 
 (defun thumbs-find-image-at-point-other-window ()
   "Display image for thumbnail at point in the preview buffer.


@@ -479,6 +453,12 @@ Open another window."
   (interactive)
   (thumbs-find-image-at-point nil t))
 
   (interactive)
   (thumbs-find-image-at-point nil t))
 

+(defun thumbs-mouse-find-image (event)
+  "Display image for thumbnail at mouse click EVENT."
+  (interactive "e")
+  (mouse-set-point event)
+  (thumbs-find-image-at-point))
+

 (defun thumbs-call-setroot-command (img)
   "Call the setroot program for IMG."
   (run-hooks 'thumbs-before-setroot-hook)
 (defun thumbs-call-setroot-command (img)
   "Call the setroot program for IMG."
   (run-hooks 'thumbs-before-setroot-hook)


@@ -491,7 +471,8 @@ Open another window."
 (defun thumbs-set-image-at-point-to-root-window ()
   "Set the image at point as the desktop wallpaper."
   (interactive)
 (defun thumbs-set-image-at-point-to-root-window ()
   "Set the image at point as the desktop wallpaper."
   (interactive)

-  (thumbs-call-setroot-command (cdr (assoc (point) thumbs-fileL))))
+  (thumbs-call-setroot-command
+   (thumbs-current-image)))

 
 (defun thumbs-set-root ()
   "Set the current image as root."
 
 (defun thumbs-set-root ()
   "Set the current image as root."


@@ -500,92 +481,168 @@ Open another window."
    (or thumbs-current-tmp-filename
        thumbs-current-image-filename)))
 
    (or thumbs-current-tmp-filename
        thumbs-current-image-filename)))
 

+(defun thumbs-file-alist ()
+  "Make an alist of elements (POS . FILENAME) for all images in thumb buffer."
+  (save-excursion
+    (let (list)
+      (goto-char (point-min))
+      (while (not (eobp))
+       (if (thumbs-current-image)
+           (push (cons (point-marker)
+                       (thumbs-current-image))
+                 list))
+       (forward-char 1))
+      list)))
+
+(defun thumbs-file-list ()
+  "Make a list of file names for all images in thumb buffer."
+  (save-excursion
+    (let (list)
+      (goto-char (point-min))
+      (while (not (eobp))
+       (if (thumbs-current-image)
+           (push (thumbs-current-image) list))
+       (forward-char 1))
+      (nreverse list))))
+

 (defun thumbs-delete-images ()
 (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)
   (interactive)

-  (let ((f (or thumbs-markedL (list (cdr (assoc (point) thumbs-fileL))))))
-    (if (yes-or-no-p "Really delete %d files?" (length f))
-       (progn
-         (mapcar (lambda (x)
-                   (setq thumbs-fileL (delete (rassoc x thumbs-fileL) thumbs-fileL))
+  (let ((files (or thumbs-markedL (list (thumbs-current-image)))))
+    (if (yes-or-no-p (format "Really delete %d files? " (length files)))
+       (let ((thumbs-fileL (thumbs-file-alist))
+             (inhibit-read-only t))
+         (dolist (x files)
+           (let (failure)
+             (condition-case ()
+                 (progn

                    (delete-file x)
                    (delete-file x)

-                   (delete-file (thumbs-thumbname x))) f)
-         (thumbs-redraw-buffer)))))
+                   (delete-file (thumbs-thumbname x)))
+               (file-error (setq failure t)))
+             (unless failure
+               (when (rassoc x thumbs-fileL)
+                 (goto-char (car (rassoc x thumbs-fileL)))
+                 (delete-region (point) (1+ (point))))
+               (setq thumbs-markedL
+                     (delq x thumbs-markedL)))))))))
+
+(defun thumbs-rename-images (newfile)
+  "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)
+    (if (and (not (file-directory-p newfile))
+            thumbs-markedL)
+       (if (file-exists-p newfile)
+           (error "Renaming marked files to file name `%s'" newfile)
+         (make-directory newfile t)))
+    (if (yes-or-no-p (format "Really rename %d files? " (length files)))
+       (let ((thumbs-fileL (thumbs-file-alist))
+             (inhibit-read-only t))
+         (dolist (file files)
+           (let (failure)
+             (condition-case ()
+                 (if (file-directory-p newfile)
+                     (rename-file file
+                                  (expand-file-name
+                                   (file-name-nondirectory file)
+                                   newfile))
+                   (rename-file file newfile))
+               (file-error (setq failure t)
+                           (push file failures)))
+             (unless failure
+               (when (rassoc file thumbs-fileL)
+                 (goto-char (car (rassoc file thumbs-fileL)))
+                 (delete-region (point) (1+ (point))))
+               (setq thumbs-markedL
+                     (delq file thumbs-markedL)))))))
+    (if failures
+       (display-warning 'file-error
+                        (format "Rename failures for %s into %s"
+                                failures newfile)
+                        :error))))

 
 (defun thumbs-kill-buffer ()
   "Kill the current buffer."
   (interactive)
 
 (defun thumbs-kill-buffer ()
   "Kill the current buffer."
   (interactive)

-  (let ((buffer (current-buffer)))
-    (ignore-errors (delete-window (selected-window)))
-    (kill-buffer buffer)))
+  (quit-window t (selected-window)))

 
 (defun thumbs-show-image-num (num)
   "Show the image with number NUM."
 
 (defun thumbs-show-image-num (num)
   "Show the image with number NUM."

-  (let ((inhibit-read-only t))
-    (delete-region (point-min)(point-max))
-    (let ((i (cdr (assoc num thumbs-fileL))))
-      (thumbs-insert-image i (thumbs-image-type i) 0)
-      (sleep-for 2)
-      (rename-buffer (concat "*Image: "
-                            (file-name-nondirectory i)
-                            " - "
-                            (number-to-string num) "*")))
-    (setq thumbs-image-num num
-         thumbs-current-image-filename i)))
+  (let ((image-buffer (get-buffer-create "*Image*")))
+    (let ((i (thumbs-current-image)))
+      (with-current-buffer image-buffer
+       (thumbs-insert-image i (thumbs-image-type i) 0))
+      (setq thumbs-image-num num
+           thumbs-current-image-filename i))))

 
 (defun thumbs-next-image ()
 
 (defun thumbs-next-image ()

-  "Show next image."
+  "Show the next image."

   (interactive)
   (let* ((i (1+ thumbs-image-num))
   (interactive)
   (let* ((i (1+ thumbs-image-num))

-        (l (caar thumbs-fileL))
-        (num
-         (cond ((assoc i thumbs-fileL) i)
-               ((>= i l) 1)
-               (t (1+ i)))))
-    (thumbs-show-image-num num)))
+        (list (thumbs-file-alist))
+        (l (caar list)))
+    (while (and (/= i thumbs-image-num) (not (assoc i list)))
+      (setq i (if (>= i l) 1 (1+ i))))
+    (thumbs-show-image-num i)))

 
 (defun thumbs-previous-image ()
   "Show the previous image."
   (interactive)
   (let* ((i (- thumbs-image-num 1))
 
 (defun thumbs-previous-image ()
   "Show the previous image."
   (interactive)
   (let* ((i (- thumbs-image-num 1))

-        (l (caar thumbs-fileL))
-        (num
-         (cond ((assoc i thumbs-fileL) i)
-               ((<= i 1) l)
-               (t (- i 1)))))
-    (thumbs-show-image-num num)))
+        (list (thumbs-file-alist))
+        (l (caar list)))
+    (while (and (/= i thumbs-image-num) (not (assoc i list)))
+      (setq i (if (<= i 1) l (1- i))))
+    (thumbs-show-image-num i)))

 
 (defun thumbs-redraw-buffer ()
   "Redraw the current thumbs buffer."
   (let ((p (point))
 
 (defun thumbs-redraw-buffer ()
   "Redraw the current thumbs buffer."
   (let ((p (point))

-       (inhibit-read-only t))
-    (delete-region (point-min)(point-max))
-    (thumbs-do-thumbs-insertion (reverse (mapcar 'cdr thumbs-fileL)))
-    (goto-char (1+ p))))
+       (inhibit-read-only t)
+       (files (thumbs-file-list)))
+    (erase-buffer)
+    (thumbs-do-thumbs-insertion files)
+    (goto-char p)))

 
 (defun thumbs-mark ()
   "Mark the image at point."
   (interactive)
 
 (defun thumbs-mark ()
   "Mark the image at point."
   (interactive)

-  (setq thumbs-markedL (cons (cdr (assoc (point) thumbs-fileL)) thumbs-markedL))
-  (let ((inhibit-read-only t))
-    (delete-char 1)
-    (thumbs-insert-thumb (cdr (assoc (point) thumbs-fileL)) t))
-  (when (eolp)(forward-char)))
+  (let ((elt (thumbs-current-image)))
+    (unless elt
+      (error "No image here"))
+    (push elt thumbs-markedL)
+    (let ((inhibit-read-only t))
+      (delete-char 1)
+      (thumbs-insert-thumb elt t)))
+  (when (eolp) (forward-char)))
+
+(defun thumbs-unmark ()
+  "Unmark the image at point."
+  (interactive)
+  (let ((elt (thumbs-current-image)))
+    (unless elt
+      (error "No image here"))
+    (setq thumbs-markedL (delete elt thumbs-markedL))
+    (let ((inhibit-read-only t))
+      (delete-char 1)
+      (thumbs-insert-thumb elt nil)))
+  (when (eolp) (forward-char)))

 
 ;; Image modification routines
 
 (defun thumbs-modify-image (action &optional arg)
   "Call convert to do ACTION on image with argument ARG.
 
 ;; Image modification routines
 
 (defun thumbs-modify-image (action &optional arg)
   "Call convert to do ACTION on image with argument ARG.

-ACTION and ARG should be legal convert command."
+ACTION and ARG should be a valid convert command."

   (interactive "sAction: \nsValue: ")
   ;; cleaning of old temp file
   (mapc 'delete-file
        (directory-files
   (interactive "sAction: \nsValue: ")
   ;; 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)
         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
     (erase-buffer)
     (thumbs-call-convert thumbs-current-image-filename
                         tmp


@@ -597,8 +654,8 @@ ACTION and ARG should be legal convert command."
 (defun thumbs-emboss-image (emboss)
   "Emboss the image with value EMBOSS."
   (interactive "nEmboss value: ")
 (defun thumbs-emboss-image (emboss)
   "Emboss the image with value EMBOSS."
   (interactive "nEmboss value: ")

-  (if (or (< emboss 3)(> emboss 31)(evenp emboss))
-      (error "Arg must be a odd number between 3 and 31"))
+  (if (or (< emboss 3) (> emboss 31) (zerop (% emboss 2)))
+      (error "Arg must be an odd number between 3 and 31"))

   (thumbs-modify-image "emboss" (number-to-string emboss)))
 
 (defun thumbs-monochrome-image ()
   (thumbs-modify-image "emboss" (number-to-string emboss)))
 
 (defun thumbs-monochrome-image ()


@@ -621,17 +678,24 @@ ACTION and ARG should be legal convert command."
   (interactive)
   (thumbs-modify-image "rotate" "90"))
 
   (interactive)
   (thumbs-modify-image "rotate" "90"))
 

+(defun thumbs-current-image ()
+  "Return the name of the image file name at point."
+  (get-text-property (point) 'thumb-image-file))
+

 (defun thumbs-forward-char ()
   "Move forward one image."
   (interactive)
   (forward-char)
 (defun thumbs-forward-char ()
   "Move forward one image."
   (interactive)
   (forward-char)

-  (when (eolp)(forward-char))
+  (while (and (not (eobp)) (not (thumbs-current-image)))
+    (forward-char))

   (thumbs-show-name))
 
 (defun thumbs-backward-char ()
   "Move backward one image."
   (interactive)
   (forward-char -1)
   (thumbs-show-name))
 
 (defun thumbs-backward-char ()
   "Move backward one image."
   (interactive)
   (forward-char -1)

+  (while (and (not (bobp)) (not (thumbs-current-image)))
+    (forward-char -1))

   (thumbs-show-name))
 
 (defun thumbs-forward-line ()
   (thumbs-show-name))
 
 (defun thumbs-forward-line ()


@@ -649,15 +713,15 @@ ACTION and ARG should be legal convert command."
 (defun thumbs-show-name ()
   "Show the name of the current file."
   (interactive)
 (defun thumbs-show-name ()
   "Show the name of the current file."
   (interactive)

-  (let ((f (cdr (assoc (point) thumbs-fileL))))
-    (message "%s [%s]" f (thumbs-file-size f))))
+  (let ((f (thumbs-current-image)))
+    (and f (message "%s [%s]" f (thumbs-file-size f)))))

 
 (defun thumbs-save-current-image ()
   "Save the current image."
   (interactive)
   (let ((f (or thumbs-current-tmp-filename
               thumbs-current-image-filename))
 
 (defun thumbs-save-current-image ()
   "Save the current image."
   (interactive)
   (let ((f (or thumbs-current-tmp-filename
               thumbs-current-image-filename))

-       (sa (read-from-minibuffer "save file as: "
+       (sa (read-from-minibuffer "Save image file as: "

                                  thumbs-current-image-filename)))
     (copy-file f sa)))
 
                                  thumbs-current-image-filename)))
     (copy-file f sa)))
 


@@ -671,6 +735,7 @@ ACTION and ARG should be legal convert command."
 (defvar thumbs-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map [return] 'thumbs-find-image-at-point)
 (defvar thumbs-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map [return] 'thumbs-find-image-at-point)

+    (define-key map [mouse-2] 'thumbs-mouse-find-image)

     (define-key map [(meta return)] 'thumbs-find-image-at-point-other-window)
     (define-key map [(control return)] 'thumbs-set-image-at-point-to-root-window)
     (define-key map [delete] 'thumbs-delete-images)
     (define-key map [(meta return)] 'thumbs-find-image-at-point-other-window)
     (define-key map [(control return)] 'thumbs-set-image-at-point-to-root-window)
     (define-key map [delete] 'thumbs-delete-images)


@@ -680,16 +745,20 @@ ACTION and ARG should be legal convert command."
     (define-key map [down] 'thumbs-forward-line)
     (define-key map "d" 'thumbs-dired)
     (define-key map "m" 'thumbs-mark)
     (define-key map [down] 'thumbs-forward-line)
     (define-key map "d" 'thumbs-dired)
     (define-key map "m" 'thumbs-mark)

+    (define-key map "u" 'thumbs-unmark)
+    (define-key map "R" 'thumbs-rename-images)
+    (define-key map "x" 'thumbs-delete-images)

     (define-key map "s" 'thumbs-show-name)
     (define-key map "q" 'thumbs-kill-buffer)
     map)
   "Keymap for `thumbs-mode'.")
 
     (define-key map "s" 'thumbs-show-name)
     (define-key map "q" 'thumbs-kill-buffer)
     map)
   "Keymap for `thumbs-mode'.")
 

+(put 'thumbs-mode 'mode-class 'special)

 (define-derived-mode thumbs-mode
   fundamental-mode "thumbs"
   "Preview images in a thumbnails buffer"
 (define-derived-mode thumbs-mode
   fundamental-mode "thumbs"
   "Preview images in a thumbnails buffer"

-  (make-variable-buffer-local 'thumbs-markedL)
-  (setq thumbs-markedL nil))
+  (setq buffer-read-only t)
+  (set (make-local-variable 'thumbs-markedL) nil))

 
 (defvar thumbs-view-image-mode-map
   (let ((map (make-sparse-keymap)))
 
 (defvar thumbs-view-image-mode-map
   (let ((map (make-sparse-keymap)))


@@ -703,17 +772,19 @@ ACTION and ARG should be legal convert command."
     (define-key map "r" 'thumbs-resize-interactive)
     (define-key map "s" 'thumbs-save-current-image)
     (define-key map "q" 'thumbs-kill-buffer)
     (define-key map "r" 'thumbs-resize-interactive)
     (define-key map "s" 'thumbs-save-current-image)
     (define-key map "q" 'thumbs-kill-buffer)

-    (define-key map "w" 'thunbs-set-root)
+    (define-key map "w" 'thumbs-set-root)

     map)
   "Keymap for `thumbs-view-image-mode'.")
 
 ;; thumbs-view-image-mode
     map)
   "Keymap for `thumbs-view-image-mode'.")
 
 ;; thumbs-view-image-mode

+(put 'thumbs-view-image-mode 'mode-class 'special)

 (define-derived-mode thumbs-view-image-mode
 (define-derived-mode thumbs-view-image-mode

-  fundamental-mode "image-view-mode")
+  fundamental-mode "image-view-mode"
+  (setq buffer-read-only t))

 
 ;;;###autoload
 (defun thumbs-dired-setroot ()
 
 ;;;###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)))
 
   (interactive)
   (thumbs-call-setroot-command (dired-get-filename)))
 


@@ -724,7 +795,5 @@ ACTION and ARG should be legal convert command."
 
 (provide 'thumbs)
 
 
 (provide 'thumbs)
 

+;; arch-tag: f9ac1ef8-83fc-42c0-8069-1fae43fd2e5c

 ;;; thumbs.el ends here
 ;;; thumbs.el ends here

-
-
-;;; arch-tag: f9ac1ef8-83fc-42c0-8069-1fae43fd2e5c