comparison lisp/thumbs.el @ 68373:3bff02a6d438

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

68372:a5c9adcb4b54

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

;; Copyright (C) 2004, 2005 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

than `thumbs-thumbsdir-max-size'."
  :type 'boolean
  :group 'thumbs)

(defcustom thumbs-image-resizing-step 10
  "Step by which to resize image."
  :type 'integer
  :group 'thumbs)

(defcustom thumbs-temp-dir temporary-file-directory
  "Temporary directory to use.

			 filein
			 (or output-format "jpeg")
			 fileout)))
    (call-process shell-file-name nil nil nil "-c" command)))

(defun thumbs-increment-image-size-element (n d)
  "Increment number N by D percent."
  (round (+ n (/ (* d n) 100))))

(defun thumbs-decrement-image-size-element (n d)
  "Decrement number N by D percent."
  (round (- n (/ (* d n) 100))))

(defun thumbs-increment-image-size (s)
  "Increment S (a cons of width x height)."
  (cons
   (thumbs-increment-image-size-element (car s)
					thumbs-image-resizing-step)
   (thumbs-increment-image-size-element (cdr s)
					thumbs-image-resizing-step)))

(defun thumbs-decrement-image-size (s)
  "Decrement S (a cons of width x height)."
  (cons
   (thumbs-decrement-image-size-element (car s)
					thumbs-image-resizing-step)
   (thumbs-decrement-image-size-element (cdr s)
					thumbs-image-resizing-step)))

(defun thumbs-resize-image (&optional increment size)
  "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
		  thumbs-current-image-size)
	       (thumbs-decrement-image-size
		thumbs-current-image-size))))
	(tmp (thumbs-temp-file)))
    (erase-buffer)
    (thumbs-call-convert thumbs-current-image-filename
			 tmp "sample"
			 (concat (number-to-string (car x)) "x"
				 (number-to-string (cdr x))))
    (thumbs-insert-image tmp 'jpeg 0)
    (setq thumbs-current-tmp-filename tmp)))

(defun thumbs-resize-interactive (width height)
  "Resize image interactively to specified WIDTH and HEIGHT."
  (interactive "nWidth: \nnHeight: ")
  (thumbs-resize-image nil (cons width height)))

(defun thumbs-resize-image-size-down ()
  "Resize image (smaller)."
  (interactive)
  (thumbs-resize-image nil))

(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."
  (convert-standard-filename
   (let ((filename (expand-file-name img)))

  (funcall (if same-window 'switch-to-buffer 'pop-to-buffer)
	   (if dir (concat "*Thumbs: " dir) "*THUMB-View*"))
  (let ((inhibit-read-only t))
    (erase-buffer)
    (thumbs-mode)
    (if dir (setq default-directory dir))
    (thumbs-do-thumbs-insertion list)
    (goto-char (point-min))
    (set (make-local-variable 'thumbs-current-dir) default-directory)))

    (unless elt
      (error "No image here"))
    (push elt thumbs-marked-list)
    (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)

    (unless elt
      (error "No image here"))
    (setq thumbs-marked-list (delete elt thumbs-marked-list))
    (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.
ACTION and ARG should be a valid convert command."
  (interactive "sAction: \nsValue: ")
  ;; cleaning of old temp file
  (mapc 'delete-file
	(directory-files
	 (thumbs-temp-dir)
	 t
	 thumbs-temp-prefix))
  (let ((buffer-read-only nil)
	(tmp (thumbs-temp-file)))
    (erase-buffer)
    (thumbs-call-convert thumbs-current-image-filename
			 tmp
			 action
			 (or arg ""))
    (thumbs-insert-image tmp 'jpeg 0)
    (setq thumbs-current-tmp-filename tmp)))

(defun thumbs-emboss-image (emboss)
  "Emboss the image with value EMBOSS."
  (interactive "nEmboss value: ")

(defvar thumbs-view-image-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [prior] 'thumbs-previous-image)
    (define-key map [next] 'thumbs-next-image)
    (define-key map "^" 'thumbs-display-thumbs-buffer)
    (define-key map "-" 'thumbs-resize-image-size-down)
    (define-key map "+" 'thumbs-resize-image-size-up)
    (define-key map "<" 'thumbs-rotate-left)
    (define-key map ">" 'thumbs-rotate-right)
    (define-key map "e" 'thumbs-emboss-image)
    (define-key map "r" 'thumbs-resize-interactive)
    (define-key map "s" 'thumbs-save-current-image)
    (define-key map "q" 'thumbs-kill-buffer)
    (define-key map "w" 'thumbs-set-root)
    map)
  "Keymap for `thumbs-view-image-mode'.")

68373:3bff02a6d438

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

;; Copyright (C) 2004, 2005 Free Software Foundation, Inc.

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

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify

