emacs/lisp/thumbs.el

28 ;; This package create two new modes: thumbs-mode and thumbs-view-image-mode.
30 ;; Minimal image manipulation functions are also available via external
32 ;; your images, use image-dired.el
50 ;; That should be a directory containing image files.
51 ;; from dired, C-t m enter in thumbs-mode with all marked files
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.
61 (require 'dired)
85 (defcustom thumbs-max-image-number 16
130 (defcustom thumbs-image-resizing-step 10
131   "Step by which to resize image as a percentage."
149   "Temporary filename of current image.")
152 (defvar thumbs-current-image-filename nil
153   "Filename of current image.")
154 (make-variable-buffer-local 'thumbs-current-image-filename)
161 (defvar thumbs-current-image-size nil
162   "Size of current image.")
164 (defvar thumbs-image-num nil
165   "Number of current image.")
166 (make-variable-buffer-local 'thumbs-image-num)
169   "Name of buffer containing thumbnails associated with image.")
199   "Return a unique temporary filename for an image."
226 	    (directory-files (thumbs-thumbsdir) t (image-file-name-regexp)))
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)))
268 (defun thumbs-resize-image-1 (&optional increment size)
269   "Resize image in current buffer.
270 If SIZE is specified use it.  Otherwise make the image larger or
275 		(thumbs-new-image-size thumbs-current-image-size increment)))
278     (thumbs-call-convert (or old thumbs-current-image-filename)
283       (thumbs-insert-image tmp 'jpeg 0))
286 (defun thumbs-resize-image (width height)
287   "Resize image interactively to specified WIDTH and HEIGHT."
289   (thumbs-resize-image-1 nil (cons width height)))
291 (defun thumbs-shrink-image ()
292   "Resize image (smaller)."
294   (thumbs-resize-image-1 -1))
296 (defun thumbs-enlarge-image ()
297   "Resize image (bigger)."
299   (thumbs-resize-image-1 1))
302   "Return a thumbnail name for the image IMG."
327 (defun thumbs-image-type (img)
328   "Return image type from filename IMG."
339   (let ((i (image-size
340 	    (find-image `((:type ,(thumbs-image-type img) :file ,img))) t)))
350 (defun thumbs-insert-image (img type relief &optional marked)
351   "Insert image IMG at point.
352 TYPE and RELIEF will be used in constructing the image; see `image'
354 If MARKED is non-nil, the image is marked."
355   (let ((i `(image :type ,type
360     (insert-image i)
361     (set (make-local-variable 'thumbs-current-image-size)
362          (image-size i t))))
366 If MARKED is non-nil, the image is marked."
367   (thumbs-insert-image
370 		     `(thumb-image-file ,img
378 	(diff (- length (* thumbs-max-image-number thumbs-extra-images))))
386     (if (> diff 0) (message "Type + to display more images."))))
389   (unless (and (display-images-p)
390                (image-type-available-p 'jpeg))
391     (error "Required image type is not supported in this Emacs session"))
410    (directory-files dir t (or reg (image-file-name-regexp)))
414 (defun thumbs-dired-show-marked ()
415   "In dired, make a thumbs buffer with marked files."
417   (thumbs-show-thumbs-list (dired-get-marked-files) nil t))
420 (defun thumbs-dired-show ()
421   "In dired, make a thumbs buffer with all files in current directory."
428 (defun thumbs-find-image (img &optional num otherwin)
433     (thumbs-view-image-mode)
435 	  (concat "image-view-mode: " (file-name-nondirectory img)
439       (setq thumbs-current-image-filename img
441 	    thumbs-image-num (or num 0))
444 	(thumbs-insert-image img (thumbs-image-type img) 0)))))
446 (defun thumbs-find-image-at-point (&optional img otherwin)
447   "Display image IMG for thumbnail at point.
450   (let* ((i (or img (thumbs-current-image))))
451     (thumbs-find-image i (point) otherwin)))
453 (defun thumbs-find-image-at-point-other-window ()
454   "Display image for thumbnail at point in the preview buffer.
457   (thumbs-find-image-at-point nil t))
459 (defun thumbs-mouse-find-image (event)
460   "Display image for thumbnail at mouse click EVENT."
463   (thumbs-find-image-at-point))
474 (defun thumbs-set-image-at-point-to-root-window ()
475   "Set the image at point as the desktop wallpaper."
478    (thumbs-current-image)))
481   "Set the current image as root."
485        thumbs-current-image-filename)))
495 	    (if (thumbs-current-image)
497 			    (thumbs-current-image))
508 	(if (thumbs-current-image)
509 	    (push (thumbs-current-image) list))
514   "Delete the image at point (and its thumbnail) (or marked files if any)."
516   (let ((files (or thumbs-marked-list (list (thumbs-current-image)))))
535   "Rename the image at point (and its thumbnail) (or marked files if any)."
537   (let ((files (or thumbs-marked-list (list (thumbs-current-image))))
565 	(display-warning 'file-error
575 (defun thumbs-show-image-num (num)
576   "Show the image with number NUM."
577   (let ((image-buffer (get-buffer-create "*Image*")))
579       (with-current-buffer image-buffer
581 	      (concat "image-view-mode: " (file-name-nondirectory img)
585 	  (thumbs-insert-image img (thumbs-image-type img) 0)
587       (setq thumbs-image-num num
588 	    thumbs-current-image-filename img))))
590 (defun thumbs-previous-image ()
591   "Show the previous image."
593   (let* ((i (- thumbs-image-num 1))
596     (thumbs-show-image-num i)))
598 (defun thumbs-next-image ()
599   "Show the next image."
601   (let* ((i (1+ thumbs-image-num))
604     (thumbs-show-image-num i)))
606 (defun thumbs-display-thumbs-buffer ()
609   (display-buffer thumbs-buffer))
621   "Mark the image at point."
623   (let ((elt (thumbs-current-image)))
625       (error "No image here"))
633   "Unmark the image at point."
635   (let ((elt (thumbs-current-image)))
637       (error "No image here"))
650 (defun thumbs-modify-image (action &optional arg)
651   "Call convert to do ACTION on image with argument ARG.
658     (thumbs-call-convert (or old thumbs-current-image-filename)
663       (thumbs-insert-image tmp 'jpeg 0))
666 (defun thumbs-emboss-image (emboss)
667   "Emboss the image with value EMBOSS."
671   (thumbs-modify-image "emboss" (number-to-string emboss)))
673 (defun thumbs-monochrome-image ()
674   "Turn the image to monochrome."
676   (thumbs-modify-image "monochrome"))
678 (defun thumbs-negate-image ()
679   "Negate the image."
681   (thumbs-modify-image "negate"))
684   "Rotate the image 90 degrees counter-clockwise."
686   (thumbs-modify-image "rotate" "270"))
689   "Rotate the image 90 degrees clockwise."
691   (thumbs-modify-image "rotate" "90"))
693 (defun thumbs-current-image ()
694   "Return the name of the image file name at point."
695   (get-text-property (point) 'thumb-image-file))
698   "Move forward one image."
701   (while (and (not (eobp)) (not (thumbs-current-image)))
706   "Move backward one image."
709   (while (and (not (bobp)) (not (thumbs-current-image)))
726   "Show more than `thumbs-max-image-number' images, if present."
730   (thumbs-dired-show))
735   (let ((f (thumbs-current-image)))
738 (defun thumbs-save-current-image ()
739   "Save the current image."
742 	       thumbs-current-image-filename))
743 	(sa (read-from-minibuffer "Save image file as: "
744 				  thumbs-current-image-filename)))
747 (defun thumbs-dired ()
748   "Use `dired' on the current thumbs directory."
750   (dired thumbs-current-dir))
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)
766     (define-key map "d" 'thumbs-dired)
782 (defvar thumbs-view-image-mode-map
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)
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)
797   "Keymap for `thumbs-view-image-mode'.")
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"
806 (defun thumbs-dired-setroot ()
807   "In dired, call the setroot program on the image at point."
809   (thumbs-call-setroot-command (dired-get-filename)))
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)