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