diff options
| author | Nick Roberts | 2006-01-24 20:54:23 +0000 |
|---|---|---|
| committer | Nick Roberts | 2006-01-24 20:54:23 +0000 |
| commit | 2ff89cf76fabaaeb8bf8ab5a2a87f469f59d939a (patch) | |
| tree | 219f682052ff844b7247ae84ea838f710e785c45 | |
| parent | 3beca8d590a771d9ef576136384d99448130ccf7 (diff) | |
| download | emacs-2ff89cf76fabaaeb8bf8ab5a2a87f469f59d939a.tar.gz emacs-2ff89cf76fabaaeb8bf8ab5a2a87f469f59d939a.zip | |
(thumbs-new-image-size): New function.
(thumbs-increment-image-size-element)
(thumbs-decrement-image-size-element, thumbs-increment-image-size)
(thumbs-decrement-image-size): Delete.
(thumbs-resize-image-1): Rename from thumbs-resize-image. Keep old
temp files and use to resize.
(thumbs-resize-image): Rename from thumbs-resize-image-interactive.
Use increment argument to enlarge/shrink. Preserve point.
(thumbs-shrink-image): Rename from thumbs-resize-image-size-down.
(thumbs-enlarge-image): Rename from thumbs-resize-image-size-up
(thumbs-show-thumbs-list): Set thumbs-buffer to current-buffer.
(thumbs-mark, thumbs-unmark): Preserve point.
(thumbs-modify-image): Keep old temp files and use to modify.
Cleanup old temp files at load time. Preserve point.
(thumbs-view-image-mode-map): Use new command names.
| -rw-r--r-- | lisp/thumbs.el | 113 |
1 files changed, 45 insertions, 68 deletions
diff --git a/lisp/thumbs.el b/lisp/thumbs.el index fe021d66b5e..f4b283bf7f2 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el | |||
| @@ -3,6 +3,7 @@ | |||
| 3 | ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca> | 5 | ;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca> |
| 6 | ;; Maintainer: FSF | ||
| 6 | ;; Keywords: Multimedia | 7 | ;; Keywords: Multimedia |
| 7 | 8 | ||
| 8 | ;; This file is part of GNU Emacs. | 9 | ;; This file is part of GNU Emacs. |
| @@ -127,7 +128,7 @@ than `thumbs-thumbsdir-max-size'." | |||
| 127 | :group 'thumbs) | 128 | :group 'thumbs) |
| 128 | 129 | ||
| 129 | (defcustom thumbs-image-resizing-step 10 | 130 | (defcustom thumbs-image-resizing-step 10 |
| 130 | "Step by which to resize image." | 131 | "Step by which to resize image as a percentage." |
| 131 | :type 'integer | 132 | :type 'integer |
| 132 | :group 'thumbs) | 133 | :group 'thumbs) |
| 133 | 134 | ||
| @@ -255,73 +256,45 @@ ACTION-PREFIX is the symbol to place before the ACTION command | |||
| 255 | fileout))) | 256 | fileout))) |
| 256 | (call-process shell-file-name nil nil nil "-c" command))) | 257 | (call-process shell-file-name nil nil nil "-c" command))) |
| 257 | 258 | ||
| 258 | (defun thumbs-increment-image-size-element (n d) | 259 | (defun thumbs-new-image-size (s increment) |
| 259 | "Increment number N by D percent." | 260 | "New image (a cons of width x height)." |
| 260 | (round (+ n (/ (* d n) 100)))) | 261 | (let ((d (* increment thumbs-image-resizing-step))) |
| 261 | 262 | (cons | |
| 262 | (defun thumbs-decrement-image-size-element (n d) | 263 | (round (+ (car s) (/ (* d (car s)) 100))) |
| 263 | "Decrement number N by D percent." | 264 | (round (+ (cdr s) (/ (* d (cdr s)) 100)))))) |
| 264 | (round (- n (/ (* d n) 100)))) | 265 | |
| 265 | 266 | (defun thumbs-resize-image-1 (&optional increment size) | |
| 266 | (defun thumbs-increment-image-size (s) | ||
| 267 | "Increment S (a cons of width x height)." | ||
| 268 | (cons | ||
| 269 | (thumbs-increment-image-size-element (car s) | ||
| 270 | thumbs-image-resizing-step) | ||
| 271 | (thumbs-increment-image-size-element (cdr s) | ||
| 272 | thumbs-image-resizing-step))) | ||
| 273 | |||
| 274 | (defun thumbs-decrement-image-size (s) | ||
| 275 | "Decrement S (a cons of width x height)." | ||
| 276 | (cons | ||
| 277 | (thumbs-decrement-image-size-element (car s) | ||
| 278 | thumbs-image-resizing-step) | ||
| 279 | (thumbs-decrement-image-size-element (cdr s) | ||
| 280 | thumbs-image-resizing-step))) | ||
| 281 | |||
| 282 | (defun thumbs-resize-image (&optional increment size) | ||
| 283 | "Resize image in current buffer. | 267 | "Resize image in current buffer. |
| 284 | If INCREMENT is set, make the image bigger, else smaller. | 268 | If SIZE is specified use it. Otherwise make the image larger or |
| 285 | Or, alternatively, a SIZE may be specified." | 269 | smaller according to whether INCREMENT is 1 or -1." |
| 286 | (interactive) | 270 | (let* ((buffer-read-only nil) |
| 287 | ;; cleaning of old temp file | 271 | (old thumbs-current-tmp-filename) |
| 288 | (condition-case nil | 272 | (x (or size |
| 289 | (apply 'delete-file | 273 | (thumbs-new-image-size thumbs-current-image-size increment))) |
| 290 | (directory-files | 274 | (tmp (thumbs-temp-file))) |
| 291 | (thumbs-temp-dir) t | ||
| 292 | thumbs-temp-prefix)) | ||
| 293 | (error nil)) | ||
| 294 | (let ((buffer-read-only nil) | ||
| 295 | (x (if size | ||
| 296 | size | ||
| 297 | (if increment | ||
| 298 | (thumbs-increment-image-size | ||
| 299 | thumbs-current-image-size) | ||
| 300 | (thumbs-decrement-image-size | ||
| 301 | thumbs-current-image-size)))) | ||
| 302 | (tmp (thumbs-temp-file))) | ||
| 303 | (erase-buffer) | 275 | (erase-buffer) |
| 304 | (thumbs-call-convert thumbs-current-image-filename | 276 | (thumbs-call-convert (or old thumbs-current-image-filename) |
| 305 | tmp "sample" | 277 | tmp "sample" |
| 306 | (concat (number-to-string (car x)) "x" | 278 | (concat (number-to-string (car x)) "x" |
| 307 | (number-to-string (cdr x)))) | 279 | (number-to-string (cdr x)))) |
| 308 | (thumbs-insert-image tmp 'jpeg 0) | 280 | (save-excursion |
| 281 | (thumbs-insert-image tmp 'jpeg 0)) | ||
| 309 | (setq thumbs-current-tmp-filename tmp))) | 282 | (setq thumbs-current-tmp-filename tmp))) |
| 310 | 283 | ||
| 311 | (defun thumbs-resize-interactive (width height) | 284 | (defun thumbs-resize-image (width height) |
| 312 | "Resize image interactively to specified WIDTH and HEIGHT." | 285 | "Resize image interactively to specified WIDTH and HEIGHT." |
| 313 | (interactive "nWidth: \nnHeight: ") | 286 | (interactive "nWidth: \nnHeight: ") |
| 314 | (thumbs-resize-image nil (cons width height))) | 287 | (thumbs-resize-image-1 nil (cons width height))) |
| 315 | 288 | ||
| 316 | (defun thumbs-resize-image-size-down () | 289 | (defun thumbs-shrink-image () |
| 317 | "Resize image (smaller)." | 290 | "Resize image (smaller)." |
| 318 | (interactive) | 291 | (interactive) |
| 319 | (thumbs-resize-image nil)) | 292 | (thumbs-resize-image-1 -1)) |
| 320 | 293 | ||
| 321 | (defun thumbs-resize-image-size-up () | 294 | (defun thumbs-enlarge-image () |
| 322 | "Resize image (bigger)." | 295 | "Resize image (bigger)." |
| 323 | (interactive) | 296 | (interactive) |
| 324 | (thumbs-resize-image t)) | 297 | (thumbs-resize-image-1 1)) |
| 325 | 298 | ||
| 326 | (defun thumbs-thumbname (img) | 299 | (defun thumbs-thumbname (img) |
| 327 | "Return a thumbnail name for the image IMG." | 300 | "Return a thumbnail name for the image IMG." |
| @@ -418,6 +391,7 @@ If MARKED is non-nil, the image is marked." | |||
| 418 | (let ((inhibit-read-only t)) | 391 | (let ((inhibit-read-only t)) |
| 419 | (erase-buffer) | 392 | (erase-buffer) |
| 420 | (thumbs-mode) | 393 | (thumbs-mode) |
| 394 | (setq thumbs-buffer (current-buffer)) | ||
| 421 | (if dir (setq default-directory dir)) | 395 | (if dir (setq default-directory dir)) |
| 422 | (thumbs-do-thumbs-insertion list) | 396 | (thumbs-do-thumbs-insertion list) |
| 423 | (goto-char (point-min)) | 397 | (goto-char (point-min)) |
| @@ -649,7 +623,8 @@ Open another window." | |||
| 649 | (push elt thumbs-marked-list) | 623 | (push elt thumbs-marked-list) |
| 650 | (let ((inhibit-read-only t)) | 624 | (let ((inhibit-read-only t)) |
| 651 | (delete-char 1) | 625 | (delete-char 1) |
| 652 | (thumbs-insert-thumb elt t))) | 626 | (save-excursion |
| 627 | (thumbs-insert-thumb elt t)))) | ||
| 653 | (when (eolp) (forward-char))) | 628 | (when (eolp) (forward-char))) |
| 654 | 629 | ||
| 655 | (defun thumbs-unmark () | 630 | (defun thumbs-unmark () |
| @@ -661,29 +636,31 @@ Open another window." | |||
| 661 | (setq thumbs-marked-list (delete elt thumbs-marked-list)) | 636 | (setq thumbs-marked-list (delete elt thumbs-marked-list)) |
| 662 | (let ((inhibit-read-only t)) | 637 | (let ((inhibit-read-only t)) |
| 663 | (delete-char 1) | 638 | (delete-char 1) |
| 664 | (thumbs-insert-thumb elt nil))) | 639 | (save-excursion |
| 640 | (thumbs-insert-thumb elt nil)))) | ||
| 665 | (when (eolp) (forward-char))) | 641 | (when (eolp) (forward-char))) |
| 666 | 642 | ||
| 643 | |||
| 644 | ;; cleaning of old temp files | ||
| 645 | (mapc 'delete-file | ||
| 646 | (directory-files (thumbs-temp-dir) t thumbs-temp-prefix)) | ||
| 647 | |||
| 667 | ;; Image modification routines | 648 | ;; Image modification routines |
| 668 | 649 | ||
| 669 | (defun thumbs-modify-image (action &optional arg) | 650 | (defun thumbs-modify-image (action &optional arg) |
| 670 | "Call convert to do ACTION on image with argument ARG. | 651 | "Call convert to do ACTION on image with argument ARG. |
| 671 | ACTION and ARG should be a valid convert command." | 652 | ACTION and ARG should be a valid convert command." |
| 672 | (interactive "sAction: \nsValue: ") | 653 | (interactive "sAction: \nsValue: ") |
| 673 | ;; cleaning of old temp file | 654 | (let* ((buffer-read-only nil) |
| 674 | (mapc 'delete-file | 655 | (old thumbs-current-tmp-filename) |
| 675 | (directory-files | 656 | (tmp (thumbs-temp-file))) |
| 676 | (thumbs-temp-dir) | ||
| 677 | t | ||
| 678 | thumbs-temp-prefix)) | ||
| 679 | (let ((buffer-read-only nil) | ||
| 680 | (tmp (thumbs-temp-file))) | ||
| 681 | (erase-buffer) | 657 | (erase-buffer) |
| 682 | (thumbs-call-convert thumbs-current-image-filename | 658 | (thumbs-call-convert (or old thumbs-current-image-filename) |
| 683 | tmp | 659 | tmp |
| 684 | action | 660 | action |
| 685 | (or arg "")) | 661 | (or arg "")) |
| 686 | (thumbs-insert-image tmp 'jpeg 0) | 662 | (save-excursion |
| 663 | (thumbs-insert-image tmp 'jpeg 0)) | ||
| 687 | (setq thumbs-current-tmp-filename tmp))) | 664 | (setq thumbs-current-tmp-filename tmp))) |
| 688 | 665 | ||
| 689 | (defun thumbs-emboss-image (emboss) | 666 | (defun thumbs-emboss-image (emboss) |
| @@ -808,12 +785,12 @@ ACTION and ARG should be a valid convert command." | |||
| 808 | (define-key map [prior] 'thumbs-previous-image) | 785 | (define-key map [prior] 'thumbs-previous-image) |
| 809 | (define-key map [next] 'thumbs-next-image) | 786 | (define-key map [next] 'thumbs-next-image) |
| 810 | (define-key map "^" 'thumbs-display-thumbs-buffer) | 787 | (define-key map "^" 'thumbs-display-thumbs-buffer) |
| 811 | (define-key map "-" 'thumbs-resize-image-size-down) | 788 | (define-key map "-" 'thumbs-shrink-image) |
| 812 | (define-key map "+" 'thumbs-resize-image-size-up) | 789 | (define-key map "+" 'thumbs-enlarge-image) |
| 813 | (define-key map "<" 'thumbs-rotate-left) | 790 | (define-key map "<" 'thumbs-rotate-left) |
| 814 | (define-key map ">" 'thumbs-rotate-right) | 791 | (define-key map ">" 'thumbs-rotate-right) |
| 815 | (define-key map "e" 'thumbs-emboss-image) | 792 | (define-key map "e" 'thumbs-emboss-image) |
| 816 | (define-key map "r" 'thumbs-resize-interactive) | 793 | (define-key map "r" 'thumbs-resize-image) |
| 817 | (define-key map "s" 'thumbs-save-current-image) | 794 | (define-key map "s" 'thumbs-save-current-image) |
| 818 | (define-key map "q" 'thumbs-kill-buffer) | 795 | (define-key map "q" 'thumbs-kill-buffer) |
| 819 | (define-key map "w" 'thumbs-set-root) | 796 | (define-key map "w" 'thumbs-set-root) |