than `thumbs-thumbsdir-max-size'."
  :type 'boolean
  :group 'thumbs)

(defcustom thumbs-image-resizing-step 10
  "Step by which to resize image as a percentage."
  :type 'integer
  :group 'thumbs)

(defcustom thumbs-temp-dir temporary-file-directory
  "Temporary directory to use.

			 filein
			 (or output-format "jpeg")
			 fileout)))
    (call-process shell-file-name nil nil nil "-c" command)))

(defun thumbs-new-image-size (s increment)
  "New image (a cons of width x height)."
  (let ((d (* increment thumbs-image-resizing-step)))
    (cons
     (round (+ (car s) (/ (* d (car s)) 100)))
     (round (+ (cdr s) (/ (* d (cdr s)) 100))))))

(defun thumbs-resize-image-1 (&optional increment size)
  "Resize image in current buffer.
If SIZE is specified use it.  Otherwise make the image larger or
smaller according to whether INCREMENT is 1 or -1."
  (let* ((buffer-read-only nil)
	 (old thumbs-current-tmp-filename)
	 (x (or size
		(thumbs-new-image-size thumbs-current-image-size increment)))
	 (tmp (thumbs-temp-file)))
    (erase-buffer)
    (thumbs-call-convert (or old thumbs-current-image-filename)
			 tmp "sample"
			 (concat (number-to-string (car x)) "x"
				 (number-to-string (cdr x))))
    (save-excursion
      (thumbs-insert-image tmp 'jpeg 0))
    (setq thumbs-current-tmp-filename tmp)))

(defun thumbs-resize-image (width height)
  "Resize image interactively to specified WIDTH and HEIGHT."
  (interactive "nWidth: \nnHeight: ")
  (thumbs-resize-image-1 nil (cons width height)))

(defun thumbs-shrink-image ()
  "Resize image (smaller)."
  (interactive)
  (thumbs-resize-image-1 -1))

(defun thumbs-enlarge-image ()
  "Resize image (bigger)."
  (interactive)
  (thumbs-resize-image-1 1))

(defun thumbs-thumbname (img)
  "Return a thumbnail name for the image IMG."
  (convert-standard-filename
   (let ((filename (expand-file-name img)))

  (funcall (if same-window 'switch-to-buffer 'pop-to-buffer)
	   (if dir (concat "*Thumbs: " dir) "*THUMB-View*"))
  (let ((inhibit-read-only t))
    (erase-buffer)
    (thumbs-mode)
    (setq thumbs-buffer (current-buffer))
    (if dir (setq default-directory dir))
    (thumbs-do-thumbs-insertion list)
    (goto-char (point-min))
    (set (make-local-variable 'thumbs-current-dir) default-directory)))

    (unless elt
      (error "No image here"))
    (push elt thumbs-marked-list)
    (let ((inhibit-read-only t))
      (delete-char 1)
      (save-excursion
	(thumbs-insert-thumb elt t))))
  (when (eolp) (forward-char)))

(defun thumbs-unmark ()
  "Unmark the image at point."
  (interactive)

    (unless elt
      (error "No image here"))
    (setq thumbs-marked-list (delete elt thumbs-marked-list))
    (let ((inhibit-read-only t))
      (delete-char 1)
      (save-excursion
	(thumbs-insert-thumb elt nil))))
  (when (eolp) (forward-char)))


;; cleaning of old temp files
(mapc 'delete-file
      (directory-files (thumbs-temp-dir) t thumbs-temp-prefix))

;; Image modification routines

(defun thumbs-modify-image (action &optional arg)
  "Call convert to do ACTION on image with argument ARG.
ACTION and ARG should be a valid convert command."
  (interactive "sAction: \nsValue: ")
  (let* ((buffer-read-only nil)
	 (old thumbs-current-tmp-filename)
	 (tmp (thumbs-temp-file)))
    (erase-buffer)
    (thumbs-call-convert (or old thumbs-current-image-filename)
			 tmp
			 action
			 (or arg ""))
    (save-excursion
      (thumbs-insert-image tmp 'jpeg 0))
    (setq thumbs-current-tmp-filename tmp)))

(defun thumbs-emboss-image (emboss)
  "Emboss the image with value EMBOSS."
  (interactive "nEmboss value: ")

(defvar thumbs-view-image-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [prior] 'thumbs-previous-image)
    (define-key map [next] 'thumbs-next-image)
    (define-key map "^" 'thumbs-display-thumbs-buffer)
    (define-key map "-" 'thumbs-shrink-image)
    (define-key map "+" 'thumbs-enlarge-image)
    (define-key map "<" 'thumbs-rotate-left)
    (define-key map ">" 'thumbs-rotate-right)
    (define-key map "e" 'thumbs-emboss-image)
    (define-key map "r" 'thumbs-resize-image)
    (define-key map "s" 'thumbs-save-current-image)
    (define-key map "q" 'thumbs-kill-buffer)
    (define-key map "w" 'thumbs-set-root)
    map)
  "Keymap for `thumbs-view-image-mode'.")