;;; image-dired.el --- use dired to browse and manipulate your images
;;
-;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
;;
;; Version: 0.4.11
;; Keywords: multimedia
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
(require 'widget)
(eval-when-compile
+ (require 'cl)
(require 'wid-edit))
(defgroup image-dired nil
:prefix "image-dired-"
:group 'multimedia)
-(defcustom image-dired-dir (concat user-emacs-directory "image-dired/")
+(defcustom image-dired-dir (locate-user-emacs-file "image-dired/")
"Directory where thumbnail images are stored."
:type 'string
:group 'image-dired)
:group 'image-dired)
(defcustom image-dired-db-file
- (concat user-emacs-directory "image-dired/.image-dired_db")
+ (expand-file-name ".image-dired_db" image-dired-dir)
"Database file where file names and their associated tags are stored."
:type 'string
:group 'image-dired)
(defcustom image-dired-temp-image-file
- (concat user-emacs-directory "image-dired/.image-dired_temp")
+ (expand-file-name ".image-dired_temp" image-dired-dir)
"Name of temporary image file used by various commands."
:type 'string
:group 'image-dired)
(defcustom image-dired-gallery-dir
- (concat user-emacs-directory "image-dired/.image-dired_gallery")
+ (expand-file-name ".image-dired_gallery" image-dired-dir)
"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."
:group 'image-dired)
(defcustom image-dired-cmd-create-thumbnail-options
- "%p -size %wx%h \"%f\" -resize %wx%h -strip jpeg:\"%t\""
+ "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip 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
:group 'image-dired)
(defcustom image-dired-cmd-create-temp-image-options
- "%p -size %wx%h \"%f\" -resize %wx%h -strip jpeg:\"%t\""
+ "%p -size %wx%h \"%f\" -resize \"%wx%h>\" -strip 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
"-set \"Thumb::URI\" \"file://%f\" "
"-set \"Description\" \"Thumbnail of file://%f\" "
"-set \"Software\" \"" (emacs-version) "\" "))
- "-thumbnail %wx%h png:\"%t\""
+ "-thumbnail \"%wx%h>\" png:\"%t\""
(if image-dired-cmd-pngnq-program
(concat
" ; " image-dired-cmd-pngnq-program " -f \"%t\""
:group 'image-dired)
(defcustom image-dired-temp-rotate-image-file
- (concat user-emacs-directory "image-dired/.image-dired_rotate_temp")
+ (expand-file-name ".image-dired_rotate_temp" image-dired-dir)
"Temporary file for rotate operations."
:type 'string
:group 'image-dired)
"%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
+`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-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'."
+This is the default size for both `image-dired-thumb-width'
+and `image-dired-thumb-height'."
: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."
+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)
: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'.
+ "Maximum number of files to show using `image-dired-show-all-from-dir'
before warning the user."
:type 'integer
:group 'image-dired)
(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)
+(defun image-dired-dired-toggle-marked-thumbs (&optional arg)
+ "Toggle thumbnails in front of file names in the dired buffer.
+If no marked file could be found, insert or hide thumbnails on the
+current line. ARG, if non-nil, specifies the files to use instead
+of the marked files. If ARG is an integer, use the next ARG (or
+previous -ARG, if ARG<0) files."
+ (interactive "P")
(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))
+ (let* ((image-pos (dired-move-to-filename))
+ (image-file (dired-get-filename nil t))
+ thumb-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)
+ (when (and image-file (string-match-p (image-file-name-regexp) image-file))
+ (setq thumb-file (image-dired-get-thumbnail-image image-file))
+ ;; If image is not already added, then add it.
+ (let ((cur-ov (overlays-in (point) (1+ (point)))))
+ (if cur-ov
+ (delete-overlay (car cur-ov))
+ (put-image thumb-file image-pos)
+ (setq overlay (loop for o in (overlays-in (point) (1+ (point)))
+ when (overlay-get o 'put-image) collect o into ov
+ finally return (car ov)))
+ (overlay-put overlay 'image-file image-file)
+ (overlay-put overlay 'thumb-file thumb-file)))))
+ arg ; Show or hide image on ARG next files.
+ 'show-progress) ; Update dired display after each image is updated.
(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.
+Move them to their corresponding files if they still exist.
Otherwise, delete overlays."
(mapc (lambda (overlay)
(when (overlay-get overlay 'put-image)
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
+Optional 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
(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:
+Write each file and tag in FILE-TAGS to the database.
+FILE-TAGS is an alist in the following form:
((FILE . TAG) ... )"
(image-dired-sane-db-file)
(let (end file tag)
;; If on empty line at end of buffer
(when (and (eobp)
(looking-at "^$"))
- (delete-backward-char 1))))))
+ (delete-char -1))))))
files)
(save-buffer)
(kill-buffer buf))))
(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."
+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))
+ (if (not (dired-goto-file file-name))
(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-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."
+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)
(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."
+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
(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."
+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
(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
+name, PROPS is a list of tags and COMMENT is the image file's
comment."
(format-spec
image-dired-display-properties-format
(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
+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))
(message "No image, or image with correct properties, at point.")
(with-current-buffer dired-buf
(message "%s" file-name)
- (setq file-name (file-name-nondirectory file-name))
- (goto-char (point-min))
- (if (search-forward file-name nil t)
+ (if (dired-goto-file file-name)
(cond ((eq command 'mark) (dired-mark 1))
((eq command 'unmark) (dired-unmark 1))
((eq command 'toggle)
[menu-bar image-dired image-dired-next-line-and-display]
'("Display thumb for next file" . image-dired-next-line-and-display)))
+(declare-function clear-image-cache "image.c" (&optional filter))
+
(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)."
+\(i.e. use this to refresh your thumbnails)."
(interactive "P")
(let (curr-file thumb-name files count)
(setq files (dired-get-marked-files))
(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:
+Write file comments to one or more files.
+FILE-COMMENTS is an alist on the following form:
((FILE . COMMENT) ... )"
(image-dired-sane-db-file)
(let (end comment-beg-pos comment-end-pos file comment)
(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."
+Optionally use old comment from FILE as initial value."
(let ((comment
(read-string
"Comment: "
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."
+matching tag will be marked in the dired buffer."
(interactive)
(image-dired-sane-db-file)
(let ((tag (read-string "Mark tagged files (regexp): "))
"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'"
+`image-dired-gallery-dir'."
(interactive)
(if (eq 'per-directory image-dired-thumbnail-storage)
(error "Currently, gallery generation is not supported \
(provide 'image-dired)
-;; arch-tag: 9d11411d-331f-4380-8b44-8adfe3a0343e
;;; image-dired.el ends here
HCoop / bpt / emacs.git / blobdiff