comparison lisp/thumbs.el @ 55827:c5c73c8c2b3e

Don't include cl. Don't bother with old Emacs versions. (thumbs-subst-char-in-string): Deleted. (thumbs-thumbname): Use subst-char-in-string. (thumbs-resize-image): Use condition-case, not ignore-errors. (thumbs-kill-buffer): Likewise. (thumbs-mode): Make buffer read-only. (thumbs-make-thumb): Unconditionally accept an existing file. (thumbs-insert-thumb): Add thumb-image-file property to the image. (thumbs-do-thumbs-insertion): Be smarter about where to put newlines. (thumbs-show-thumbs-list): Error if images not supported. (thumbs-save-current-image): Improve prompt string. (thumbs-mode-map): Define u, R, x. (thumbs-unmark): New command. (thumbs-emboss-image): Minor cleanup. (thumbs-forward-char, thumbs-backward-char): Skip chars with no image. (thumbs-rename-images): New command. (thumbs-show-image-num): Rewrite. Don't rename the buffer. (thumbs-current-image): New function. (thumbs-file-list, thumbs-file-alist): New functions. (thumbs-find-image): Delete arg L. Don't set up thumbs-fileL as buffer-local global var. (thumbs-find-image-at-point): Use thumbs-current-image. (thumbs-set-image-at-point-to-root-window): Likewise. (thumbs-delete-images): Use thumbs-current-image, thumbs-file-alist. Record and warn about errors. Update thumbs-markedL for deletions. (thumbs-next-image, thumbs-previous-image): Use thumbs-file-alist. (thumbs-redraw-buffer): Use thumbs-file-list. (thumbs-mark): Use thumbs-current-image. (thumbs-show-name): Use thumbs-current-image. (thumbs-show-name): Do nothing if no image at point. (thumbs-mouse-find-image): New command. (thumbs-mode-map): Bind it to mouse-2. (thumbs-mode): Make mode-class special. (thumbs-view-image-mode): Likewise.

55826:e7bdb5b77df2

;;; thumbs.el --- Thumbnails previewer for images files
;;;
;; Author: Jean-Philippe Theberge <[e-mail]>
;;
;; Thanks: Alex Schroeder <[e-mail]> for maintaining the package at some time
;;         The peoples at #[e-mail] for numerous help
;;         RMS for emacs and the GNU project.
;;
;; 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
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

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

;;; Commentary:

;; This package create two new mode: thumbs-mode and
;; thumbs-view-image-mode. It is used for images browsing and viewing

;;; History:
;;

;;; Code:

(eval-when-compile
  (require 'cl))
(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."

	    (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
	(message "Deleting file %s" (caddar filesL)))
      (delete-file (caddar filesL))
      (setq dirsize (- dirsize (cadar filesL)))
      (setq filesL (cdr filesL)))))

;; Check the thumbsnail directory size and clean it if necessary.
(when thumbs-thumbsdir-auto-clean
  (thumbs-cleanup-thumbsdir))

  "Resize image in current buffer.
