aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorNick Roberts2006-01-24 20:54:23 +0000
committerNick Roberts2006-01-24 20:54:23 +0000
commit2ff89cf76fabaaeb8bf8ab5a2a87f469f59d939a (patch)
tree219f682052ff844b7247ae84ea838f710e785c45
parent3beca8d590a771d9ef576136384d99448130ccf7 (diff)
downloademacs-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.el113
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.
284If INCREMENT is set, make the image bigger, else smaller. 268If SIZE is specified use it. Otherwise make the image larger or
285Or, alternatively, a SIZE may be specified." 269smaller 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.
671ACTION and ARG should be a valid convert command." 652ACTION 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)