X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6f8a87c027ebd6f9cfdac5c0df97d651227bec62..838d78d411955dbe3ef5d75ff404ced8ca832c5a:/lisp/image-dired.el
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index d520d99ea1..7b0a55de22 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -1,6 +1,6 @@
;;; image-dired.el --- use dired to browse and manipulate your images
;;
-;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;;
;; Version: 0.4.11
;; Keywords: multimedia
@@ -8,10 +8,10 @@
;; 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 2, 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
@@ -19,9 +19,7 @@
;; 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 .
;;; Commentary:
;;
@@ -231,7 +229,7 @@ Used together with `image-dired-cmd-create-thumbnail-options'."
: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
@@ -249,7 +247,7 @@ Used together with `image-dired-cmd-create-temp-image-options'."
: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
@@ -282,7 +280,7 @@ with the information required by the Thumbnail Managing Standard."
"-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\""
@@ -820,7 +818,7 @@ thumbnail buffer to be selected."
(if (not append)
(erase-buffer)
(goto-char (point-max)))
- (mapcar
+ (mapc
(lambda (curr-file)
(setq thumb-name (image-dired-thumb-name curr-file))
(if (and (not (file-exists-p thumb-name))
@@ -869,11 +867,28 @@ displayed."
;;;###autoload
(defalias 'tumme 'image-dired-show-all-from-dir)
+(defun image-dired-sane-db-file ()
+ "Check if `image-dired-db-file' exists.
+If not, try to create it (including any parent directories).
+Signal error if there are problems creating it."
+ (or (file-exists-p image-dired-db-file)
+ (let (dir buf)
+ (unless (file-directory-p (setq dir (file-name-directory
+ image-dired-db-file)))
+ (make-directory dir t))
+ (with-current-buffer (setq buf (create-file-buffer
+ image-dired-db-file))
+ (write-file image-dired-db-file))
+ (kill-buffer buf)
+ (file-exists-p image-dired-db-file))
+ (error "Could not create %s" image-dired-db-file)))
+
(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) ... )"
+ (image-dired-sane-db-file)
(let (end file tag)
(with-temp-file image-dired-db-file
(insert-file-contents image-dired-db-file)
@@ -893,6 +908,7 @@ is an alist in the following form:
(defun image-dired-remove-tag (files tag)
"For all FILES, remove TAG from the image database."
+ (image-dired-sane-db-file)
(save-excursion
(let (end buf start)
(setq buf (find-file image-dired-db-file))
@@ -900,7 +916,7 @@ is an alist in the following form:
(if (stringp files)
(setq files (list files))
(error "Files must be a string or a list of strings!")))
- (mapcar
+ (mapc
(lambda (file)
(goto-char (point-min))
(when (search-forward-regexp
@@ -927,6 +943,7 @@ is an alist in the following form:
(defun image-dired-list-tags (file)
"Read all tags for image FILE from the image database."
+ (image-dired-sane-db-file)
(save-excursion
(let (end buf (tags ""))
(setq buf (find-file image-dired-db-file))
@@ -1011,12 +1028,9 @@ use only useful if `image-dired-track-movement' is nil."
(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))))
@@ -1118,7 +1132,7 @@ image."
(defun image-dired-next-line ()
"Move to next line and display properties."
(interactive)
- (next-line 1)
+ (forward-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))
@@ -1130,7 +1144,7 @@ image."
(defun image-dired-previous-line ()
"Move to previous line and display properties."
(interactive)
- (previous-line 1)
+ (forward-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
@@ -1165,7 +1179,7 @@ comment."
", "))
(comment (get-text-property (point) 'comment)))
(if file-name
- (message
+ (message "%s"
(image-dired-format-properties-string
dired-buf
file-name
@@ -1180,8 +1194,7 @@ comment."
(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))
@@ -1189,10 +1202,8 @@ dired."
(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)
+ (message "%s" file-name)
+ (if (dired-goto-file file-name)
(cond ((eq command 'mark) (dired-mark 1))
((eq command 'unmark) (dired-unmark 1))
((eq command 'toggle)
@@ -1572,6 +1583,8 @@ Note that n, p and and will be hijacked and bound to
[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
@@ -1835,7 +1848,7 @@ With prefix argument ARG, display image in its original size."
(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."
+ "Return true if there is an image-dired thumbnail at point."
(get-text-property (point) 'image-dired-thumbnail))
(defun image-dired-rotate-thumbnail (degrees)
@@ -2038,6 +2051,7 @@ function. The result is a couple of new files in
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)
(with-temp-file image-dired-db-file
(insert-file-contents image-dired-db-file)
@@ -2108,6 +2122,7 @@ as initial value."
(defun image-dired-get-comment (file)
"Get comment for file FILE."
+ (image-dired-sane-db-file)
(save-excursion
(let (end buf comment-beg-pos comment-end-pos comment)
(setq buf (find-file image-dired-db-file))
@@ -2136,6 +2151,7 @@ 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)
+ (image-dired-sane-db-file)
(let ((tag (read-string "Mark tagged files (regexp): "))
(hits 0)
files buf)
@@ -2148,7 +2164,7 @@ matching tags will be marked in the dired buffer."
(setq files (append (list (match-string 1)) files)))
(kill-buffer buf)
;; Mark files
- (mapcar
+ (mapc
;; I tried using `dired-mark-files-regexp' but it was
;; waaaay to slow.
(lambda (curr-file)
@@ -2217,7 +2233,7 @@ non-nil."
", "))
(comment (image-dired-get-comment file)))
(if file-name
- (message
+ (message "%s"
(image-dired-format-properties-string
dired-buf
file-name
@@ -2300,6 +2316,7 @@ image-dired-file-comment-list:
(defun image-dired-create-gallery-lists ()
"Create temporary lists used by `image-dired-gallery-generate'."
+ (image-dired-sane-db-file)
(let ((buf (find-file image-dired-db-file))
end beg file row-tags)
(setq image-dired-tag-file-list nil)