if INCREMENT is set, make the image bigger, else smaller.
Or, alternatively, a SIZE may be specified."
  (interactive)
  ;; cleaning of old temp file
  (ignore-errors
    (apply 'delete-file
	   (directory-files
	    thumbs-temp-dir t
	    thumbs-temp-prefix)))
  (let ((buffer-read-only nil)
	(x (if size
	       size
	     (if increment
		 (thumbs-increment-image-size

(defun thumbs-resize-image-size-up ()
  "Resize image (bigger)."
  (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."
  (concat thumbs-thumbsdir "/"
	  (thumbs-subst-char-in-string
	   ?\  ?\_
	   (apply
	    'concat
	    (split-string
	     (expand-file-name img) "/")))))

(defun thumbs-make-thumb (img)
  "Create the thumbnail for IMG."
  (let* ((fn (expand-file-name img))
	 (tn (thumbs-thumbname img)))
    (if (or (not (file-exists-p tn))
	    (not (equal (thumbs-file-size tn) thumbs-geometry)))
	(thumbs-call-convert fn tn "sample" thumbs-geometry))
    tn))

(defun thumbs-image-type (img)
  "Return image type from filename IMG."

(defun thumbs-insert-thumb (img &optional marked)
  "Insert the thumbnail for IMG at point.
if MARKED is non-nil, the image is marked"
  (thumbs-insert-image
   (thumbs-make-thumb img) 'jpeg thumbs-relief marked))

(defun thumbs-do-thumbs-insertion (L)
  "Insert all thumbs in list L."
  (setq thumbs-fileL nil)
  (let ((i 0))
    (while L
      (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)))))

(defun thumbs-show-thumbs-list (L &optional buffer-name same-window)
  (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))
    (setq thumbs-current-dir default-directory)
    (make-variable-buffer-local 'thumbs-current-dir)))

  (thumbs-show-all-from-dir default-directory nil t))

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

(defun thumbs-find-image (img L &optional num otherwin)
  (funcall
   (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer)
   (concat "*Image: " (file-name-nondirectory img) " - "
	   (number-to-string (or num 0)) "*"))
  (thumbs-view-image-mode)
  (let ((inhibit-read-only t))

	  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.
use another window it OTHERWIN is t."
  (interactive)
  (let* ((L thumbs-fileL)
	 (n (point))
	 (i (or img (cdr (assoc n L)))))
    (thumbs-find-image i L n otherwin)))

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

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

  (run-hooks 'thumbs-after-setroot-hook))

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

(defun thumbs-set-root ()
  "Set the current image as root."
  (interactive)
  (thumbs-call-setroot-command
   (or thumbs-current-tmp-filename
       thumbs-current-image-filename)))

(defun thumbs-delete-images ()
  "Delete the image at point (and it's thumbnail) (or marked files if any)."
  (interactive)
  (let ((f (or thumbs-markedL (list (cdr (assoc (point) thumbs-fileL))))))
    (if (yes-or-no-p (format "Really delete %d files? " (length f)))
	(progn
	  (mapcar (lambda (x)
		    (setq thumbs-fileL (delete (rassoc x thumbs-fileL) thumbs-fileL))
		    (delete-file x)
		    (delete-file (thumbs-thumbname x))) f)
	  (thumbs-redraw-buffer)))))

(defun thumbs-kill-buffer ()
  "Kill the current buffer."
  (interactive)
  (let ((buffer (current-buffer)))
    (ignore-errors (delete-window (selected-window)))
    (kill-buffer buffer)))

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

(defun thumbs-next-image ()
  "Show next image."
  (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)))

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

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

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

;; Image modification routines

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

    (setq thumbs-current-tmp-filename tmp)))

(defun thumbs-emboss-image (emboss)
  "Emboss the image with value EMBOSS."
  (interactive "nEmboss value: ")
  (if (or (< emboss 3) (> emboss 31) (zerop (logand emboss 1)))
      (error "Arg must be a odd number between 3 and 31"))
  (thumbs-modify-image "emboss" (number-to-string emboss)))

(defun thumbs-monochrome-image ()
  "Turn the image to monochrome."
  (interactive)

(defun thumbs-rotate-right ()
  "Rotate the image 90 degrees clockwise."
  (interactive)
  (thumbs-modify-image "rotate" "90"))

(defun thumbs-forward-char ()
  "Move forward one image."
  (interactive)
  (forward-char)
  (when (eolp)(forward-char))
  (thumbs-show-name))

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

(defun thumbs-forward-line ()
  "Move down one line."
  (interactive)

  (thumbs-show-name))

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

(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: "
				  thumbs-current-image-filename)))
    (copy-file f sa)))

(defun thumbs-dired ()
  "Use `dired' on the current thumbs directory."

;; thumbs-mode

(defvar thumbs-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [return] 'thumbs-find-image-at-point)
    (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 [right] 'thumbs-forward-char)
    (define-key map [left] 'thumbs-backward-char)
    (define-key map [up] 'thumbs-backward-line)
    (define-key map [down] 'thumbs-forward-line)
    (define-key map "d" 'thumbs-dired)
    (define-key map "m" 'thumbs-mark)
    (define-key map "s" 'thumbs-show-name)
    (define-key map "q" 'thumbs-kill-buffer)
    map)
  "Keymap for `thumbs-mode'.")

(define-derived-mode thumbs-mode
  fundamental-mode "thumbs"
  "Preview images in a thumbnails buffer"
  (make-variable-buffer-local 'thumbs-markedL)
  (setq thumbs-markedL nil))

(defvar thumbs-view-image-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [prior] 'thumbs-previous-image)

    (define-key map "w" 'thunbs-set-root)
    map)
  "Keymap for `thumbs-view-image-mode'.")

;; thumbs-view-image-mode
(define-derived-mode thumbs-view-image-mode
  fundamental-mode "image-view-mode")

;;;###autoload
(defun thumbs-dired-setroot ()

55827:c5c73c8c2b3e

;;; thumbs.el --- Thumbnails previewer for images files

;; Copyright 2004 Free Software Foundation, Inc

;; Author: Jean-Philippe Theberge <[e-mail]>
;; Keywords: Multimedia

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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.
;;              
;; Thanks: Alex Schroeder <[e-mail]> for maintaining the package at some time
;;         The peoples at #[e-mail] for numerous help
;;         RMS for emacs and the GNU project.
;;

;;; Commentary:

;; This package create two new mode: thumbs-mode and
;; thumbs-view-image-mode. It is used for images browsing and viewing

;;; History:
;;

;;; Code:

(require 'dired)

;; CUSTOMIZATIONS

(defgroup thumbs nil
  "Thumbnails previewer."

	    (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
	(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.
(when thumbs-thumbsdir-auto-clean
  (thumbs-cleanup-thumbsdir))

  "Resize image in current buffer.
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-prefix))
    (error nil))
  (let ((buffer-read-only nil)
	(x (if size
	       size
	     (if increment
		 (thumbs-increment-image-size

(defun thumbs-resize-image-size-up ()
  "Resize image (bigger)."
  (interactive)
  (thumbs-resize-image t))

(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) "/")))))

(defun thumbs-make-thumb (img)
  "Create the thumbnail for 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
	    ;;  unequal to the one requested -- rms.
;;;	    (not (equal (thumbs-file-size tn) thumbs-geometry))
	    )
	(thumbs-call-convert fn tn "sample" thumbs-geometry))
    tn))

(defun thumbs-image-type (img)
  "Return image type from filename IMG."

(defun thumbs-insert-thumb (img &optional marked)
  "Insert the thumbnail for IMG at point.
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)
		     'thumb-image-file img))

(defun thumbs-do-thumbs-insertion (L)
  "Insert all thumbs in list L."
  (let ((i 0))
    (dolist (img L)
      (thumbs-insert-thumb img
			   (member img thumbs-markedL))
      (when (= 0 (mod (setq i (1+ i)) thumbs-per-line))
	(newline)))
    (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"))
  (funcall (if same-window 'switch-to-buffer 'pop-to-buffer)
	   (or buffer-name "*THUMB-View*"))
  (let ((inhibit-read-only t))
    (erase-buffer)
    (thumbs-mode)
    (thumbs-do-thumbs-insertion L)
    (goto-char (point-min))
    (setq thumbs-current-dir default-directory)
    (make-variable-buffer-local 'thumbs-current-dir)))

  (thumbs-show-all-from-dir default-directory nil t))

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

(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) " - "
	   (number-to-string (or num 0)) "*"))
  (thumbs-view-image-mode)
  (let ((inhibit-read-only t))

	  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."
  (interactive)
  (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.
Open another window."
  (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)
  (shell-command (replace-regexp-in-string

  (run-hooks 'thumbs-after-setroot-hook))

(defun thumbs-set-image-at-point-to-root-window ()
  "Set the image at point as the desktop wallpaper."
  (interactive)
  (thumbs-call-setroot-command
   (thumbs-current-image)))

(defun thumbs-set-root ()
  "Set the current image as root."
  (interactive)
  (thumbs-call-setroot-command
   (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 ()
  "Delete the image at point (and it's 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)))
	(let ((thumbs-fileL (thumbs-file-alist))
	      (inhibit-read-only t))
	  (dolist (x files)
	    (let (failure)
	      (condition-case ()
		  (progn
		    (delete-file x)
		    (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 it's 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)
  (let ((buffer (current-buffer)))
    (condition-case nil
	(delete-window (selected-window))
      (error nil))
    (kill-buffer buffer)))

(defun thumbs-show-image-num (num)
  "Show the image with number NUM."
  (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 ()
  "Show next image."
  (interactive)
  (let* ((i (1+ thumbs-image-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))
	 (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))
	(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)
  (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.

    (setq thumbs-current-tmp-filename tmp)))

(defun thumbs-emboss-image (emboss)
  "Emboss the image with value EMBOSS."
  (interactive "nEmboss value: ")
  (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 ()
  "Turn the image to monochrome."
  (interactive)

(defun thumbs-rotate-right ()
  "Rotate the image 90 degrees clockwise."
  (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)
  (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)
  (while (and (not (bobp)) (not (thumbs-current-image)))
    (forward-char -1))
  (thumbs-show-name))

(defun thumbs-forward-line ()
  "Move down one line."
  (interactive)

  (thumbs-show-name))

(defun thumbs-show-name ()
  "Show the name of the current file."
  (interactive)
  (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))
	(sa (read-from-minibuffer "Save image file as: "
				  thumbs-current-image-filename)))
    (copy-file f sa)))

(defun thumbs-dired ()
  "Use `dired' on the current thumbs directory."

;; thumbs-mode

(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 [right] 'thumbs-forward-char)
    (define-key map [left] 'thumbs-backward-char)
    (define-key map [up] 'thumbs-backward-line)
    (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'.")

(put 'thumbs-mode 'mode-class 'special)
(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))

(defvar thumbs-view-image-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [prior] 'thumbs-previous-image)

    (define-key map "w" 'thunbs-set-root)
    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
  fundamental-mode "image-view-mode")

;;;###autoload
(defun thumbs-dired-setroot ()