lisp/thumbs.el

   1 ;;; thumbs.el --- Thumbnails previewer for images files
   2 ;;;
   3 ;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca>
   4 ;;
   5 ;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some time
   6 ;;         The peoples at #emacs@freenode.net for numerous help
   7 ;;         RMS for emacs and the GNU project.
   8 ;;
   9 ;; Keywords: Multimedia
  10
  11 (defconst thumbs-version "2.0")
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  28 ;; Boston, MA 02111-1307, USA.
  29
  30 ;;; Commentary:
  31
  32 ;; This package create two new mode: thumbs-mode and
  33 ;; thumbs-view-image-mode. It is used for images browsing and viewing
  34 ;; from within emacs. Minimal image manipulation functions are also
  35 ;; available via external programs.
  36 ;;
  37 ;; The 'convert' program from 'ImageMagick'
  38 ;; [URL:http://www.imagemagick.org/] is required.
  39 ;;
  40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  41 ;; CHANGELOG
  42 ;;
  43 ;; This is version 2.0
  44 ;;
  45 ;; USAGE
  46 ;;
  47 ;; Type M-x thumbs RET DIR RET to view the directory DIR in Thumbs mode.
  48 ;; That should be a directory containing image files.
  49 ;; from dired, C-t m enter in thumbs-mode with all marked files
  50 ;;             C-t a enter in thumbs-mode with all files in current-directory
  51 ;; In thumbs-mode, pressing <return> on a image will bring you in image view mode
  52 ;; for that image.  C-h m will give you a list of available keybinding.
  53
  54 ;;; History:
  55 ;;
  56
  57 ;;; Code:
  58
  59 (eval-when-compile
  60   (require 'cl))
  61 (require 'dired)
  62
  63 ;; Abort if in-line imaging isn't supported (i.e. Emacs-20.7)
  64
  65 (when (not (display-images-p))
  66   (error "Your Emacs version (%S) doesn't support in-line images,
  67 was not compiled with image support or is run in console mode.
  68 Upgrade to Emacs 21.1 or newer, compile it with image support
  69 or use a window-system"
  70          emacs-version))
  71
  72 ;; CUSTOMIZATIONS
  73
  74 (defgroup thumbs nil
  75   "Thumbnails previewer."
  76   :group 'multimedia)
  77
  78 (defcustom thumbs-thumbsdir
  79   (expand-file-name "~/.emacs-thumbs")
  80   "*Directory to store thumbnails."
  81   :type 'directory
  82   :group 'thumbs)
  83
  84 (defcustom thumbs-geometry "100x100"
  85   "*Size of thumbnails."
  86   :type 'string
  87   :group 'thumbs)
  88
  89 (defcustom thumbs-per-line 5
  90   "*Number of thumbnails per line to show in directory."
  91   :type 'string
  92   :group 'thumbs)
  93
  94 (defcustom thumbs-thumbsdir-max-size 50000000
  95   "Max size for thumbnails directory.
  96 When it reach that size (in bytes), a warning is send."
  97   :type 'string
  98   :group 'thumbs)
  99
 100 (defcustom thumbs-conversion-program
 101   (if (equal 'windows-nt system-type)
 102       "convert.exe"
 103     (or (executable-find "convert")
 104         "/usr/X11R6/bin/convert"))
 105   "*Name of conversion program for thumbnails generation.
 106 It must be 'convert'."
 107   :type 'string
 108   :group 'thumbs)
 109
 110 (defcustom thumbs-setroot-command
 111   "xloadimage -onroot -fullscreen *"
 112   "Command to set the root window."
 113   :type 'string
 114   :group 'thumbs)
 115
 116 (defcustom thumbs-relief 5
 117   "*Size of button-like border around thumbnails."
 118   :type 'string
 119   :group 'thumbs)
 120
 121 (defcustom thumbs-margin 2
 122   "*Size of the margin around thumbnails.
 123 This is where you see the cursor."
 124   :type 'string
 125   :group 'thumbs)
 126
 127 (defcustom thumbs-thumbsdir-auto-clean t
 128   "If set, delete older file in the thumbnails directory.
 129 Deletion is done at load time when the directory size is bigger
 130 than 'thumbs-thumbsdir-max-size'."
 131   :type 'boolean
 132   :group 'thumbs)
 133
 134 (defcustom thumbs-image-resizing-step 10
 135   "Step by wich to resize image."
 136   :type 'string
 137   :group 'thumbs)
 138
 139 (defcustom thumbs-temp-dir
 140   "/tmp/"
 141   "Temporary directory to use.
 142 Leaving it to default '/tmp/' can let another user
 143 see some of your images."
 144   :type 'directory
 145   :group 'thumbs)
 146
 147 (defcustom thumbs-temp-prefix "emacsthumbs"
 148   "Prefix to add to temp files."
 149   :type 'string
 150   :group 'thumbs)
 151
 152 ;; Initialize some variable, for later use.
 153 (defvar thumbs-temp-file
 154   (concat thumbs-temp-dir thumbs-temp-prefix)
 155   "Temporary filesname for images.")
 156
 157 (defvar thumbs-current-tmp-filename
 158   nil
 159   "Temporary filename of current image.")
 160 (defvar thumbs-current-image-filename
 161   nil
 162   "Filename of current image.")
 163 (defvar thumbs-current-image-size
 164   nil
 165   "Size of current image.")
 166 (defvar thumbs-image-num
 167   nil
 168   "Number of current image.")
 169 (defvar thumbs-current-dir
 170   nil
 171   "Current directory.")
 172 (defvar thumbs-markedL
 173   nil
 174   "List of marked files.")
 175
 176 ;; Make sure auto-image-file-mode is ON.
 177 (auto-image-file-mode t)
 178
 179 ;; Create the thumbs directory if it does not exists.
 180 (setq thumbs-thumbsdir (expand-file-name thumbs-thumbsdir))
 181
 182 (when (not (file-directory-p thumbs-thumbsdir))
 183   (progn
 184     (make-directory thumbs-thumbsdir)
 185     (message "Creating thumbnails directory")))
 186
 187 (defvar thumbs-gensym-counter 0)
 188
 189 (defun thumbs-gensym (&optional arg)
 190   "Generate a new uninterned symbol.
 191 The name is made by appending a number to PREFIX, default \"Thumbs\"."
 192   (let ((prefix (if (stringp arg) arg "Thumbs"))
 193         (num (if (integerp arg) arg
 194                (prog1
 195                    thumbs-gensym-counter
 196                  (setq thumbs-gensym-counter (1+ thumbs-gensym-counter))))))
 197     (make-symbol (format "%s%d" prefix num))))
 198
 199 (defun thumbs-cleanup-thumbsdir ()
 200   "Clean the thumbnails directory.
 201 If the total size of all files in 'thumbs-thumbsdir' is bigger than
 202 'thumbs-thumbsdir-max-size', files are deleted until the max size is
 203 reached."
 204   (let* ((filesL
 205           (sort
 206            (mapcar
 207             (lambda (f)
 208               (let ((fattribsL (file-attributes f)))
 209                 `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f)))
 210             (directory-files thumbs-thumbsdir t (image-file-name-regexp)))
 211            '(lambda (l1 l2) (time-less-p (car l1)(car l2)))))
 212          (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL))))
 213     (while (> dirsize thumbs-thumbsdir-max-size)
 214       (progn
 215         (message "Deleting file %s" (caddar filesL)))
 216       (delete-file (caddar filesL))
 217       (setq dirsize (- dirsize (cadar filesL)))
 218       (setq filesL (cdr filesL)))))
 219
 220 ;; Check the thumbsnail directory size and clean it if necessary.
 221 (when thumbs-thumbsdir-auto-clean
 222   (thumbs-cleanup-thumbsdir))
 223
 224 (defun thumbs-call-convert (filein fileout action
 225                                    &optional arg output-format action-prefix)
 226   "Call the convert program.
 227 FILEIN is the input file,
 228 FILEOUT is the output file,
 229 ACTION is the command to send to convert.
 230 Optional argument are:
 231 ARG any arguments to the ACTION command,
 232 OUTPUT-FORMAT is the file format to output, default is jpeg
 233 ACTION-PREFIX is the symbol to place before the ACTION command
 234               (default to '-' but can sometime be '+')."
 235   (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\""
 236                          thumbs-conversion-program
 237                          (or action-prefix "-")
 238                          action
 239                          (or arg "")
 240                          filein
 241                          (or output-format "jpeg")
 242                          fileout)))
 243     (shell-command command)))
 244
 245 (defun thumbs-increment-image-size-element (n d)
 246   "Increment number N by D percent."
 247   (round (+ n (/ (* d n) 100))))
 248
 249 (defun thumbs-decrement-image-size-element (n d)
 250   "Decrement number N by D percent."
 251   (round (- n (/ (* d n) 100))))
 252
 253 (defun thumbs-increment-image-size (s)
 254   "Increment S (a cons of width x heigh)."
 255   (cons
 256    (thumbs-increment-image-size-element (car s)
 257                                         thumbs-image-resizing-step)
 258    (thumbs-increment-image-size-element (cdr s)
 259                                         thumbs-image-resizing-step)))
 260
 261 (defun thumbs-decrement-image-size (s)
 262   "Decrement S (a cons of width x heigh)."
 263   (cons
 264    (thumbs-decrement-image-size-element (car s)
 265                                         thumbs-image-resizing-step)
 266    (thumbs-decrement-image-size-element (cdr s)
 267                                         thumbs-image-resizing-step)))
 268
 269 (defun thumbs-resize-image (&optional increment size)
 270   "Resize image in current buffer.
 271 if INCREMENT is set, make the image bigger, else smaller.
 272 Or, alternatively, a SIZE may be specified."
 273   (interactive)
 274   ;; cleaning of old temp file
 275   (ignore-errors
 276     (apply 'delete-file
 277            (directory-files
 278             thumbs-temp-dir t
 279             thumbs-temp-prefix)))
 280   (let ((buffer-read-only nil)
 281         (x (if size
 282                size
 283              (if increment
 284                  (thumbs-increment-image-size
 285                   thumbs-current-image-size)
 286                (thumbs-decrement-image-size
 287                 thumbs-current-image-size))))
 288         (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym))))
 289     (erase-buffer)
 290     (thumbs-call-convert thumbs-current-image-filename
 291                          tmp "sample"
 292                          (concat (number-to-string (car x)) "x"
 293                                  (number-to-string (cdr x))))
 294     (thumbs-insert-image tmp 'jpeg 0)
 295     (setq thumbs-current-tmp-filename tmp)))
 296
 297 (defun thumbs-resize-interactive (width height)
 298   "Resize Image interactively to specified WIDTH and HEIGHT."
 299   (interactive "nWidth: \nnHeight: ")
 300   (thumbs-resize-image nil (cons width height)))
 301
 302 (defun thumbs-resize-image-size-down ()
 303   "Resize image (smaller)."
 304   (interactive)
 305   (thumbs-resize-image nil))
 306
 307 (defun thumbs-resize-image-size-up ()
 308   "Resize image (bigger)."
 309   (interactive)
 310   (thumbs-resize-image t))
 311
 312 (defun thumbs-subst-char-in-string (orig rep string)
 313   "Replace occurrences of character ORIG with character REP in STRING.
 314 Return the resulting (new) string.  -- (defun borowed to Dave Love)"
 315   (let ((string (copy-sequence string))
 316         (l (length string))
 317         (i 0))
 318     (while (< i l)
 319       (if (= (aref string i) orig)
 320           (aset string i rep))
 321       (setq i (1+ i)))
 322     string))
 323
 324 (defun thumbs-thumbname (img)
 325   "Return a thumbnail name for the image IMG."
 326   (concat thumbs-thumbsdir "/"
 327           (thumbs-subst-char-in-string
 328            ?\  ?\_
 329            (apply
 330             'concat
 331             (split-string
 332              (expand-file-name img) "/")))))
 333
 334 (defun thumbs-make-thumb (img)
 335   "Create the thumbnail for IMG."
 336   (let* ((fn (expand-file-name img))
 337          (tn (thumbs-thumbname img)))
 338     (if (or (not (file-exists-p tn))
 339             (not (equal (thumbs-file-size tn) thumbs-geometry)))
 340         (thumbs-call-convert fn tn "sample" thumbs-geometry))
 341     tn))
 342
 343 (defun thumbs-image-type (img)
 344   "Return image type from filename IMG."
 345   (cond ((string-match ".*\\.jpe?g\\'" img) 'jpeg)
 346         ((string-match ".*\\.xpm\\'" img) 'xpm)
 347         ((string-match ".*\\.xbm\\'" img) 'xbm)
 348         ((string-match ".*\\.gif\\'" img) 'gif)
 349         ((string-match ".*\\.bmp\\'" img) 'bmp)
 350         ((string-match ".*\\.png\\'" img) 'png)
 351         ((string-match ".*\\.tiff?\\'" img) 'tiff)))
 352
 353 (defun thumbs-file-size (img)
 354   (let ((i (image-size (find-image `((:type ,(thumbs-image-type img) :file ,img))) t)))
 355     (concat (number-to-string (round (car i)))
 356             "x"
 357             (number-to-string (round (cdr i))))))
 358
 359 ;;;###autoload
 360 (defun thumbs-find-thumb (img)
 361   "Display the thumbnail for IMG."
 362   (interactive "f")
 363   (find-file (thumbs-make-thumb img)))
 364
 365 (defun thumbs-insert-image (img type relief &optional marked)
 366   "Insert image IMG at point.
 367 TYPE and RELIEF will be used in constructing the image; see `image'
 368 in the emacs-lisp manual for further documentation.
 369 if MARKED is non-nil, the image is marked."
 370   (let ((i `(image :type ,type
 371                    :file ,img
 372                    :relief ,relief
 373                    :conversion ,(if marked 'disabled)
 374                    :margin ,thumbs-margin)))
 375     (insert-image i)
 376     (setq thumbs-current-image-size
 377           (image-size i t))))
 378
 379 (defun thumbs-insert-thumb (img &optional marked)
 380   "Insert the thumbnail for IMG at point.
 381 if MARKED is non-nil, the image is marked"
 382   (thumbs-insert-image
 383    (thumbs-make-thumb img) 'jpeg thumbs-relief marked))
 384
 385 (defun thumbs-do-thumbs-insertion (L)
 386   "Insert all thumbs in list L."
 387   (setq thumbs-fileL nil)
 388   (let ((i 0))
 389     (while L
 390       (when (= 0 (mod (setq i (1+ i)) thumbs-per-line))
 391         (newline))
 392       (setq thumbs-fileL (cons (cons (point)
 393                                      (car L))
 394                                thumbs-fileL))
 395       (thumbs-insert-thumb (car L)
 396                            (member (car L) thumbs-markedL))
 397       (setq L (cdr L)))))
 398
 399 (defun thumbs-show-thumbs-list (L &optional buffer-name same-window)
 400   (funcall (if same-window 'switch-to-buffer 'pop-to-buffer)
 401            (or buffer-name "*THUMB-View*"))
 402   (let ((inhibit-read-only t))
 403     (erase-buffer)
 404     (thumbs-mode)
 405     (make-variable-buffer-local 'thumbs-fileL)
 406     (setq thumbs-fileL nil)
 407     (thumbs-do-thumbs-insertion L)
 408     (goto-char (point-min))
 409     (setq thumbs-current-dir default-directory)
 410     (make-variable-buffer-local 'thumbs-current-dir)))
 411
 412 ;;;###autoload
 413 (defun thumbs-show-all-from-dir (dir &optional reg same-window)
 414   "Make a preview buffer for all images in DIR.
 415 Optional argument REG to select file matching a regexp,
 416 and SAME-WINDOW to show thumbs in the same window."
 417   (interactive "DDir: ")
 418   (thumbs-show-thumbs-list
 419    (directory-files dir t
 420                     (or reg (image-file-name-regexp)))
 421    (concat "*Thumbs: " dir) same-window))
 422
 423 ;;;###autoload
 424 (defun thumbs-dired-show-marked ()
 425   "In Dired, make a thumbs buffer with all marked files."
 426   (interactive)
 427   (thumbs-show-thumbs-list (dired-get-marked-files) nil t))
 428
 429 ;;;###autoload
 430 (defun thumbs-dired-show-all ()
 431   "In dired, make a thumbs buffer with all files in current directory."
 432   (interactive)
 433   (thumbs-show-all-from-dir default-directory nil t))
 434
 435 ;;;###autoload
 436 (defalias 'thumbs 'thumbs-show-all-from-dir)
 437
 438 (defun thumbs-find-image (img L &optional num otherwin)
 439   (funcall
 440    (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer)
 441    (concat "*Image: " (file-name-nondirectory img) " - "
 442            (number-to-string (or num 0)) "*"))
 443   (thumbs-view-image-mode)
 444   (let ((inhibit-read-only t))
 445     (setq thumbs-current-image-filename img
 446           thumbs-current-tmp-filename nil
 447           thumbs-image-num (or num 0))
 448     (make-variable-buffer-local 'thumbs-current-image-filename)
 449     (make-variable-buffer-local 'thumbs-current-tmp-filename)
 450     (make-variable-buffer-local 'thumbs-current-image-size)
 451     (make-variable-buffer-local 'thumbs-image-num)
 452     (make-variable-buffer-local 'thumbs-fileL)
 453     (setq thumbs-fileL L)
 454     (delete-region (point-min)(point-max))
 455     (thumbs-insert-image img (thumbs-image-type img) 0)))
 456
 457 (defun thumbs-find-image-at-point (&optional img otherwin)
 458   "Display image IMG for thumbnail at point.
 459 use another window it OTHERWIN is t."
 460   (interactive)
 461   (let* ((L thumbs-fileL)
 462          (n (point))
 463          (i (or img (cdr (assoc n L)))))
 464     (thumbs-find-image i L n otherwin)))
 465
 466 (defun thumbs-find-image-at-point-other-window ()
 467   "Display image for thumbnail at point in the preview buffer.
 468 Open another window."
 469   (interactive)
 470   (thumbs-find-image-at-point nil t))
 471
 472 (defun thumbs-call-setroot-command (img)
 473   "Call the setroot program for IMG."
 474   (run-hooks 'thumbs-before-setroot-hook)
 475   (shell-command (replace-regexp-in-string
 476                   "\\*"
 477                   (shell-quote-argument (expand-file-name img))
 478                   thumbs-setroot-command nil t))
 479   (run-hooks 'thumbs-after-setroot-hook))
 480
 481 (defun thumbs-set-image-at-point-to-root-window ()
 482   "Set the image at point as the desktop wallpaper."
 483   (interactive)
 484   (thumbs-call-setroot-command (cdr (assoc (point) thumbs-fileL))))
 485
 486 (defun thumbs-set-root ()
 487   "Set the current image as root."
 488   (interactive)
 489   (thumbs-call-setroot-command
 490    (or thumbs-current-tmp-filename
 491        thumbs-current-image-filename)))
 492
 493 (defun thumbs-delete-images ()
 494   "Delete the image at point (and it's thumbnail) (or marked files if any)."
 495   (interactive)
 496   (let ((f (or thumbs-markedL (list (cdr (assoc (point) thumbs-fileL))))))
 497     (if (yes-or-no-p (format "Really delete %d files? " (length f)))
 498         (progn
 499           (mapcar (lambda (x)
 500                     (setq thumbs-fileL (delete (rassoc x thumbs-fileL) thumbs-fileL))
 501                     (delete-file x)
 502                     (delete-file (thumbs-thumbname x))) f)
 503           (thumbs-redraw-buffer)))))
 504
 505 (defun thumbs-kill-buffer ()
 506   "Kill the current buffer."
 507   (interactive)
 508   (let ((buffer (current-buffer)))
 509     (ignore-errors (delete-window (selected-window)))
 510     (kill-buffer buffer)))
 511
 512 (defun thumbs-show-image-num (num)
 513   "Show the image with number NUM."
 514   (let ((inhibit-read-only t))
 515     (delete-region (point-min)(point-max))
 516     (let ((i (cdr (assoc num thumbs-fileL))))
 517       (thumbs-insert-image i (thumbs-image-type i) 0)
 518       (sleep-for 2)
 519       (rename-buffer (concat "*Image: "
 520                              (file-name-nondirectory i)
 521                              " - "
 522                              (number-to-string num) "*"))
 523       (setq thumbs-image-num num
 524             thumbs-current-image-filename i))))
 525
 526 (defun thumbs-next-image ()
 527   "Show next image."
 528   (interactive)
 529   (let* ((i (1+ thumbs-image-num))
 530          (l (caar thumbs-fileL))
 531          (num
 532           (cond ((assoc i thumbs-fileL) i)
 533                 ((>= i l) 1)
 534                 (t (1+ i)))))
 535     (thumbs-show-image-num num)))
 536
 537 (defun thumbs-previous-image ()
 538   "Show the previous image."
 539   (interactive)
 540   (let* ((i (- thumbs-image-num 1))
 541          (l (caar thumbs-fileL))
 542          (num
 543           (cond ((assoc i thumbs-fileL) i)
 544                 ((<= i 1) l)
 545                 (t (- i 1)))))
 546     (thumbs-show-image-num num)))
 547
 548 (defun thumbs-redraw-buffer ()
 549   "Redraw the current thumbs buffer."
 550   (let ((p (point))
 551         (inhibit-read-only t))
 552     (delete-region (point-min)(point-max))
 553     (thumbs-do-thumbs-insertion (reverse (mapcar 'cdr thumbs-fileL)))
 554     (goto-char (1+ p))))
 555
 556 (defun thumbs-mark ()
 557   "Mark the image at point."
 558   (interactive)
 559   (setq thumbs-markedL (cons (cdr (assoc (point) thumbs-fileL)) thumbs-markedL))
 560   (let ((inhibit-read-only t))
 561     (delete-char 1)
 562     (thumbs-insert-thumb (cdr (assoc (point) thumbs-fileL)) t))
 563   (when (eolp)(forward-char)))
 564
 565 ;; Image modification routines
 566
 567 (defun thumbs-modify-image (action &optional arg)
 568   "Call convert to do ACTION on image with argument ARG.
 569 ACTION and ARG should be legal convert command."
 570   (interactive "sAction: \nsValue: ")
 571   ;; cleaning of old temp file
 572   (mapc 'delete-file
 573         (directory-files
 574          thumbs-temp-dir
 575          t
 576          thumbs-temp-prefix))
 577   (let ((buffer-read-only nil)
 578         (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym))))
 579     (erase-buffer)
 580     (thumbs-call-convert thumbs-current-image-filename
 581                          tmp
 582                          action
 583                          (or arg ""))
 584     (thumbs-insert-image tmp 'jpeg 0)
 585     (setq thumbs-current-tmp-filename tmp)))
 586
 587 (defun thumbs-emboss-image (emboss)
 588   "Emboss the image with value EMBOSS."
 589   (interactive "nEmboss value: ")
 590   (if (or (< emboss 3) (> emboss 31) (zerop (logand emboss 1)))
 591       (error "Arg must be a odd number between 3 and 31"))
 592   (thumbs-modify-image "emboss" (number-to-string emboss)))
 593
 594 (defun thumbs-monochrome-image ()
 595   "Turn the image to monochrome."
 596   (interactive)
 597   (thumbs-modify-image "monochrome"))
 598
 599 (defun thumbs-negate-image ()
 600   "Negate the image."
 601   (interactive)
 602   (thumbs-modify-image "negate"))
 603
 604 (defun thumbs-rotate-left ()
 605   "Rotate the image 90 degrees counter-clockwise."
 606   (interactive)
 607   (thumbs-modify-image "rotate" "270"))
 608
 609 (defun thumbs-rotate-right ()
 610   "Rotate the image 90 degrees clockwise."
 611   (interactive)
 612   (thumbs-modify-image "rotate" "90"))
 613
 614 (defun thumbs-forward-char ()
 615   "Move forward one image."
 616   (interactive)
 617   (forward-char)
 618   (when (eolp)(forward-char))
 619   (thumbs-show-name))
 620
 621 (defun thumbs-backward-char ()
 622   "Move backward one image."
 623   (interactive)
 624   (forward-char -1)
 625   (thumbs-show-name))
 626
 627 (defun thumbs-forward-line ()
 628   "Move down one line."
 629   (interactive)
 630   (forward-line 1)
 631   (thumbs-show-name))
 632
 633 (defun thumbs-backward-line ()
 634   "Move up one line."
 635   (interactive)
 636   (forward-line -1)
 637   (thumbs-show-name))
 638
 639 (defun thumbs-show-name ()
 640   "Show the name of the current file."
 641   (interactive)
 642   (let ((f (cdr (assoc (point) thumbs-fileL))))
 643     (message "%s [%s]" f (thumbs-file-size f))))
 644
 645 (defun thumbs-save-current-image ()
 646   "Save the current image."
 647   (interactive)
 648   (let ((f (or thumbs-current-tmp-filename
 649                thumbs-current-image-filename))
 650         (sa (read-from-minibuffer "save file as: "
 651                                   thumbs-current-image-filename)))
 652     (copy-file f sa)))
 653
 654 (defun thumbs-dired ()
 655   "Use `dired' on the current thumbs directory."
 656   (interactive)
 657   (dired thumbs-current-dir))
 658
 659 ;; thumbs-mode
 660
 661 (defvar thumbs-mode-map
 662   (let ((map (make-sparse-keymap)))
 663     (define-key map [return] 'thumbs-find-image-at-point)
 664     (define-key map [(meta return)] 'thumbs-find-image-at-point-other-window)
 665     (define-key map [(control return)] 'thumbs-set-image-at-point-to-root-window)
 666     (define-key map [delete] 'thumbs-delete-images)
 667     (define-key map [right] 'thumbs-forward-char)
 668     (define-key map [left] 'thumbs-backward-char)
 669     (define-key map [up] 'thumbs-backward-line)
 670     (define-key map [down] 'thumbs-forward-line)
 671     (define-key map "d" 'thumbs-dired)
 672     (define-key map "m" 'thumbs-mark)
 673     (define-key map "s" 'thumbs-show-name)
 674     (define-key map "q" 'thumbs-kill-buffer)
 675     map)
 676   "Keymap for `thumbs-mode'.")
 677
 678 (define-derived-mode thumbs-mode
 679   fundamental-mode "thumbs"
 680   "Preview images in a thumbnails buffer"
 681   (make-variable-buffer-local 'thumbs-markedL)
 682   (setq thumbs-markedL nil))
 683
 684 (defvar thumbs-view-image-mode-map
 685   (let ((map (make-sparse-keymap)))
 686     (define-key map [prior] 'thumbs-previous-image)
 687     (define-key map [next] 'thumbs-next-image)
 688     (define-key map "-" 'thumbs-resize-image-size-down)
 689     (define-key map "+" 'thumbs-resize-image-size-up)
 690     (define-key map "<" 'thumbs-rotate-left)
 691     (define-key map ">" 'thumbs-rotate-right)
 692     (define-key map "e" 'thumbs-emboss-image)
 693     (define-key map "r" 'thumbs-resize-interactive)
 694     (define-key map "s" 'thumbs-save-current-image)
 695     (define-key map "q" 'thumbs-kill-buffer)
 696     (define-key map "w" 'thunbs-set-root)
 697     map)
 698   "Keymap for `thumbs-view-image-mode'.")
 699
 700 ;; thumbs-view-image-mode
 701 (define-derived-mode thumbs-view-image-mode
 702   fundamental-mode "image-view-mode")
 703
 704 ;;;###autoload
 705 (defun thumbs-dired-setroot ()
 706   "In dired, Call the setroot program on the image at point."
 707   (interactive)
 708   (thumbs-call-setroot-command (dired-get-filename)))
 709
 710 ;; Modif to dired mode map
 711 (define-key dired-mode-map "\C-ta" 'thumbs-dired-show-all)
 712 (define-key dired-mode-map "\C-tm" 'thumbs-dired-show-marked)
 713 (define-key dired-mode-map "\C-tw" 'thumbs-dired-setroot)
 714
 715 (provide 'thumbs)
 716
 717 ;;; thumbs.el ends here
 718
 719
 720 ;;; arch-tag: f9ac1ef8-83fc-42c0-8069-1fae43fd2e5c