diff options
Diffstat (limited to 'lisp/image-dired.el')
| -rw-r--r-- | lisp/image-dired.el | 2597 |
1 files changed, 2597 insertions, 0 deletions
diff --git a/lisp/image-dired.el b/lisp/image-dired.el new file mode 100644 index 00000000000..ed330410d88 --- /dev/null +++ b/lisp/image-dired.el @@ -0,0 +1,2597 @@ +;;; image-dired.el --- use dired to browse and manipulate your images +;; +;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. +;; +;; Version: 0.4.11 +;; Keywords: multimedia +;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; BACKGROUND +;; ========== +;; +;; I needed a program to browse, organize and tag my pictures. I got +;; tired of the old gallery program I used as it did not allow +;; multi-file operations easily. Also, it put things out of my +;; control. Image viewing programs I tested did not allow multi-file +;; operations or did not do what I wanted it to. +;; +;; So, I got the idea to use the wonderful functionality of Emacs and +;; `dired' to do it. It would allow me to do almost anything I wanted, +;; which is basically just to browse all my pictures in an easy way, +;; letting me manipulate and tag them in various ways. `dired' already +;; provide all the file handling and navigation facilities; I only +;; needed to add some functions to display the images. +;; +;; I briefly tried out thumbs.el, and although it seemed more +;; powerful than this package, it did not work the way I wanted to. It +;; was too slow to created thumbnails of all files in a directory (I +;; currently keep all my 2000+ images in the same directory) and +;; browsing the thumbnail buffer was slow too. image-dired.el will not +;; create thumbnails until they are needed and the browsing is done +;; quickly and easily in dired. I copied a great deal of ideas and +;; code from there though... :) +;; +;; `image-dired' stores the thumbnail files in `image-dired-dir' +;; using the file name format ORIGNAME.thumb.ORIGEXT. For example +;; ~/.emacs.d/image-dired/myimage01.thumb.jpg. The "database" is for +;; now just a plain text file with the following format: +;; +;; file-name-non-directory;comment:comment-text;tag1;tag2;tag3;...;tagN +;; +;; +;; PREREQUISITES +;; ============= +;; +;; * The ImageMagick package. Currently, `convert' and `mogrify' are +;; used. Find it here: http://www.imagemagick.org. +;; +;; * For non-lossy rotation of JPEG images, the JpegTRAN program is +;; needed. +;; +;; * For `image-dired-get-exif-data' and `image-dired-write-exif-data' to work, +;; the command line tool `exiftool' is needed. It can be found here: +;; http://www.sno.phy.queensu.ca/~phil/exiftool/. These two functions +;; are, among other things, used for writing comments to image files +;; using `image-dired-thumbnail-set-image-description' and to create +;; "unique" file names using `image-dired-get-exif-file-name' (used by +;; `image-dired-copy-with-exif-file-name'). +;; +;; +;; USAGE +;; ===== +;; +;; This information has been moved to the manual. Type `C-h r' to open +;; the Emacs manual and go to the node Thumbnails by typing `g +;; Thumbnails RET'. +;; +;; Quickstart: M-x image-dired RET DIRNAME RET +;; +;; where DIRNAME is a directory containing image files. +;; +;; LIMITATIONS +;; =========== +;; +;; * Supports all image formats that Emacs and convert supports, but +;; the thumbnails are hard-coded to JPEG format. +;; +;; * WARNING: The "database" format used might be changed so keep a +;; backup of `image-dired-db-file' when testing new versions. +;; +;; +;; TODO +;; ==== +;; +;; * Support gallery creation when using per-directory thumbnail +;; storage. +;; +;; * Some sort of auto-rotate function based on rotate info in the +;; EXIF data. +;; +;; * Check if exiftool exist before trying to call it to give a better +;; error message. +;; +;; * Investigate if it is possible to also write the tags to the image +;; files. +;; +;; * From thumbs.el: Add an option for clean-up/max-size functionality +;; for thumbnail directory. +;; +;; * From thumbs.el: Add setroot function. +;; +;; * From thumbs.el: Add image resizing, if useful (image-dired's automatic +;; "image fit" might be enough) +;; +;; * From thumbs.el: Add the "modify" commands (emboss, negate, +;; monochrome etc). +;; +;; * Asynchronous creation of thumbnails. +;; +;; * Add `image-dired-display-thumbs-ring' and functions to cycle that. Find +;; out which is best, saving old batch just before inserting new, or +;; saving the current batch in the ring when inserting it. Adding it +;; probably needs rewriting `image-dired-display-thumbs' to be more general. +;; +;; * Find some way of toggling on and off really nice keybindings in +;; dired (for example, using C-n or <down> instead of C-S-n). Richard +;; suggested that we could keep C-t as prefix for image-dired commands +;; as it is currently not used in dired. He also suggested that +;; `dired-next-line' and `dired-previous-line' figure out if +;; image-dired is enabled in the current buffer and, if it is, call +;; `image-dired-dired-next-line' and +;; `image-dired-dired-previous-line', respectively. Update: This is +;; partly done; some bindings have now been added to dired. +;; +;; * Enhanced gallery creation with basic CSS-support and pagination +;; of tag pages with many pictures. +;; +;; * Rewrite `image-dired-modify-mark-on-thumb-original-file' to be +;; less ugly. +;; +;; * In some way keep track of buffers and windows and stuff so that +;; it works as the user expects. +;; +;; * More/better documentation +;; +;; +;;; Code: + +(require 'dired) +(require 'format-spec) +(require 'widget) + +(eval-when-compile + (require 'wid-edit)) + +(defgroup image-dired nil + "Use dired to browse your images as thumbnails, and more." + :prefix "image-dired-" + :group 'multimedia) + +(defcustom image-dired-dir "~/.emacs.d/image-dired/" + "Directory where thumbnail images are stored." + :type 'string + :group 'image-dired) + +(defcustom image-dired-thumbnail-storage 'use-image-dired-dir + "How to store image-dired's thumbnail files. +Image-Dired can store thumbnail files in one of two ways and this is +controlled by this variable. \"Use image-dired dir\" means that the +thumbnails are stored in a central directory. \"Per directory\" +means that each thumbnail is stored in a subdirectory called +\".image-dired\" in the same directory where the image file is. +\"Thumbnail Managing Standard\" means that the thumbnails are +stored and generated according to the Thumbnail Managing Standard +that allows sharing of thumbnails across different programs." + :type '(choice :tag "How to store thumbnail files" + (const :tag "Thumbnail Managing Standard" standard) + (const :tag "Use image-dired-dir" use-image-dired-dir) + (const :tag "Per-directory" per-directory)) + :group 'image-dired) + +(defcustom image-dired-db-file "~/.emacs.d/image-dired/.image-dired_db" + "Database file where file names and their associated tags are stored." + :type 'string + :group 'image-dired) + +(defcustom image-dired-temp-image-file "~/.emacs.d/image-dired/.image-dired_temp" + "Name of temporary image file used by various commands." + :type 'string + :group 'image-dired) + +(defcustom image-dired-gallery-dir "~/.emacs.d/image-dired/.image-dired_gallery" + "Directory to store generated gallery html pages. +This path needs to be \"shared\" to the public so that it can access +the index.html page that image-dired creates." + :type 'string + :group 'image-dired) + +(defcustom image-dired-gallery-image-root-url +"http://your.own.server/image-diredpics" + "URL where the full size images are to be found. +Note that this path has to be configured in your web server. Image-Dired +expects to find pictures in this directory." + :type 'string + :group 'image-dired) + +(defcustom image-dired-gallery-thumb-image-root-url +"http://your.own.server/image-diredthumbs" + "URL where the thumbnail images are to be found. +Note that this path has to be configured in your web server. Image-Dired +expects to find pictures in this directory." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-create-thumbnail-program + "convert" + "Executable used to create thumbnail. +Used together with `image-dired-cmd-create-thumbnail-options'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-create-thumbnail-options + "%p -size %wx%h \"%f\" -resize %wx%h +profile \"*\" jpeg:\"%t\"" + "Format of command used to create thumbnail image. +Available options are %p which is replaced by +`image-dired-cmd-create-thumbnail-program', %w which is replaced by +`image-dired-thumb-width', %h which is replaced by `image-dired-thumb-height', +%f which is replaced by the file name of the original image and %t +which is replaced by the file name of the thumbnail file." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-create-temp-image-program + "convert" + "Executable used to create temporary image. +Used together with `image-dired-cmd-create-temp-image-options'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-create-temp-image-options + "%p -size %wx%h \"%f\" -resize %wx%h +profile \"*\" jpeg:\"%t\"" + "Format of command used to create temporary image for display window. +Available options are %p which is replaced by +`image-dired-cmd-create-temp-image-program', %w and %h which is replaced by +the calculated max size for width and height in the image display window, +%f which is replaced by the file name of the original image and %t which +is replaced by the file name of the temporary file." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-pngnq-program (executable-find "pngnq") + "The file name of the `pngnq' program. +It quantizes colors of PNG images down to 256 colors." + :type '(choice (const :tag "Not Set" nil) string) + :group 'image-dired) + +(defcustom image-dired-cmd-pngcrush-program (executable-find "pngcrush") + "The file name of the `pngcrush' program. +It optimizes the compression of PNG images. Also it adds PNG textual chunks +with the information required by the Thumbnail Managing Standard." + :type '(choice (const :tag "Not Set" nil) string) + :group 'image-dired) + +(defcustom image-dired-cmd-create-standard-thumbnail-command + (concat + image-dired-cmd-create-thumbnail-program " " + "-size %wx%h \"%f\" " + (unless (or image-dired-cmd-pngcrush-program image-dired-cmd-pngnq-program) + (concat + "-set \"Thumb::MTime\" \"%m\" " + "-set \"Thumb::URI\" \"file://%f\" " + "-set \"Description\" \"Thumbnail of file://%f\" " + "-set \"Software\" \"" (emacs-version) "\" ")) + "-thumbnail %wx%h png:\"%t\"" + (if image-dired-cmd-pngnq-program + (concat + " ; " image-dired-cmd-pngnq-program " -f \"%t\"" + (unless image-dired-cmd-pngcrush-program + " ; mv %q %t"))) + (if image-dired-cmd-pngcrush-program + (concat + (unless image-dired-cmd-pngcrush-program + " ; cp %t %q") + " ; " image-dired-cmd-pngcrush-program " -q " + "-text b \"Description\" \"Thumbnail of file://%f\" " + "-text b \"Software\" \"" (emacs-version) "\" " + ;; "-text b \"Thumb::Image::Height\" \"%oh\" " + ;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" " + ;; "-text b \"Thumb::Image::Width\" \"%ow\" " + "-text b \"Thumb::MTime\" \"%m\" " + ;; "-text b \"Thumb::Size\" \"%b\" " + "-text b \"Thumb::URI\" \"file://%f\" " + "%q %t" + " ; rm %q"))) + "Command to create thumbnails according to the Thumbnail Managing Standard." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-rotate-thumbnail-program + "mogrify" + "Executable used to rotate thumbnail. +Used together with `image-dired-cmd-rotate-thumbnail-options'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-rotate-thumbnail-options + "%p -rotate %d \"%t\"" + "Format of command used to rotate thumbnail image. +Available options are %p which is replaced by +`image-dired-cmd-rotate-thumbnail-program', %d which is replaced by the +number of (positive) degrees to rotate the image, normally 90 or 270 +\(for 90 degrees right and left), %t which is replaced by the file name +of the thumbnail file." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-rotate-original-program + "jpegtran" + "Executable used to rotate original image. +Used together with `image-dired-cmd-rotate-original-options'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-rotate-original-options + "%p -rotate %d -copy all -outfile %t \"%o\"" + "Format of command used to rotate original image. +Available options are %p which is replaced by +`image-dired-cmd-rotate-original-program', %d which is replaced by the +number of (positive) degrees to rotate the image, normally 90 or +270 \(for 90 degrees right and left), %o which is replaced by the +original image file name and %t which is replaced by +`image-dired-temp-image-file'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-temp-rotate-image-file + "~/.emacs.d/image-dired/.image-dired_rotate_temp" + "Temporary file for rotate operations." + :type 'string + :group 'image-dired) + +(defcustom image-dired-rotate-original-ask-before-overwrite t + "Confirm overwrite of original file after rotate operation. +If non-nil, ask user for confirmation before overwriting the +original file with `image-dired-temp-rotate-image-file'." + :type 'boolean + :group 'image-dired) + +(defcustom image-dired-cmd-write-exif-data-program + "exiftool" + "Program used to write EXIF data to image. +Used together with `image-dired-cmd-write-exif-data-options'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-write-exif-data-options + "%p -%t=\"%v\" \"%f\"" + "Format of command used to write EXIF data. +Available options are %p which is replaced by +`image-dired-cmd-write-exif-data-program', %f which is replaced by the +image file name, %t which is replaced by the tag name and %v +which is replaced by the tag value." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-read-exif-data-program + "exiftool" + "Program used to read EXIF data to image. +Used together with `image-dired-cmd-read-exif-data-program-options'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-cmd-read-exif-data-options + "%p -s -s -s -%t \"%f\"" + "Format of command used to read EXIF data. +Available options are %p which is replaced by +`image-dired-cmd-write-exif-data-options', %f which is replaced +by the image file name and %t which is replaced by the tag name." + :type 'string + :group 'image-dired) + +(defcustom image-dired-gallery-hidden-tags + (list "private" "hidden" "pending") + "List of \"hidden\" tags. +Used by `image-dired-gallery-generate' to leave out \"hidden\" images." + :type '(repeat string) + :group 'image-dired) + +(defcustom image-dired-thumb-size (if (eq 'standard image-dired-thumbnail-storage) 128 100) + "Size of thumbnails, in pixels. +This is the default size for both `image-dired-thumb-width' and `image-dired-thumb-height'." + :type 'integer + :group 'image-dired) + +(defcustom image-dired-thumb-width image-dired-thumb-size + "Width of thumbnails, in pixels." + :type 'integer + :group 'image-dired) + +(defcustom image-dired-thumb-height image-dired-thumb-size + "Height of thumbnails, in pixels." + :type 'integer + :group 'image-dired) + +(defcustom image-dired-thumb-relief 2 + "Size of button-like border around thumbnails." + :type 'integer + :group 'image-dired) + +(defcustom image-dired-thumb-margin 2 + "Size of the margin around thumbnails. +This is where you see the cursor." + :type 'integer + :group 'image-dired) + +(defcustom image-dired-line-up-method 'dynamic + "Default method for line-up of thumbnails in thumbnail buffer. +Used by `image-dired-display-thumbs' and other functions that needs to +line-up thumbnails. Dynamic means to use the available width of the +window containing the thumbnail buffer, Fixed means to use +`image-dired-thumbs-per-row', Interactive is for asking the user, and No +line-up means that no automatic line-up will be done." + :type '(choice :tag "Default line-up method" + (const :tag "Dynamic" dynamic) + (const :tag "Fixed" fixed) + (const :tag "Interactive" interactive) + (const :tag "No line-up" none)) + :group 'image-dired) + +(defcustom image-dired-thumbs-per-row 3 + "Number of thumbnails to display per row in thumb buffer." + :type 'integer + :group 'image-dired) + +(defcustom image-dired-display-window-width-correction 1 + "Number to be used to correct image display window width. +Change if the default (1) does not work (i.e. if the image does not +completely fit)." + :type 'integer + :group 'image-dired) + +(defcustom image-dired-display-window-height-correction 0 + "Number to be used to correct image display window height. +Change if the default (0) does not work (i.e. if the image does not +completely fit)." + :type 'integer + :group 'image-dired) + +(defcustom image-dired-track-movement t + "The current state of the tracking and mirroring. +For more information, see the documentation for +`image-dired-toggle-movement-tracking'." + :type 'boolean + :group 'image-dired) + +(defcustom image-dired-append-when-browsing nil + "Append thumbnails in thumbnail buffer when browsing. +If non-nil, using `image-dired-next-line-and-display' and +`image-dired-previous-line-and-display' will leave a trail of thumbnail +images in the thumbnail buffer. If you enable this and want to clean +the thumbnail buffer because it is filled with too many thumbmnails, +just call `image-dired-display-thumb' to display only the image at point. +This value can be toggled using `image-dired-toggle-append-browsing'." + :type 'boolean + :group 'image-dired) + +(defcustom image-dired-dired-disp-props t + "If non-nil, display properties for dired file when browsing. +Used by `image-dired-next-line-and-display', +`image-dired-previous-line-and-display' and `image-dired-mark-and-display-next'. +If the database file is large, this can slow down image browsing in +dired and you might want to turn it off." + :type 'boolean + :group 'image-dired) + +(defcustom image-dired-display-properties-format "%b: %f (%t): %c" + "Display format for thumbnail properties. +%b is replaced with associated dired buffer name, %f with file name +\(without path) of original image file, %t with the list of tags and %c +with the comment." + :type 'string + :group 'image-dired) + +(defcustom image-dired-external-viewer + ;; TODO: Use mailcap, dired-guess-shell-alist-default, + ;; dired-view-command-alist. + (cond ((executable-find "display")) + ((executable-find "xli")) + ((executable-find "qiv") "qiv -t")) + "Name of external viewer. +Including parameters. Used when displaying original image from +`image-dired-thumbnail-mode'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-main-image-directory "~/pics/" + "Name of main image directory, if any. +Used by `image-dired-copy-with-exif-file-name'." + :type 'string + :group 'image-dired) + +(defcustom image-dired-show-all-from-dir-max-files 50 + "Maximum number of files to show using `image-dired-show-all-from-dir'. +before warning the user." + :type 'integer + :group 'image-dired) + +(defun image-dired-dir () + "Return the current thumbnails directory (from variable `image-dired-dir'). +Create the thumbnails directory if it does not exist." + (let ((image-dired-dir (file-name-as-directory + (expand-file-name image-dired-dir)))) + (unless (file-directory-p image-dired-dir) + (make-directory image-dired-dir t) + (message "Creating thumbnails directory")) + image-dired-dir)) + +(defun image-dired-insert-image (file type relief margin) + "Insert image FILE of image TYPE, using RELIEF and MARGIN, at point." + + (let ((i `(image :type ,type + :file ,file + :relief ,relief + :margin ,margin))) + (insert-image i))) + +(defun image-dired-get-thumbnail-image (file) + "Return the image descriptor for a thumbnail of image file FILE." + (unless (string-match (image-file-name-regexp) file) + (error "%s is not a valid image file" file)) + (let ((thumb-file (image-dired-thumb-name file))) + (unless (and (file-exists-p thumb-file) + (<= (float-time (nth 5 (file-attributes file))) + (float-time (nth 5 (file-attributes thumb-file))))) + (image-dired-create-thumb file thumb-file)) + (create-image thumb-file) +;; (list 'image :type 'jpeg +;; :file thumb-file +;; :relief image-dired-thumb-relief :margin image-dired-thumb-margin) + )) + +(defun image-dired-insert-thumbnail (file original-file-name + associated-dired-buffer) + "Insert thumbnail image FILE. +Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER." + (let (beg end) + (setq beg (point)) + (image-dired-insert-image file + ;; TODO: this should depend on the real file type + (if (eq 'standard image-dired-thumbnail-storage) + 'png 'jpeg) + image-dired-thumb-relief + image-dired-thumb-margin) + (setq end (point)) + (add-text-properties + beg end + (list 'image-dired-thumbnail t + 'original-file-name original-file-name + 'associated-dired-buffer associated-dired-buffer + 'tags (image-dired-list-tags original-file-name) + 'mouse-face 'highlight + 'comment (image-dired-get-comment original-file-name))))) + +(defun image-dired-thumb-name (file) + "Return thumbnail file name for FILE. +Depending on the value of `image-dired-thumbnail-storage', the file +name will vary. For central thumbnail file storage, make a +MD5-hash of the image file's directory name and add that to make +the thumbnail file name unique. For per-directory storage, just +add a subdirectory. For standard storage, produce the file name +according to the Thumbnail Managing Standard." + (cond ((eq 'standard image-dired-thumbnail-storage) + (expand-file-name + (concat "~/.thumbnails/normal/" + (md5 (concat "file://" (expand-file-name file))) ".png"))) + ((eq 'use-image-dired-dir image-dired-thumbnail-storage) + (let* ((f (expand-file-name file)) + (md5-hash + ;; Is MD5 hashes fast enough? The checksum of a + ;; thumbnail file name need not be that + ;; "cryptographically" good so a faster one could + ;; be used here. + (md5 (file-name-as-directory (file-name-directory f))))) + (format "%s%s%s.thumb.%s" + (file-name-as-directory (expand-file-name (image-dired-dir))) + (file-name-sans-extension (file-name-nondirectory f)) + (if md5-hash (concat "_" md5-hash) "") + (file-name-extension f)))) + ((eq 'per-directory image-dired-thumbnail-storage) + (let ((f (expand-file-name file))) + (format "%s.image-dired/%s.thumb.%s" + (file-name-directory f) + (file-name-sans-extension (file-name-nondirectory f)) + (file-name-extension f)))))) + +(defun image-dired-create-thumb (original-file thumbnail-file) + "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE." + (let* ((width (int-to-string image-dired-thumb-width)) + (height (int-to-string image-dired-thumb-height)) + (modif-time (format "%.0f" (float-time (nth 5 (file-attributes + original-file))))) + (thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png" + thumbnail-file)) + (command + (format-spec + (if (eq 'standard image-dired-thumbnail-storage) + image-dired-cmd-create-standard-thumbnail-command + image-dired-cmd-create-thumbnail-options) + (list + (cons ?p image-dired-cmd-create-thumbnail-program) + (cons ?w width) + (cons ?h height) + (cons ?m modif-time) + (cons ?f original-file) + (cons ?q thumbnail-nq8-file) + (cons ?t thumbnail-file)))) + thumbnail-dir) + (when (not (file-exists-p + (setq thumbnail-dir (file-name-directory thumbnail-file)))) + (message "Creating thumbnail directory.") + (make-directory thumbnail-dir)) + (call-process shell-file-name nil nil nil shell-command-switch command))) + +;;;###autoload +(defun image-dired-dired-insert-marked-thumbs () + "Insert thumbnails before file names of marked files in the dired buffer." + (interactive) + (dired-map-over-marks + (let* ((image-pos (dired-move-to-filename)) + (image-file (dired-get-filename)) + (thumb-file (image-dired-get-thumbnail-image image-file)) + overlay) + ;; If image is not already added, then add it. + (unless (delq nil (mapcar (lambda (o) (overlay-get o 'put-image)) + ;; Can't use (overlays-at (point)), BUG? + (overlays-in (point) (1+ (point))))) + (put-image thumb-file image-pos) + (setq + overlay + (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o)) + (overlays-in (point) (1+ (point))))))) + (overlay-put overlay 'image-file image-file) + (overlay-put overlay 'thumb-file thumb-file))) + nil) + (add-hook 'dired-after-readin-hook 'image-dired-dired-after-readin-hook nil t)) + +(defun image-dired-dired-after-readin-hook () + "Relocate existing thumbnail overlays in dired buffer after reverting. +Move them to their corresponding files if they are still exist. +Otherwise, delete overlays." + (mapc (lambda (overlay) + (when (overlay-get overlay 'put-image) + (let* ((image-file (overlay-get overlay 'image-file)) + (image-pos (dired-goto-file image-file))) + (if image-pos + (move-overlay overlay image-pos image-pos) + (delete-overlay overlay))))) + (overlays-in (point-min) (point-max)))) + +(defun image-dired-next-line-and-display () + "Move to next dired line and display thumbnail image." + (interactive) + (dired-next-line 1) + (image-dired-display-thumbs + t (or image-dired-append-when-browsing nil) t) + (if image-dired-dired-disp-props + (image-dired-dired-display-properties))) + +(defun image-dired-previous-line-and-display () + "Move to previous dired line and display thumbnail image." + (interactive) + (dired-previous-line 1) + (image-dired-display-thumbs + t (or image-dired-append-when-browsing nil) t) + (if image-dired-dired-disp-props + (image-dired-dired-display-properties))) + +(defun image-dired-toggle-append-browsing () + "Toggle `image-dired-append-when-browsing'." + (interactive) + (setq image-dired-append-when-browsing + (not image-dired-append-when-browsing)) + (message "Append browsing %s." + (if image-dired-append-when-browsing + "on" + "off"))) + +(defun image-dired-mark-and-display-next () + "Mark current file in dired and display next thumbnail image." + (interactive) + (dired-mark 1) + (image-dired-display-thumbs + t (or image-dired-append-when-browsing nil) t) + (if image-dired-dired-disp-props + (image-dired-dired-display-properties))) + +(defun image-dired-toggle-dired-display-properties () + "Toggle `image-dired-dired-disp-props'." + (interactive) + (setq image-dired-dired-disp-props + (not image-dired-dired-disp-props)) + (message "Dired display properties %s." + (if image-dired-dired-disp-props + "on" + "off"))) + +(defvar image-dired-thumbnail-buffer "*image-dired*" + "Image-Dired's thumbnail buffer.") + +(defun image-dired-create-thumbnail-buffer () + "Create thumb buffer and set `image-dired-thumbnail-mode'." + (let ((buf (get-buffer-create image-dired-thumbnail-buffer))) + (with-current-buffer buf + (setq buffer-read-only t) + (if (not (eq major-mode 'image-dired-thumbnail-mode)) + (image-dired-thumbnail-mode))) + buf)) + +(defvar image-dired-display-image-buffer "*image-dired-display-image*" + "Where larger versions of the images are display.") + +(defun image-dired-create-display-image-buffer () + "Create image display buffer and set `image-dired-display-image-mode'." + (let ((buf (get-buffer-create image-dired-display-image-buffer))) + (with-current-buffer buf + (setq buffer-read-only t) + (if (not (eq major-mode 'image-dired-display-image-mode)) + (image-dired-display-image-mode))) + buf)) + +(defvar image-dired-saved-window-configuration nil + "Saved window configuration.") + +;;;###autoload +(defun image-dired-dired-with-window-configuration (dir &optional arg) + "Open directory DIR and create a default window configuration. + +Convenience command that: + + - Opens dired in folder DIR + - Splits windows in most useful (?) way + - Set `truncate-lines' to t + +After the command has finished, you would typically mark some +image files in dired and type +\\[image-dired-display-thumbs] (`image-dired-display-thumbs'). + +If called with prefix argument ARG, skip splitting of windows. + +The current window configuration is saved and can be restored by +calling `image-dired-restore-window-configuration'." + (interactive "DDirectory: \nP") + (let ((buf (image-dired-create-thumbnail-buffer)) + (buf2 (image-dired-create-display-image-buffer))) + (setq image-dired-saved-window-configuration + (current-window-configuration)) + (dired dir) + (delete-other-windows) + (when (not arg) + (split-window-horizontally) + (setq truncate-lines t) + (save-excursion + (other-window 1) + (switch-to-buffer buf) + (split-window-vertically) + (other-window 1) + (switch-to-buffer buf2) + (other-window -2))))) + +(defun image-dired-restore-window-configuration () + "Restore window configuration. +Restore any changes to the window configuration made by calling +`image-dired-dired-with-window-configuration'." + (interactive) + (if image-dired-saved-window-configuration + (set-window-configuration image-dired-saved-window-configuration) + (message "No saved window configuration"))) + +;;;###autoload +(defun image-dired-display-thumbs (&optional arg append do-not-pop) + "Display thumbnails of all marked files, in `image-dired-thumbnail-buffer'. +If a thumbnail image does not exist for a file, it is created on the +fly. With prefix argument ARG, display only thumbnail for file at +point (this is useful if you have marked some files but want to show +another one). + +Recommended usage is to split the current frame horizontally so that +you have the dired buffer in the left window and the +`image-dired-thumbnail-buffer' buffer in the right window. + +With optional argument APPEND, append thumbnail to thumbnail buffer +instead of erasing it first. + +Option argument DO-NOT-POP controls if `pop-to-buffer' should be +used or not. If non-nil, use `display-buffer' instead of +`pop-to-buffer'. This is used from functions like +`image-dired-next-line-and-display' and +`image-dired-previous-line-and-display' where we do not want the +thumbnail buffer to be selected." + (interactive "P") + (let ((buf (image-dired-create-thumbnail-buffer)) + curr-file thumb-name files count dired-buf beg) + (if arg + (setq files (list (dired-get-filename))) + (setq files (dired-get-marked-files))) + (setq dired-buf (current-buffer)) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (if (not append) + (erase-buffer) + (goto-char (point-max))) + (mapcar + (lambda (curr-file) + (setq thumb-name (image-dired-thumb-name curr-file)) + (if (and (not (file-exists-p thumb-name)) + (not (= 0 (image-dired-create-thumb curr-file thumb-name)))) + (message "Thumb could not be created for file %s" curr-file) + (image-dired-insert-thumbnail thumb-name curr-file dired-buf))) + files)) + (cond ((eq 'dynamic image-dired-line-up-method) + (image-dired-line-up-dynamic)) + ((eq 'fixed image-dired-line-up-method) + (image-dired-line-up)) + ((eq 'interactive image-dired-line-up-method) + (image-dired-line-up-interactive)) + ((eq 'none image-dired-line-up-method) + nil) + (t + (image-dired-line-up-dynamic)))) + (if do-not-pop + (display-buffer image-dired-thumbnail-buffer) + (pop-to-buffer image-dired-thumbnail-buffer)))) + +;;;###autoload +(defun image-dired-show-all-from-dir (dir) + "Make a preview buffer for all images in DIR and display it. +If the number of files in DIR matching `image-file-name-regexp' +exceeds `image-dired-show-all-from-dir-max-files', a warning will be +displayed." + (interactive "DDir: ") + (dired dir) + (dired-mark-files-regexp (image-file-name-regexp)) + (let ((files (dired-get-marked-files))) + (if (or (<= (length files) image-dired-show-all-from-dir-max-files) + (and (> (length files) image-dired-show-all-from-dir-max-files) + (y-or-n-p + (format + "Directory contains more than %d image files. Proceed? " + image-dired-show-all-from-dir-max-files)))) + (progn + (image-dired-display-thumbs) + (pop-to-buffer image-dired-thumbnail-buffer)) + (message "Cancelled.")))) + +;;;###autoload +(defalias 'image-dired 'image-dired-show-all-from-dir) + +;;;###autoload +(defalias 'tumme 'image-dired-show-all-from-dir) + +(defun image-dired-write-tags (file-tags) + "Write file tags to database. +Write each file and tag in FILE-TAGS to the database. FILE-TAGS +is an alist in the following form: + ((FILE . TAG) ... )" + (let (end file tag) + (with-temp-file image-dired-db-file + (insert-file-contents image-dired-db-file) + (dolist (elt file-tags) + (setq file (car elt) + tag (cdr elt)) + (goto-char (point-min)) + (if (search-forward-regexp (format "^%s.*$" file) nil t) + (progn + (setq end (point)) + (beginning-of-line) + (when (not (search-forward (format ";%s" tag) end t)) + (end-of-line) + (insert (format ";%s" tag)))) + (goto-char (point-max)) + (insert (format "\n%s;%s" file tag))))))) + +(defun image-dired-remove-tag (files tag) + "For all FILES, remove TAG from the image database." + (save-excursion + (let (end buf start) + (setq buf (find-file image-dired-db-file)) + (if (not (listp files)) + (if (stringp files) + (setq files (list files)) + (error "Files must be a string or a list of strings!"))) + (mapcar + (lambda (file) + (goto-char (point-min)) + (when (search-forward-regexp + (format "^%s" file) nil t) + (end-of-line) + (setq end (point)) + (beginning-of-line) + (when (search-forward-regexp (format "\\(;%s\\)" tag) end t) + (delete-region (match-beginning 1) (match-end 1)) + ;; Check if file should still be in the database. If + ;; it has no tags or comments, it will be removed. + (end-of-line) + (setq end (point)) + (beginning-of-line) + (when (not (search-forward ";" end t)) + (kill-line 1) + ;; If on empty line at end of buffer + (when (and (eobp) + (looking-at "^$")) + (delete-backward-char 1)))))) + files) + (save-buffer) + (kill-buffer buf)))) + +(defun image-dired-list-tags (file) + "Read all tags for image FILE from the image database." + (save-excursion + (let (end buf (tags "")) + (setq buf (find-file image-dired-db-file)) + (goto-char (point-min)) + (when (search-forward-regexp + (format "^%s" file) nil t) + (end-of-line) + (setq end (point)) + (beginning-of-line) + (if (search-forward ";" end t) + (if (search-forward "comment:" end t) + (if (search-forward ";" end t) + (setq tags (buffer-substring (point) end))) + (setq tags (buffer-substring (point) end))))) + (kill-buffer buf) + (split-string tags ";")))) + +;;;###autoload +(defun image-dired-tag-files (arg) + "Tag marked file(s) in dired. With prefix ARG, tag file at point." + (interactive "P") + (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")) + curr-file files) + (if arg + (setq files (list (dired-get-filename))) + (setq files (dired-get-marked-files))) + (image-dired-write-tags + (mapcar + (lambda (x) + (cons x tag)) + files)))) + +(defun image-dired-tag-thumbnail () + "Tag current thumbnail." + (interactive) + (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))) + (image-dired-write-tags (list (cons (image-dired-original-file-name) tag)))) + (image-dired-update-property + 'tags (image-dired-list-tags (image-dired-original-file-name)))) + +;;;###autoload +(defun image-dired-delete-tag (arg) + "Remove tag for selected file(s). +With prefix argument ARG, remove tag from file at point." + (interactive "P") + (let ((tag (read-string "Tag to remove: ")) + files) + (if arg + (setq files (list (dired-get-filename))) + (setq files (dired-get-marked-files))) + (image-dired-remove-tag files tag))) + +(defun image-dired-tag-thumbnail-remove () + "Remove tag from thumbnail." + (interactive) + (let ((tag (read-string "Tag to remove: "))) + (image-dired-remove-tag (image-dired-original-file-name) tag)) + (image-dired-update-property + 'tags (image-dired-list-tags (image-dired-original-file-name)))) + +(defun image-dired-original-file-name () + "Get original file name for thumbnail or display image at point." + (get-text-property (point) 'original-file-name)) + +(defun image-dired-associated-dired-buffer () + "Get associated dired buffer at point." + (get-text-property (point) 'associated-dired-buffer)) + +(defun image-dired-get-buffer-window (buf) + "Return window where buffer BUF is." + (get-window-with-predicate + (lambda (window) + (equal (window-buffer window) buf)) + nil t)) + +(defun image-dired-track-original-file () + "Track the original file in the associated dired buffer. +See documentation for `image-dired-toggle-movement-tracking'. Interactive +use only useful if `image-dired-track-movement' is nil." + (interactive) + (let ((old-buf (current-buffer)) + (dired-buf (image-dired-associated-dired-buffer)) + (file-name (image-dired-original-file-name))) + (when (and (buffer-live-p dired-buf) file-name) + (setq file-name (file-name-nondirectory file-name)) + (set-buffer dired-buf) + (goto-char (point-min)) + (if (not (search-forward file-name nil t)) + (message "Could not track file") + (dired-move-to-filename) + (set-window-point + (image-dired-get-buffer-window dired-buf) (point))) + (set-buffer old-buf)))) + +(defun image-dired-toggle-movement-tracking () + "Turn on and off `image-dired-track-movement'. +Tracking of the movements between thumbnail and dired buffer so that +they are \"mirrored\" in the dired buffer. When this is on, moving +around in the thumbnail or dired buffer will find the matching +position in the other buffer." + (interactive) + (setq image-dired-track-movement (not image-dired-track-movement)) + (message "Tracking %s" (if image-dired-track-movement "on" "off"))) + +(defun image-dired-track-thumbnail () + "Track current dired file's thumb in `image-dired-thumbnail-buffer'. +This is almost the same as what `image-dired-track-original-file' does, but +the other way around." + (let ((file (dired-get-filename)) + (old-buf (current-buffer)) + prop-val found) + (when (get-buffer image-dired-thumbnail-buffer) + (set-buffer image-dired-thumbnail-buffer) + (goto-char (point-min)) + (while (and (not (eobp)) + (not found)) + (if (and (setq prop-val + (get-text-property (point) 'original-file-name)) + (string= prop-val file)) + (setq found t)) + (if (not found) + (forward-char 1))) + (when found + (set-window-point + (image-dired-thumbnail-window) (point)) + (image-dired-display-thumb-properties)) + (set-buffer old-buf)))) + +(defun image-dired-dired-next-line (&optional arg) + "Call `dired-next-line', then track thumbnail. +This can safely replace `dired-next-line'. With prefix argument, move +ARG lines." + (interactive "P") + (dired-next-line (or arg 1)) + (if image-dired-track-movement + (image-dired-track-thumbnail))) + +(defun image-dired-dired-previous-line (&optional arg) + "Call `dired-previous-line', then track thumbnail. +This can safely replace `dired-previous-line'. With prefix argument, +move ARG lines." + (interactive "P") + (dired-previous-line (or arg 1)) + (if image-dired-track-movement + (image-dired-track-thumbnail))) + +(defun image-dired-forward-image (&optional arg) + "Move to next image and display properties. +Optional prefix ARG says how many images to move; default is one +image." + (interactive "p") + (let (pos (steps (or arg 1))) + (dotimes (i steps) + (if (and (not (eobp)) + (save-excursion + (forward-char) + (while (and (not (eobp)) + (not (image-dired-image-at-point-p))) + (forward-char)) + (setq pos (point)) + (image-dired-image-at-point-p))) + (goto-char pos) + (error "At last image")))) + (when image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-display-thumb-properties)) + +(defun image-dired-backward-image (&optional arg) + "Move to previous image and display properties. +Optional prefix ARG says how many images to move; default is one +image." + (interactive "p") + (let (pos (steps (or arg 1))) + (dotimes (i steps) + (if (and (not (bobp)) + (save-excursion + (backward-char) + (while (and (not (bobp)) + (not (image-dired-image-at-point-p))) + (backward-char)) + (setq pos (point)) + (image-dired-image-at-point-p))) + (goto-char pos) + (error "At first image")))) + (when image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-display-thumb-properties)) + +(defun image-dired-next-line () + "Move to next line and display properties." + (interactive) + (next-line 1) + ;; If we end up in an empty spot, back up to the next thumbnail. + (if (not (image-dired-image-at-point-p)) + (image-dired-backward-image)) + (if image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-display-thumb-properties)) + + +(defun image-dired-previous-line () + "Move to previous line and display properties." + (interactive) + (previous-line 1) + ;; If we end up in an empty spot, back up to the next + ;; thumbnail. This should only happen if the user deleted a + ;; thumbnail and did not refresh, so it is not very common. But we + ;; can handle it in a good manner, so why not? + (if (not (image-dired-image-at-point-p)) + (image-dired-backward-image)) + (if image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-display-thumb-properties)) + +(defun image-dired-format-properties-string (buf file props comment) + "Format display properties. +BUF is the associated dired buffer, FILE is the original image file +name, PROPS is a list of tags and COMMENT is the image files's +comment." + (format-spec + image-dired-display-properties-format + (list + (cons ?b (or buf "")) + (cons ?f file) + (cons ?t (or (princ props) "")) + (cons ?c (or comment ""))))) + +(defun image-dired-display-thumb-properties () + "Display thumbnail properties in the echo area." + (if (not (eobp)) + (let ((file-name (file-name-nondirectory (image-dired-original-file-name))) + (dired-buf (buffer-name (image-dired-associated-dired-buffer))) + (props (mapconcat + 'princ + (get-text-property (point) 'tags) + ", ")) + (comment (get-text-property (point) 'comment))) + (if file-name + (message + (image-dired-format-properties-string + dired-buf + file-name + props + comment)))))) + +(defun image-dired-dired-file-marked-p () + "Check whether file on current line is marked or not." + (save-excursion + (beginning-of-line) + (not (looking-at "^ .*$")))) + +(defun image-dired-modify-mark-on-thumb-original-file (command) + "Modify mark in dired buffer. +This is quite ugly but I don't know how to implemented in a better +way. COMMAND is one of 'mark for marking file in dired, 'unmark for +unmarking file in dired or 'flag for flagging file for delete in +dired." + (let ((file-name (image-dired-original-file-name)) + (dired-buf (image-dired-associated-dired-buffer))) + (if (not (and dired-buf file-name)) + (message "No image, or image with correct properties, at point.") + (with-current-buffer dired-buf + (message file-name) + (setq file-name (file-name-nondirectory file-name)) + (goto-char (point-min)) + (if (search-forward file-name nil t) + (cond ((eq command 'mark) (dired-mark 1)) + ((eq command 'unmark) (dired-unmark 1)) + ((eq command 'toggle) + (if (image-dired-dired-file-marked-p) + (dired-unmark 1) + (dired-mark 1))) + ((eq command 'flag) (dired-flag-file-deletion 1)))))))) + +(defun image-dired-mark-thumb-original-file () + "Mark original image file in associated dired buffer." + (interactive) + (image-dired-modify-mark-on-thumb-original-file 'mark) + (image-dired-forward-image)) + +(defun image-dired-unmark-thumb-original-file () + "Unmark original image file in associated dired buffer." + (interactive) + (image-dired-modify-mark-on-thumb-original-file 'unmark) + (image-dired-forward-image)) + +(defun image-dired-flag-thumb-original-file () + "Flag original image file for deletion in associated dired buffer." + (interactive) + (image-dired-modify-mark-on-thumb-original-file 'flag) + (image-dired-forward-image)) + +(defun image-dired-toggle-mark-thumb-original-file () + "Toggle mark on original image file in associated dired buffer." + (interactive) + (image-dired-modify-mark-on-thumb-original-file 'toggle)) + +(defun image-dired-jump-original-dired-buffer () + "Jump to the dired buffer associated with the current image file. +You probably want to use this together with +`image-dired-track-original-file'." + (interactive) + (let ((buf (image-dired-associated-dired-buffer)) + window frame) + (setq window (image-dired-get-buffer-window buf)) + (if window + (progn + (if (not (equal (selected-frame) (setq frame (window-frame window)))) + (select-frame-set-input-focus frame)) + (select-window window)) + (message "Associated dired buffer not visible")))) + +;;;###autoload +(defun image-dired-jump-thumbnail-buffer () + "Jump to thumbnail buffer." + (interactive) + (let ((window (image-dired-thumbnail-window)) + frame) + (if window + (progn + (if (not (equal (selected-frame) (setq frame (window-frame window)))) + (select-frame-set-input-focus frame)) + (select-window window)) + (message "Thumbnail buffer not visible")))) + +(defvar image-dired-thumbnail-mode-map (make-sparse-keymap) + "Keymap for `image-dired-thumbnail-mode'.") + +(defvar image-dired-thumbnail-mode-line-up-map (make-sparse-keymap) + "Keymap for line-up commands in `image-dired-thumbnail-mode'.") + +(defvar image-dired-thumbnail-mode-tag-map (make-sparse-keymap) + "Keymap for tag commands in `image-dired-thumbnail-mode'.") + +(defun image-dired-define-thumbnail-mode-keymap () + "Define keymap for `image-dired-thumbnail-mode'." + + ;; Keys + (define-key image-dired-thumbnail-mode-map [right] 'image-dired-forward-image) + (define-key image-dired-thumbnail-mode-map [left] 'image-dired-backward-image) + (define-key image-dired-thumbnail-mode-map [up] 'image-dired-previous-line) + (define-key image-dired-thumbnail-mode-map [down] 'image-dired-next-line) + (define-key image-dired-thumbnail-mode-map "\C-f" 'image-dired-forward-image) + (define-key image-dired-thumbnail-mode-map "\C-b" 'image-dired-backward-image) + (define-key image-dired-thumbnail-mode-map "\C-p" 'image-dired-previous-line) + (define-key image-dired-thumbnail-mode-map "\C-n" 'image-dired-next-line) + + (define-key image-dired-thumbnail-mode-map "d" 'image-dired-flag-thumb-original-file) + (define-key image-dired-thumbnail-mode-map [delete] + 'image-dired-flag-thumb-original-file) + (define-key image-dired-thumbnail-mode-map "m" 'image-dired-mark-thumb-original-file) + (define-key image-dired-thumbnail-mode-map "u" 'image-dired-unmark-thumb-original-file) + (define-key image-dired-thumbnail-mode-map "." 'image-dired-track-original-file) + (define-key image-dired-thumbnail-mode-map [tab] 'image-dired-jump-original-dired-buffer) + + ;; add line-up map + (define-key image-dired-thumbnail-mode-map "g" image-dired-thumbnail-mode-line-up-map) + + ;; map it to "g" so that the user can press it more quickly + (define-key image-dired-thumbnail-mode-line-up-map "g" 'image-dired-line-up-dynamic) + ;; "f" for "fixed" number of thumbs per row + (define-key image-dired-thumbnail-mode-line-up-map "f" 'image-dired-line-up) + ;; "i" for "interactive" + (define-key image-dired-thumbnail-mode-line-up-map "i" 'image-dired-line-up-interactive) + + ;; add tag map + (define-key image-dired-thumbnail-mode-map "t" image-dired-thumbnail-mode-tag-map) + + ;; map it to "t" so that the user can press it more quickly + (define-key image-dired-thumbnail-mode-tag-map "t" 'image-dired-tag-thumbnail) + ;; "r" for "remove" + (define-key image-dired-thumbnail-mode-tag-map "r" 'image-dired-tag-thumbnail-remove) + + (define-key image-dired-thumbnail-mode-map "\C-m" + 'image-dired-display-thumbnail-original-image) + (define-key image-dired-thumbnail-mode-map [C-return] + 'image-dired-thumbnail-display-external) + + (define-key image-dired-thumbnail-mode-map "l" 'image-dired-rotate-thumbnail-left) + (define-key image-dired-thumbnail-mode-map "r" 'image-dired-rotate-thumbnail-right) + + (define-key image-dired-thumbnail-mode-map "L" 'image-dired-rotate-original-left) + (define-key image-dired-thumbnail-mode-map "R" 'image-dired-rotate-original-right) + + (define-key image-dired-thumbnail-mode-map "D" + 'image-dired-thumbnail-set-image-description) + + (define-key image-dired-thumbnail-mode-map "\C-d" 'image-dired-delete-char) + (define-key image-dired-thumbnail-mode-map " " + 'image-dired-display-next-thumbnail-original) + (define-key image-dired-thumbnail-mode-map + (kbd "DEL") 'image-dired-display-previous-thumbnail-original) + (define-key image-dired-thumbnail-mode-map "c" 'image-dired-comment-thumbnail) + (define-key image-dired-thumbnail-mode-map "q" 'image-dired-kill-buffer-and-window) + + ;; Mouse + (define-key image-dired-thumbnail-mode-map [mouse-2] 'image-dired-mouse-display-image) + (define-key image-dired-thumbnail-mode-map [mouse-1] 'image-dired-mouse-select-thumbnail) + + ;; Seems I must first set C-down-mouse-1 to undefined, or else it + ;; will trigger the buffer menu. If I try to instead bind + ;; C-down-mouse-1 to `image-dired-mouse-toggle-mark', I get a message + ;; about C-mouse-1 not being defined afterwards. Annoying, but I + ;; probably do not completely understand mouse events. + + (define-key image-dired-thumbnail-mode-map [C-down-mouse-1] 'undefined) + (define-key image-dired-thumbnail-mode-map [C-mouse-1] 'image-dired-mouse-toggle-mark) + + ;; Menu + (define-key image-dired-thumbnail-mode-map [menu-bar image-dired] + (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-kill-buffer-and-window] + '("Quit" . image-dired-kill-buffer-and-window)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-delete-char] + '("Delete thumbnail from buffer" . image-dired-delete-char)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-tag-thumbnail-remove] + '("Remove tag from thumbnail" . image-dired-tag-thumbnail-remove)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-tag-thumbnail] + '("Tag thumbnail" . image-dired-tag-thumbnail)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-comment-thumbnail] + '("Comment thumbnail" . image-dired-comment-thumbnail)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-refresh-thumb] + '("Refresh thumb" . image-dired-refresh-thumb)) + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-line-up-dynamic] + '("Dynamic line up" . image-dired-line-up-dynamic)) + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-line-up] + '("Line up thumbnails" . image-dired-line-up)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-rotate-thumbnail-left] + '("Rotate thumbnail left" . image-dired-rotate-thumbnail-left)) + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-rotate-thumbnail-right] + '("Rotate thumbnail right" . image-dired-rotate-thumbnail-right)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-rotate-original-left] + '("Rotate original left" . image-dired-rotate-original-left)) + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-rotate-original-right] + '("Rotate original right" . image-dired-rotate-original-right)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-toggle-movement-tracking] + '("Toggle movement tracking on/off" . image-dired-toggle-movement-tracking)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-jump-original-dired-buffer] + '("Jump to dired buffer" . image-dired-jump-original-dired-buffer)) + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-track-original-file] + '("Track original" . image-dired-track-original-file)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-flag-thumb-original-file] + '("Flag original for deletion" . image-dired-flag-thumb-original-file)) + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-unmark-thumb-original-file] + '("Unmark original" . image-dired-unmark-thumb-original-file)) + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-mark-thumb-original-file] + '("Mark original" . image-dired-mark-thumb-original-file)) + + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-thumbnail-display-external] + '("Display in external viewer" . image-dired-thumbnail-display-external)) + (define-key image-dired-thumbnail-mode-map + [menu-bar image-dired image-dired-display-thumbnail-original-image] + '("Display image" . image-dired-display-thumbnail-original-image))) + +(defvar image-dired-display-image-mode-map (make-sparse-keymap) + "Keymap for `image-dired-display-image-mode'.") + +(defun image-dired-define-display-image-mode-keymap () + "Define keymap for `image-dired-display-image-mode'." + + ;; Keys + (define-key image-dired-display-image-mode-map "q" 'image-dired-kill-buffer-and-window) + + (define-key image-dired-display-image-mode-map "f" + 'image-dired-display-current-image-full) + + (define-key image-dired-display-image-mode-map "s" + 'image-dired-display-current-image-sized) + + ;; Menu + (define-key image-dired-display-image-mode-map [menu-bar image-dired] + (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) + + (define-key image-dired-display-image-mode-map + [menu-bar image-dired image-dired-kill-buffer-and-window] + '("Quit" . image-dired-kill-buffer-and-window)) + + (define-key image-dired-display-image-mode-map + [menu-bar image-dired image-dired-display-current-image-sized] + '("Display original, sized to fit" . image-dired-display-current-image-sized)) + + (define-key image-dired-display-image-mode-map + [menu-bar image-dired image-dired-display-current-image-full] + '("Display original, full size" . image-dired-display-current-image-full)) + + ) + +(defun image-dired-display-current-image-full () + "Display current image in full size." + (interactive) + (let ((file (image-dired-original-file-name))) + (if file + (progn + (image-dired-display-image file t) + (message "Full size image displayed")) + (error "No original file name at point")))) + +(defun image-dired-display-current-image-sized () + "Display current image in sized to fit window dimensions." + (interactive) + (let ((file (image-dired-original-file-name))) + (if file + (progn + (image-dired-display-image file) + (message "Full size image displayed")) + (error "No original file name at point")))) + +(define-derived-mode image-dired-thumbnail-mode + fundamental-mode "image-dired-thumbnail" + "Browse and manipulate thumbnail images using dired. +Use `image-dired-dired' and `image-dired-setup-dired-keybindings' to get a +nice setup to start with." + (image-dired-define-thumbnail-mode-keymap) + (message "image-dired-thumbnail-mode enabled")) + +(define-derived-mode image-dired-display-image-mode + fundamental-mode "image-dired-image-display" + "Mode for displaying and manipulating original image. +Resized or in full-size." + (image-dired-define-display-image-mode-keymap) + (message "image-dired-display-image-mode enabled")) + +;;;###autoload +(defun image-dired-setup-dired-keybindings () + "Setup easy-to-use keybindings for the commands to be used in dired mode. +Note that n, p and <down> and <up> will be hijacked and bound to +`image-dired-dired-x-line'." + (interactive) + + ;; Hijack previous and next line movement. Let C-p and C-b be + ;; though... + + (define-key dired-mode-map "p" 'image-dired-dired-previous-line) + (define-key dired-mode-map "n" 'image-dired-dired-next-line) + (define-key dired-mode-map [up] 'image-dired-dired-previous-line) + (define-key dired-mode-map [down] 'image-dired-dired-next-line) + + (define-key dired-mode-map (kbd "C-S-n") 'image-dired-next-line-and-display) + (define-key dired-mode-map (kbd "C-S-p") 'image-dired-previous-line-and-display) + (define-key dired-mode-map (kbd "C-S-m") 'image-dired-mark-and-display-next) + + (define-key dired-mode-map "\C-td" 'image-dired-display-thumbs) + (define-key dired-mode-map "\C-tt" 'image-dired-tag-files) + (define-key dired-mode-map "\C-tr" 'image-dired-delete-tag) + (define-key dired-mode-map [tab] 'image-dired-jump-thumbnail-buffer) + (define-key dired-mode-map "\C-ti" 'image-dired-dired-display-image) + (define-key dired-mode-map "\C-tx" 'image-dired-dired-display-external) + (define-key dired-mode-map "\C-ta" 'image-dired-display-thumbs-append) + (define-key dired-mode-map "\C-t." 'image-dired-display-thumb) + (define-key dired-mode-map "\C-tc" 'image-dired-dired-comment-files) + (define-key dired-mode-map "\C-tf" 'image-dired-mark-tagged-files) + + ;; Menu for dired + (define-key dired-mode-map [menu-bar image-dired] + (cons "Image-Dired" (make-sparse-keymap "Image-Dired"))) + + (define-key dired-mode-map [menu-bar image-dired image-dired-copy-with-exif-file-name] + '("Copy with EXIF file name" . image-dired-copy-with-exif-file-name)) + + (define-key dired-mode-map [menu-bar image-dired image-dired-dired-comment-files] + '("Comment files" . image-dired-dired-comment-files)) + + (define-key dired-mode-map [menu-bar image-dired image-dired-mark-tagged-files] + '("Mark tagged files" . image-dired-mark-tagged-files)) + + (define-key dired-mode-map [menu-bar image-dired image-dired-delete-tag] + '("Remove tag from files" . image-dired-delete-tag)) + + (define-key dired-mode-map [menu-bar image-dired image-dired-tag-files] + '("Tag files" . image-dired-tag-files)) + + (define-key dired-mode-map [menu-bar image-dired image-dired-jump-thumbnail-buffer] + '("Jump to thumbnail buffer" . image-dired-jump-thumbnail-buffer)) + + (define-key dired-mode-map [menu-bar image-dired image-dired-toggle-movement-tracking] + '("Toggle movement tracking" . image-dired-toggle-movement-tracking)) + + (define-key dired-mode-map + [menu-bar image-dired image-dired-toggle-append-browsing] + '("Toggle append browsing" . image-dired-toggle-append-browsing)) + + (define-key dired-mode-map + [menu-bar image-dired image-dired-toggle-disp-props] + '("Toggle display properties" . image-dired-toggle-dired-display-properties)) + + (define-key dired-mode-map + [menu-bar image-dired image-dired-dired-display-external] + '("Display in external viewer" . image-dired-dired-display-external)) + (define-key dired-mode-map + [menu-bar image-dired image-dired-dired-display-image] + '("Display image" . image-dired-dired-display-image)) + (define-key dired-mode-map + [menu-bar image-dired image-dired-display-thumb] + '("Display this thumbnail" . image-dired-display-thumb)) + (define-key dired-mode-map + [menu-bar image-dired image-dired-display-thumbs-append] + '("Display thumbnails append" . image-dired-display-thumbs-append)) + (define-key dired-mode-map + [menu-bar image-dired image-dired-display-thumbs] + '("Display thumbnails" . image-dired-display-thumbs)) + + (define-key dired-mode-map + [menu-bar image-dired image-dired-create-thumbs] + '("Create thumbnails for marked files" . image-dired-create-thumbs)) + + (define-key dired-mode-map + [menu-bar image-dired image-dired-mark-and-display-next] + '("Mark and display next" . image-dired-mark-and-display-next)) + (define-key dired-mode-map + [menu-bar image-dired image-dired-previous-line-and-display] + '("Display thumb for previous file" . image-dired-previous-line-and-display)) + (define-key dired-mode-map + [menu-bar image-dired image-dired-next-line-and-display] + '("Display thumb for next file" . image-dired-next-line-and-display))) + +(defun image-dired-create-thumbs (&optional arg) + "Create thumbnail images for all marked files in dired. +With prefix argument ARG, create thumbnails even if they already exist +\(i.e. use this to refresh your thumbnails)." + (interactive "P") + (let (curr-file thumb-name files count) + (setq files (dired-get-marked-files)) + (mapcar + (lambda (curr-file) + (setq thumb-name (image-dired-thumb-name curr-file)) + ;; If the user overrides the exist check, we must clear the + ;; image cache so that if the user wants to display the + ;; thumnail, it is not fetched from cache. + (if arg + (clear-image-cache)) + (if (or (not (file-exists-p thumb-name)) + arg) + (if (not (= 0 (image-dired-create-thumb curr-file + (image-dired-thumb-name curr-file)))) + (error "Thumb could not be created")))) + files))) + +(defvar image-dired-slideshow-timer nil + "Slideshow timer.") + +(defvar image-dired-slideshow-count 0 + "Keeping track on number of images in slideshow.") + +(defvar image-dired-slideshow-times 0 + "Number of pictures to display in slideshow.") + +(defun image-dired-slideshow-step () + "Step to next file, if `image-dired-slideshow-times' has not been reached." + (if (< image-dired-slideshow-count image-dired-slideshow-times) + (progn + (message "%s" (1+ image-dired-slideshow-count)) + (setq image-dired-slideshow-count (1+ image-dired-slideshow-count)) + (image-dired-next-line-and-display)) + (image-dired-slideshow-stop))) + +(defun image-dired-slideshow-start () + "Start slideshow. +Ask user for number of images to show and the delay in between." + (interactive) + (setq image-dired-slideshow-count 0) + (setq image-dired-slideshow-times (string-to-number (read-string "How many: "))) + (let ((repeat (string-to-number + (read-string + "Delay, in seconds. Decimals are accepted : " "1")))) + (setq image-dired-slideshow-timer + (run-with-timer + 0 repeat + 'image-dired-slideshow-step)))) + +(defun image-dired-slideshow-stop () + "Cancel slideshow." + (interactive) + (cancel-timer image-dired-slideshow-timer)) + +(defun image-dired-delete-char () + "Remove current thumbnail from thumbnail buffer and line up." + (interactive) + (let ((inhibit-read-only t)) + (delete-char 1) + (if (looking-at " ") + (delete-char 1)))) + +;;;###autoload +(defun image-dired-display-thumbs-append () + "Append thumbnails to `image-dired-thumbnail-buffer'." + (interactive) + (image-dired-display-thumbs nil t t)) + +;;;###autoload +(defun image-dired-display-thumb () + "Shorthand for `image-dired-display-thumbs' with prefix argument." + (interactive) + (image-dired-display-thumbs t nil t)) + +(defun image-dired-line-up () + "Line up thumbnails according to `image-dired-thumbs-per-row'. +See also `image-dired-line-up-dynamic'." + (interactive) + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (while (and (not (image-dired-image-at-point-p)) + (not (eobp))) + (delete-char 1)) + (while (not (eobp)) + (forward-char) + (while (and (not (image-dired-image-at-point-p)) + (not (eobp))) + (delete-char 1))) + (goto-char (point-min)) + (let ((count 0)) + (while (not (eobp)) + (forward-char) + (if (= image-dired-thumbs-per-row 1) + (insert "\n") + (insert " ") + (setq count (1+ count)) + (when (and (= count (- image-dired-thumbs-per-row 1)) + (not (eobp))) + (forward-char) + (insert "\n") + (setq count 0))))) + (goto-char (point-min)))) + +(defun image-dired-line-up-dynamic () + "Line up thumbnails images dynamically. +Calculate how many thumbnails fit." + (interactive) + (let* ((char-width (frame-char-width)) + (width (image-dired-window-width-pixels (image-dired-thumbnail-window))) + (image-dired-thumbs-per-row + (/ width + (+ (* 2 image-dired-thumb-relief) + (* 2 image-dired-thumb-margin) + image-dired-thumb-width char-width)))) + (image-dired-line-up))) + +(defun image-dired-line-up-interactive () + "Line up thumbnails interactively. +Ask user how many thumbnails should be displayed per row." + (interactive) + (let ((image-dired-thumbs-per-row + (string-to-number (read-string "How many thumbs per row: ")))) + (if (not (> image-dired-thumbs-per-row 0)) + (message "Number must be greater than 0") + (image-dired-line-up)))) + +(defun image-dired-thumbnail-display-external () + "Display original image for thumbnail at point using external viewer." + (interactive) + (let ((file (image-dired-original-file-name))) + (if (not (image-dired-image-at-point-p)) + (message "No thumbnail at point") + (if (not file) + (message "No original file name found") + (call-process shell-file-name nil nil nil shell-command-switch + (format "%s \"%s\"" image-dired-external-viewer file)))))) + +;;;###autoload +(defun image-dired-dired-display-external () + "Display file at point using an external viewer." + (interactive) + (let ((file (dired-get-filename))) + (call-process shell-file-name nil nil nil shell-command-switch + (format "%s \"%s\"" image-dired-external-viewer file)))) + +(defun image-dired-window-width-pixels (window) + "Calculate WINDOW width in pixels." + (* (window-width window) (frame-char-width))) + +(defun image-dired-window-height-pixels (window) + "Calculate WINDOW height in pixels." + ;; Note: The mode-line consumes one line + (* (- (window-height window) 1) (frame-char-height))) + +(defun image-dired-display-window () + "Return window where `image-dired-display-image-buffer' is visible." + (get-window-with-predicate + (lambda (window) + (equal (buffer-name (window-buffer window)) image-dired-display-image-buffer)) + nil t)) + +(defun image-dired-thumbnail-window () + "Return window where `image-dired-thumbnail-buffer' is visible." + (get-window-with-predicate + (lambda (window) + (equal (buffer-name (window-buffer window)) image-dired-thumbnail-buffer)) + nil t)) + +(defun image-dired-associated-dired-buffer-window () + "Return window where associated dired buffer is visible." + (let (buf) + (if (image-dired-image-at-point-p) + (progn + (setq buf (image-dired-associated-dired-buffer)) + (get-window-with-predicate + (lambda (window) + (equal (window-buffer window) buf)))) + (error "No thumbnail image at point")))) + +(defun image-dired-display-window-width () + "Return width, in pixels, of image-dired's image display window." + (- (image-dired-window-width-pixels (image-dired-display-window)) + image-dired-display-window-width-correction)) + +(defun image-dired-display-window-height () + "Return height, in pixels, of image-dired's image display window." + (- (image-dired-window-height-pixels (image-dired-display-window)) + image-dired-display-window-height-correction)) + +(defun image-dired-display-image (file &optional original-size) + "Display image FILE in image buffer. +Use this when you want to display the image, semi sized, in a new +window. The image is sized to fit the display window (using a +temporary file, don't worry). Because of this, it will not be as +quick as opening it directly, but on most modern systems it +should feel snappy enough. + +If optional argument ORIGINAL-SIZE is non-nil, display image in its +original size." + (let ((new-file (expand-file-name image-dired-temp-image-file)) + width height command ret) + (setq file (expand-file-name file)) + (if (not original-size) + (progn + (setq width (image-dired-display-window-width)) + (setq height (image-dired-display-window-height)) + (setq command + (format-spec + image-dired-cmd-create-temp-image-options + (list + (cons ?p image-dired-cmd-create-temp-image-program) + (cons ?w width) + (cons ?h height) + (cons ?f file) + (cons ?t new-file)))) + (setq ret (call-process shell-file-name nil nil nil + shell-command-switch command)) + (if (not (= 0 ret)) + (error "Could not resize image"))) + (copy-file file new-file t)) + (with-current-buffer (image-dired-create-display-image-buffer) + (let ((inhibit-read-only t)) + (erase-buffer) + (clear-image-cache) + (image-dired-insert-image image-dired-temp-image-file 'jpeg 0 0) + (goto-char (point-min)) + (image-dired-update-property 'original-file-name file))))) + +(defun image-dired-display-thumbnail-original-image (&optional arg) + "Display current thumbnail's original image in display buffer. +See documentation for `image-dired-display-image' for more information. +With prefix argument ARG, display image in its original size." + (interactive "P") + (let ((file (image-dired-original-file-name))) + (if (not (string-equal major-mode "image-dired-thumbnail-mode")) + (message "Not in image-dired-thumbnail-mode") + (if (not (image-dired-image-at-point-p)) + (message "No thumbnail at point") + (if (not file) + (message "No original file name found") + (image-dired-create-display-image-buffer) + (display-buffer image-dired-display-image-buffer) + (image-dired-display-image file arg)))))) + + +;;;###autoload +(defun image-dired-dired-display-image (&optional arg) + "Display current image file. +See documentation for `image-dired-display-image' for more information. +With prefix argument ARG, display image in its original size." + (interactive "P") + (image-dired-create-display-image-buffer) + (display-buffer image-dired-display-image-buffer) + (image-dired-display-image (dired-get-filename) arg)) + +(defun image-dired-image-at-point-p () + "Return true if there is a image-dired thumbnail at point." + (get-text-property (point) 'image-dired-thumbnail)) + +(defun image-dired-rotate-thumbnail (degrees) + "Rotate thumbnail DEGREES degrees." + (if (not (image-dired-image-at-point-p)) + (message "No thumbnail at point") + (let ((file (image-dired-thumb-name (image-dired-original-file-name))) + command) + (setq command (format-spec + image-dired-cmd-rotate-thumbnail-options + (list + (cons ?p image-dired-cmd-rotate-thumbnail-program) + (cons ?d degrees) + (cons ?t (expand-file-name file))))) + (call-process shell-file-name nil nil nil shell-command-switch command) + ;; Clear the cache to refresh image. I wish I could just refresh + ;; the current file but I do not know how to do that. Yet... + (clear-image-cache)))) + +(defun image-dired-rotate-thumbnail-left () + "Rotate thumbnail left (counter clockwise) 90 degrees. +The result of the rotation is displayed in the image display area +and a confirmation is needed before the original image files is +overwritten. This confirmation can be turned off using +`image-dired-rotate-original-ask-before-overwrite'." + (interactive) + (image-dired-rotate-thumbnail "270")) + +(defun image-dired-rotate-thumbnail-right () + "Rotate thumbnail counter right (clockwise) 90 degrees. +The result of the rotation is displayed in the image display area +and a confirmation is needed before the original image files is +overwritten. This confirmation can be turned off using +`image-dired-rotate-original-ask-before-overwrite'." + (interactive) + (image-dired-rotate-thumbnail "90")) + +(defun image-dired-refresh-thumb () + "Force creation of new image for current thumbnail." + (interactive) + (let ((file (image-dired-original-file-name))) + (clear-image-cache) + (image-dired-create-thumb file (image-dired-thumb-name file)))) + +(defun image-dired-rotate-original (degrees) + "Rotate original image DEGREES degrees." + (if (not (image-dired-image-at-point-p)) + (message "No image at point") + (let ((file (image-dired-original-file-name)) + command temp-file) + (if (not (string-match "\.[jJ][pP[eE]?[gG]$" file)) + (error "Only JPEG images can be rotated!")) + (setq command (format-spec + image-dired-cmd-rotate-original-options + (list + (cons ?p image-dired-cmd-rotate-original-program) + (cons ?d degrees) + (cons ?o (expand-file-name file)) + (cons ?t image-dired-temp-rotate-image-file)))) + (if (not (= 0 (call-process shell-file-name nil nil nil + shell-command-switch command))) + (error "Could not rotate image") + (image-dired-display-image image-dired-temp-rotate-image-file) + (if (or (and image-dired-rotate-original-ask-before-overwrite + (y-or-n-p + "Rotate to temp file OK. Overwrite original image? ")) + (not image-dired-rotate-original-ask-before-overwrite)) + (progn + (copy-file image-dired-temp-rotate-image-file file t) + (image-dired-refresh-thumb)) + (image-dired-display-image file)))))) + +(defun image-dired-rotate-original-left () + "Rotate original image left (counter clockwise) 90 degrees." + (interactive) + (image-dired-rotate-original "270")) + +(defun image-dired-rotate-original-right () + "Rotate original image right (clockwise) 90 degrees." + (interactive) + (image-dired-rotate-original "90")) + +(defun image-dired-get-exif-file-name (file) + "Use the image's EXIF information to return a unique file name. +The file name should be unique as long as you do not take more than +one picture per second. The original file name is suffixed at the end +for traceability. The format of the returned file name is +YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from +`image-dired-copy-with-exif-file-name'." + (let (data no-exif-data-found) + (if (not (string-match "\.[Jj][Pp][Ee]?[Gg]$" (expand-file-name file))) + (progn + (setq no-exif-data-found t) + (setq data + (format-time-string + "%Y:%m:%d %H:%M:%S" + (nth 5 (file-attributes (expand-file-name file)))))) + (setq data (image-dired-get-exif-data (expand-file-name file) + "DateTimeOriginal"))) + (while (string-match "[ :]" data) + (setq data (replace-match "_" nil nil data))) + (format "%s%s%s" data + (if no-exif-data-found + "_noexif_" + "_") + (file-name-nondirectory file)))) + +(defun image-dired-thumbnail-set-image-description () + "Set the ImageDescription EXIF tag for the original image. +If the image already has a value for this tag, it is used as the +default value at the prompt." + (interactive) + (if (not (image-dired-image-at-point-p)) + (message "No thumbnail at point") + (let* ((file (image-dired-original-file-name)) + (old-value (image-dired-get-exif-data file "ImageDescription"))) + (if (eq 0 + (image-dired-set-exif-data file "ImageDescription" + (read-string "Value of ImageDescription: " + old-value))) + (message "Successfully wrote ImageDescription tag.") + (error "Could not write ImageDescription tag"))))) + +(defun image-dired-set-exif-data (file tag-name tag-value) + "In FILE, set EXIF tag TAG-NAME to value TAG-VALUE." + (let (command) + (setq command (format-spec + image-dired-cmd-write-exif-data-options + (list + (cons ?p image-dired-cmd-write-exif-data-program) + (cons ?f (expand-file-name file)) + (cons ?t tag-name) + (cons ?v tag-value)))) + (call-process shell-file-name nil nil nil shell-command-switch command))) + +(defun image-dired-get-exif-data (file tag-name) + "From FILE, return EXIF tag TAG-NAME." + (let ((buf (get-buffer-create "*image-dired-get-exif-data*")) + command tag-value) + (setq command (format-spec + image-dired-cmd-read-exif-data-options + (list + (cons ?p image-dired-cmd-read-exif-data-program) + (cons ?f file) + (cons ?t tag-name)))) + (with-current-buffer buf + (delete-region (point-min) (point-max)) + (if (not (eq (call-process shell-file-name nil t nil + shell-command-switch command) 0)) + (error "Could not get EXIF tag") + (goto-char (point-min)) + ;; Clean buffer from newlines and carriage returns before + ;; getting final info + (while (search-forward-regexp "[\n\r]" nil t) + (replace-match "" nil t)) + (setq tag-value (buffer-substring (point-min) (point-max))))) + tag-value)) + +(defun image-dired-copy-with-exif-file-name () + "Copy file with unique name to main image directory. +Copy current or all marked files in dired to a new file in your +main image directory, using a file name generated by +`image-dired-get-exif-file-name'. A typical usage for this if when +copying images from a digital camera into the image directory. + + Typically, you would open up the folder with the incoming +digital images, mark the files to be copied, and execute this +function. The result is a couple of new files in +`image-dired-main-image-directory' called +2005_05_08_12_52_00_dscn0319.jpg, +2005_05_08_14_27_45_dscn0320.jpg etc." + (interactive) + (let (new-name + (files (dired-get-marked-files))) + (mapcar + (lambda (curr-file) + (setq new-name + (format "%s/%s" + (file-name-as-directory + (expand-file-name image-dired-main-image-directory)) + (image-dired-get-exif-file-name curr-file))) + (message "Copying %s to %s" curr-file new-name) + (copy-file curr-file new-name)) + files))) + +(defun image-dired-display-next-thumbnail-original () + "In thubnail buffer, move to next thumbnail and display the image." + (interactive) + (image-dired-forward-image) + (image-dired-display-thumbnail-original-image)) + +(defun image-dired-display-previous-thumbnail-original () + "Move to previous thumbnail and display image." + (interactive) + (image-dired-backward-image) + (image-dired-display-thumbnail-original-image)) + +(defun image-dired-write-comments (file-comments) + "Write file comments to database. +Write file comments to one or more files. FILE-COMMENTS is an alist on +the following form: + ((FILE . COMMENT) ... )" + (let (end comment-beg-pos comment-end-pos file comment) + (with-temp-file image-dired-db-file + (insert-file-contents image-dired-db-file) + (dolist (elt file-comments) + (setq file (car elt) + comment (cdr elt)) + (goto-char (point-min)) + (if (search-forward-regexp (format "^%s.*$" file) nil t) + (progn + (setq end (point)) + (beginning-of-line) + ;; Delete old comment, if any + (when (search-forward ";comment:" end t) + (setq comment-beg-pos (match-beginning 0)) + ;; Any tags after the comment? + (if (search-forward ";" end t) + (setq comment-end-pos (- (point) 1)) + (setq comment-end-pos end)) + ;; Delete comment tag and comment + (delete-region comment-beg-pos comment-end-pos)) + ;; Insert new comment + (beginning-of-line) + (unless (search-forward ";" end t) + (end-of-line) + (insert ";")) + (insert (format "comment:%s;" comment))) + ;; File does not exist in database - add it. + (goto-char (point-max)) + (insert (format "\n%s;comment:%s" file comment))))))) + +(defun image-dired-update-property (prop value) + "Update text property PROP with value VALUE at point." + (let ((inhibit-read-only t)) + (put-text-property + (point) (1+ (point)) + prop + value))) + +;;;###autoload +(defun image-dired-dired-comment-files () + "Add comment to current or marked files in dired." + (interactive) + (let ((comment (image-dired-read-comment))) + (image-dired-write-comments + (mapcar + (lambda (curr-file) + (cons curr-file comment)) + (dired-get-marked-files))))) + +(defun image-dired-comment-thumbnail () + "Add comment to current thumbnail in thumbnail buffer." + (interactive) + (let* ((file (image-dired-original-file-name)) + (comment (image-dired-read-comment file))) + (image-dired-write-comments (list (cons file comment))) + (image-dired-update-property 'comment comment)) + (image-dired-display-thumb-properties)) + +(defun image-dired-read-comment (&optional file) + "Read comment for an image. +Read comment for an image, optionally using old comment from FILE +as initial value." + (let ((comment + (read-string + "Comment: " + (if file (image-dired-get-comment file))))) + comment)) + +(defun image-dired-get-comment (file) + "Get comment for file FILE." + (save-excursion + (let (end buf comment-beg-pos comment-end-pos comment) + (setq buf (find-file image-dired-db-file)) + (goto-char (point-min)) + (when (search-forward-regexp + (format "^%s" file) nil t) + (end-of-line) + (setq end (point)) + (beginning-of-line) + (cond ((search-forward ";comment:" end t) + (setq comment-beg-pos (point)) + (if (search-forward ";" end t) + (setq comment-end-pos (- (point) 1)) + (setq comment-end-pos end)) + (setq comment (buffer-substring + comment-beg-pos comment-end-pos))))) + (kill-buffer buf) + comment))) + +;;;###autoload +(defun image-dired-mark-tagged-files () + "Use regexp to mark files with matching tag. +A `tag' is a keyword, a piece of meta data, associated with an +image file and stored in image-dired's database file. This command +lets you input a regexp and this will be matched against all tags +on all image files in the database file. The files that have a +matching tags will be marked in the dired buffer." + (interactive) + (let ((tag (read-string "Mark tagged files (regexp): ")) + (hits 0) + files buf) + (save-excursion + (setq buf (find-file image-dired-db-file)) + (goto-char (point-min)) + ;; Collect matches + (while (search-forward-regexp + (concat "\\(^[^;\n]+\\);.*" tag ".*$") nil t) + (setq files (append (list (match-string 1)) files))) + (kill-buffer buf) + ;; Mark files + (mapcar + ;; I tried using `dired-mark-files-regexp' but it was + ;; waaaay to slow. + (lambda (curr-file) + ;; Don't bother about hits found in other directories than + ;; the current one. + (when (string= (file-name-as-directory + (expand-file-name default-directory)) + (file-name-as-directory + (file-name-directory curr-file))) + (setq curr-file (file-name-nondirectory curr-file)) + (goto-char (point-min)) + (when (search-forward-regexp (format "\\s %s$" curr-file) nil t) + (setq hits (+ hits 1)) + (dired-mark 1)))) + files)) + (message "%d files with matching tag marked." hits))) + +(defun image-dired-mouse-display-image (event) + "Use mouse EVENT, call `image-dired-display-image' to display image. +Track this in associated dired buffer if `image-dired-track-movement' is +non-nil." + (interactive "e") + (let (file) + (mouse-set-point event) + (goto-char (posn-point (event-end event))) + (setq file (image-dired-original-file-name)) + (if image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-create-display-image-buffer) + (display-buffer image-dired-display-image-buffer) + (image-dired-display-image file))) + +(defun image-dired-mouse-select-thumbnail (event) + "Use mouse EVENT to select thumbnail image. +Track this in associated dired buffer if `image-dired-track-movement' is +non-nil." + (interactive "e") + (let (file) + (mouse-set-point event) + (goto-char (posn-point (event-end event))) + (if image-dired-track-movement + (image-dired-track-original-file))) + (image-dired-display-thumb-properties)) + +(defun image-dired-mouse-toggle-mark (event) + "Use mouse EVENT to toggle dired mark for thumbnail. +Track this in associated dired buffer if `image-dired-track-movement' is +non-nil." + (interactive "e") + (let (file) + (mouse-set-point event) + (goto-char (posn-point (event-end event))) + (if image-dired-track-movement + (image-dired-track-original-file))) + (image-dired-toggle-mark-thumb-original-file)) + +(defun image-dired-dired-display-properties () + "Display properties for dired file in the echo area." + (interactive) + (let* ((file (dired-get-filename)) + (file-name (file-name-nondirectory file)) + (dired-buf (buffer-name (current-buffer))) + (props (mapconcat + 'princ + (image-dired-list-tags file) + ", ")) + (comment (image-dired-get-comment file))) + (if file-name + (message + (image-dired-format-properties-string + dired-buf + file-name + props + comment))))) + +(defvar image-dired-tag-file-list nil + "List to store tag-file structure.") + +(defvar image-dired-file-tag-list nil + "List to store file-tag structure.") + +(defvar image-dired-file-comment-list nil + "List to store file comments.") + +(defun image-dired-add-to-tag-file-list (tag file) + "Add relation between TAG and FILE." + (let (curr) + (if image-dired-tag-file-list + (if (setq curr (assoc tag image-dired-tag-file-list)) + (if (not (member file curr)) + (setcdr curr (cons file (cdr curr)))) + (setcdr image-dired-tag-file-list + (cons (list tag file) (cdr image-dired-tag-file-list)))) + (setq image-dired-tag-file-list (list (list tag file)))))) + +(defun image-dired-add-to-tag-file-lists (tag file) + "Helper function used from `image-dired-create-gallery-lists'. + +Add TAG to FILE in one list and FILE to TAG in the other. + +Lisp structures look like the following: + +image-dired-file-tag-list: + + ((\"filename1\" \"tag1\" \"tag2\" \"tag3\" ...) + (\"filename2\" \"tag1\" \"tag2\" \"tag3\" ...) + ...) + +image-dired-tag-file-list: + + ((\"tag1\" \"filename1\" \"filename2\" \"filename3\" ...) + (\"tag2\" \"filename1\" \"filename2\" \"filename3\" ...) + ...)" + ;; Add tag to file list + (let (curr) + (if image-dired-file-tag-list + (if (setq curr (assoc file image-dired-file-tag-list)) + (setcdr curr (cons tag (cdr curr))) + (setcdr image-dired-file-tag-list + (cons (list file tag) (cdr image-dired-file-tag-list)))) + (setq image-dired-file-tag-list (list (list file tag)))) + ;; Add file to tag list + (if image-dired-tag-file-list + (if (setq curr (assoc tag image-dired-tag-file-list)) + (if (not (member file curr)) + (setcdr curr (cons file (cdr curr)))) + (setcdr image-dired-tag-file-list + (cons (list tag file) (cdr image-dired-tag-file-list)))) + (setq image-dired-tag-file-list (list (list tag file)))))) + +(defun image-dired-add-to-file-comment-list (file comment) + "Helper function used from `image-dired-create-gallery-lists'. + +For FILE, add COMMENT to list. + +Lisp structure looks like the following: + +image-dired-file-comment-list: + + ((\"filename1\" . \"comment1\") + (\"filename2\" . \"comment2\") + ...)" + (if image-dired-file-comment-list + (if (not (assoc file image-dired-file-comment-list)) + (setcdr image-dired-file-comment-list + (cons (cons file comment) + (cdr image-dired-file-comment-list)))) + (setq image-dired-file-comment-list (list (cons file comment))))) + +(defun image-dired-create-gallery-lists () + "Create temporary lists used by `image-dired-gallery-generate'." + (let ((buf (find-file image-dired-db-file)) + end beg file row-tags) + (setq image-dired-tag-file-list nil) + (setq image-dired-file-tag-list nil) + (setq image-dired-file-comment-list nil) + (goto-char (point-min)) + (while (search-forward-regexp "^." nil t) + (end-of-line) + (setq end (point)) + (beginning-of-line) + (setq beg (point)) + (if (not (search-forward ";" end nil)) + (error "Something is really wrong, check format of database")) + (setq row-tags (split-string + (buffer-substring beg end) ";")) + (setq file (car row-tags)) + (mapc + (lambda (x) + (if (not (string-match "^comment:\\(.*\\)" x)) + (image-dired-add-to-tag-file-lists x file) + (image-dired-add-to-file-comment-list file (match-string 1 x)))) + (cdr row-tags))) + (kill-buffer buf)) + ;; Sort tag-file list + (setq image-dired-tag-file-list + (sort image-dired-tag-file-list + (lambda (x y) + (string< (car x) (car y)))))) + +(defun image-dired-hidden-p (file) + "Return t if image FILE has a \"hidden\" tag." + (let (hidden) + (mapc + (lambda (tag) + (if (member tag image-dired-gallery-hidden-tags) + (setq hidden t))) + (cdr (assoc file image-dired-file-tag-list))) + hidden)) + +(defun image-dired-gallery-generate () + "Generate gallery pages. +First we create a couple of Lisp structures from the database to make +it easier to generate, then HTML-files are created in +`image-dired-gallery-dir'" + (interactive) + (if (eq 'per-directory image-dired-thumbnail-storage) + (error "Currently, gallery generation is not supported \ +when using per-directory thumbnail file storage")) + (image-dired-create-gallery-lists) + (let ((tags image-dired-tag-file-list) + count curr tag index-buf tag-buf + comment file-tags tag-link tag-link-list) + ;; Make sure gallery root exist + (if (file-exists-p image-dired-gallery-dir) + (if (not (file-directory-p image-dired-gallery-dir)) + (error "Variable image-dired-gallery-dir is not a directory")) + (make-directory image-dired-gallery-dir)) + ;; Open index file + (setq index-buf (find-file + (format "%s/index.html" image-dired-gallery-dir))) + (erase-buffer) + (insert "<html>\n") + (insert " <body>\n") + (insert " <h2>Image-Dired Gallery</h2>\n") + (insert (format "<p>\n Gallery generated %s\n <p>\n" + (current-time-string))) + (insert " <h3>Tag index</h3>\n") + (setq count 1) + ;; Pre-generate list of all tag links + (mapc + (lambda (curr) + (setq tag (car curr)) + (when (not (member tag image-dired-gallery-hidden-tags)) + (setq tag-link (format "<a href=\"%d.html\">%s</a>" count tag)) + (if tag-link-list + (setq tag-link-list + (append tag-link-list (list (cons tag tag-link)))) + (setq tag-link-list (list (cons tag tag-link)))) + (setq count (1+ count)))) + tags) + (setq count 1) + ;; Main loop where we generated thumbnail pages per tag + (mapc + (lambda (curr) + (setq tag (car curr)) + ;; Don't display hidden tags + (when (not (member tag image-dired-gallery-hidden-tags)) + ;; Insert link to tag page in index + (insert (format " %s<br>\n" (cdr (assoc tag tag-link-list)))) + ;; Open per-tag file + (setq tag-buf (find-file + (format "%s/%s.html" image-dired-gallery-dir count))) + (erase-buffer) + (insert "<html>\n") + (insert " <body>\n") + (insert " <p><a href=\"index.html\">Index</a></p>\n") + (insert (format " <h2>Images with tag "%s"</h2>" tag)) + ;; Main loop for files per tag page + (mapc + (lambda (file) + (when (not (image-dired-hidden-p file)) + ;; Insert thumbnail with link to full image + (insert + (format "<a href=\"%s/%s\"><img src=\"%s/%s\"%s></a>\n" + image-dired-gallery-image-root-url + (file-name-nondirectory file) + image-dired-gallery-thumb-image-root-url + (file-name-nondirectory (image-dired-thumb-name file)) file)) + ;; Insert comment, if any + (if (setq comment (cdr (assoc file image-dired-file-comment-list))) + (insert (format "<br>\n%s<br>\n" comment)) + (insert "<br>\n")) + ;; Insert links to other tags, if any + (when (> (length + (setq file-tags (assoc file image-dired-file-tag-list))) 2) + (insert "[ ") + (mapc + (lambda (extra-tag) + ;; Only insert if not file name or the main tag + (if (and (not (equal extra-tag tag)) + (not (equal extra-tag file))) + (insert + (format "%s " (cdr (assoc extra-tag tag-link-list)))))) + file-tags) + (insert "]<br>\n")))) + (cdr curr)) + (insert " <p><a href=\"index.html\">Index</a></p>\n") + (insert " </body>\n") + (insert "</html>\n") + (save-buffer) + (kill-buffer tag-buf) + (setq count (1+ count)))) + tags) + (insert " </body>\n") + (insert "</html>") + (save-buffer) + (kill-buffer index-buf))) + +(defun image-dired-kill-buffer-and-window () + "Kill the current buffer and, if possible, also the window." + (interactive) + (let ((buffer (current-buffer))) + (condition-case nil + (delete-window (selected-window)) + (error nil)) + (kill-buffer buffer))) + +(defvar image-dired-widget-list nil + "List to keep track of meta data in edit buffer.") + +;;;###autoload +(defun image-dired-dired-edit-comment-and-tags () + "Edit comment and tags of current or marked image files. +Edit comment and tags for all marked image files in an +easy-to-use form." + (interactive) + (setq image-dired-widget-list nil) + ;; Setup buffer. + (let ((files (dired-get-marked-files))) + (switch-to-buffer "*Image-Dired Edit Meta Data*") + (kill-all-local-variables) + (make-local-variable 'widget-example-repeat) + (let ((inhibit-read-only t)) + (erase-buffer)) + (remove-overlays) + ;; Some help for the user. + (widget-insert +"\nEdit comments and tags for each image. Separate multiple tags +with a comma. Move forward between fields using TAB or RET. +Move to the previous field using backtab (S-TAB). Save by +activating the Save button at the bottom of the form or cancel +the operation by activating the Cancel button.\n\n") + ;; Here comes all images and a comment and tag field for each + ;; image. + (let (thumb-file img comment-widget tag-widget) + + (dolist (file files) + + (setq thumb-file (image-dired-thumb-name file) + img (create-image thumb-file)) + + (insert-image img) + (widget-insert "\n\nComment: ") + (setq comment-widget + (widget-create 'editable-field + :size 60 + :format "%v " + :value (or (image-dired-get-comment file) ""))) + (widget-insert "\nTags: ") + (setq tag-widget + (widget-create 'editable-field + :size 60 + :format "%v " + :value (or (mapconcat + (lambda (tag) + tag) + (image-dired-list-tags file) + ",") ""))) + ;; Save information in all widgets so that we can use it when + ;; the user saves the form. + (setq image-dired-widget-list + (append image-dired-widget-list + (list (list file comment-widget tag-widget)))) + (widget-insert "\n\n"))) + + ;; Footer with Save and Cancel button. + (widget-insert "\n") + (widget-create 'push-button + :notify + (lambda (&rest ignore) + (image-dired-save-information-from-widgets) + (bury-buffer) + (message "Done.")) + "Save") + (widget-insert " ") + (widget-create 'push-button + :notify + (lambda (&rest ignore) + (bury-buffer) + (message "Operation canceled.")) + "Cancel") + (widget-insert "\n") + (use-local-map widget-keymap) + (widget-setup) + ;; Jump to the first widget. + (widget-forward 1))) + +(defun image-dired-save-information-from-widgets () + "Save information found in `image-dired-widget-list'. +Use the information in `image-dired-widget-list' to save comments and +tags to their respective image file. Internal function used by +`image-dired-dired-edit-comment-and-tags'." + (let (file comment tag-string tag-list lst) + (image-dired-write-comments + (mapcar + (lambda (widget) + (setq file (car widget) + comment (widget-value (cadr widget))) + (cons file comment)) + image-dired-widget-list)) + (image-dired-write-tags + (dolist (widget image-dired-widget-list lst) + (setq file (car widget) + tag-string (widget-value (car (cddr widget))) + tag-list (split-string tag-string ",")) + (dolist (tag tag-list) + (push (cons file tag) lst)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;; TEST-SECTION ;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (defvar image-dired-dir-max-size 12300000) + +;; (defun image-dired-test-clean-old-files () +;; "Clean `image-dired-dir' from old thumbnail files. +;; \"Oldness\" measured using last access time. If the total size of all +;; thumbnail files in `image-dired-dir' is larger than 'image-dired-dir-max-size', +;; old files are deleted until the max size is reached." +;; (let* ((files +;; (sort +;; (mapcar +;; (lambda (f) +;; (let ((fattribs (file-attributes f))) +;; ;; Get last access time and file size +;; `(,(nth 4 fattribs) ,(nth 7 fattribs) ,f))) +;; (directory-files (image-dired-dir) t ".+\.thumb\..+$")) +;; ;; Sort function. Compare time between two files. +;; '(lambda (l1 l2) +;; (time-less-p (car l1) (car l2))))) +;; (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files)))) +;; (while (> dirsize image-dired-dir-max-size) +;; (y-or-n-p +;; (format "Size of thumbnail directory: %d, delete old file %s? " +;; dirsize (cadr (cdar files)))) +;; (delete-file (cadr (cdar files))) +;; (setq dirsize (- dirsize (car (cdar files)))) +;; (setq files (cdr files))))) + +;;;;;;;;;;;;;;;;;;;;;;, + +;; (defun dired-speedbar-buttons (dired-buffer) +;; (when (and (boundp 'image-dired-use-speedbar) +;; image-dired-use-speedbar) +;; (let ((filename (with-current-buffer dired-buffer +;; (dired-get-filename)))) +;; (when (and (not (string-equal filename (buffer-string))) +;; (string-match (image-file-name-regexp) filename)) +;; (erase-buffer) +;; (insert (propertize +;; filename +;; 'display +;; (image-dired-get-thumbnail-image filename))))))) + +;; (setq image-dired-use-speedbar t) + +(provide 'image-dired) + +;; arch-tag: 9d11411d-331f-4380-8b44-8adfe3a0343e +;;; image-dired.el ends here |