aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/thumbs.el
diff options
context:
space:
mode:
authorKaroly Lorentey2005-06-15 12:57:51 +0000
committerKaroly Lorentey2005-06-15 12:57:51 +0000
commitef85512e51f043d73788f00a2aed13cccde0682c (patch)
treefc1fa1378533250f260ef8eaa9a84ae882d9df84 /lisp/thumbs.el
parent8736257554f49445f7b4402ac7a9436b38ce6452 (diff)
parentef88a9999004e6c26148c8d280d6a41f623d7249 (diff)
downloademacs-ef85512e51f043d73788f00a2aed13cccde0682c.tar.gz
emacs-ef85512e51f043d73788f00a2aed13cccde0682c.zip
Merged from miles@gnu.org--gnu-2005 (patch 80-82, 350-422)
Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-350 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-352 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-353 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-354 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-355 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-356 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-357 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-358 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-359 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-360 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-362 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-363 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-364 Remove "-face" suffix from widget faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-365 Remove "-face" suffix from custom faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-366 Remove "-face" suffix from change-log faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-367 Remove "-face" suffix from compilation faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-368 Remove "-face" suffix from diff-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-369 lisp/longlines.el (longlines-visible-face): Face removed * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-371 Remove "-face" suffix from whitespace-highlight face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-372 Remove "-face" suffix from ruler-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-373 Remove "-face" suffix from show-paren faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-374 Remove "-face" suffix from log-view faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-375 Remove "-face" suffix from smerge faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-376 Remove "-face" suffix from show-tabs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-377 Remove "-face" suffix from highlight-changes faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-378 Remove "-face" suffix from and downcase info faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-379 Remove "-face" suffix from pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-380 Update uses of renamed pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-381 Tweak ChangeLog * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-382 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-383 Remove "-face" suffix from strokes-char face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-384 Remove "-face" suffix from compare-windows face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-385 Remove "-face" suffix from calendar faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-386 Remove "-face" suffix from diary-button face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-387 Remove "-face" suffix from testcover faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-388 Remove "-face" suffix from viper faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-389 Remove "-face" suffix from org faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-390 Remove "-face" suffix from sgml-namespace face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-391 Remove "-face" suffix from table-cell face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-392 Remove "-face" suffix from tex-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-393 Remove "-face" suffix from texinfo-heading face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-394 Remove "-face" suffix from flyspell faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-396 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-397 Remove "-face" suffix from gomoku faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-398 Remove "-face" suffix from mpuz faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-399 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-401 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-403 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-404 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-405 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-406 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-407 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-408 Remove "-face" suffix from Buffer-menu-buffer face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-409 Remove "-face" suffix from antlr-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-411 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-412 Remove "-face" suffix from flymake faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-413 Remove "-face" suffix from idlwave faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-414 Remove "-face" suffix from sh-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-415 Remove "-face" suffix from vhdl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-416 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-417 Remove "-face" suffix from which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-418 Remove "-face" suffix from cperl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-419 Remove "-face" suffix from ld-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-420 Fix cperl-mode font-lock problem * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-421 Tweak which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-422 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-80 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-81 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-82 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-350
Diffstat (limited to 'lisp/thumbs.el')
-rw-r--r--lisp/thumbs.el114
1 files changed, 58 insertions, 56 deletions
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 321fe7266cc..09fe77cf352 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -65,8 +65,7 @@
65 :version "22.1" 65 :version "22.1"
66 :group 'multimedia) 66 :group 'multimedia)
67 67
68(defcustom thumbs-thumbsdir 68(defcustom thumbs-thumbsdir "~/.emacs-thumbs"
69 (expand-file-name "~/.emacs-thumbs")
70 "*Directory to store thumbnails." 69 "*Directory to store thumbnails."
71 :type 'directory 70 :type 'directory
72 :group 'thumbs) 71 :group 'thumbs)
@@ -78,17 +77,17 @@
78 77
79(defcustom thumbs-per-line 5 78(defcustom thumbs-per-line 5
80 "*Number of thumbnails per line to show in directory." 79 "*Number of thumbnails per line to show in directory."
81 :type 'string 80 :type 'integer
82 :group 'thumbs) 81 :group 'thumbs)
83 82
84(defcustom thumbs-thumbsdir-max-size 50000000 83(defcustom thumbs-thumbsdir-max-size 50000000
85 "Max size for thumbnails directory. 84 "Max size for thumbnails directory.
86When it reachs that size (in bytes), a warning is sent." 85When it reaches that size (in bytes), a warning is sent."
87 :type 'string 86 :type 'integer
88 :group 'thumbs) 87 :group 'thumbs)
89 88
90(defcustom thumbs-conversion-program 89(defcustom thumbs-conversion-program
91 (if (equal 'windows-nt system-type) 90 (if (eq system-type 'windows-nt)
92 "convert.exe" 91 "convert.exe"
93 (or (executable-find "convert") 92 (or (executable-find "convert")
94 "/usr/X11R6/bin/convert")) 93 "/usr/X11R6/bin/convert"))
@@ -105,32 +104,31 @@ It must be 'convert'."
105 104
106(defcustom thumbs-relief 5 105(defcustom thumbs-relief 5
107 "*Size of button-like border around thumbnails." 106 "*Size of button-like border around thumbnails."
108 :type 'string 107 :type 'integer
109 :group 'thumbs) 108 :group 'thumbs)
110 109
111(defcustom thumbs-margin 2 110(defcustom thumbs-margin 2
112 "*Size of the margin around thumbnails. 111 "*Size of the margin around thumbnails.
113This is where you see the cursor." 112This is where you see the cursor."
114 :type 'string 113 :type 'integer
115 :group 'thumbs) 114 :group 'thumbs)
116 115
117(defcustom thumbs-thumbsdir-auto-clean t 116(defcustom thumbs-thumbsdir-auto-clean t
118 "If set, delete older file in the thumbnails directory. 117 "If set, delete older file in the thumbnails directory.
119Deletion is done at load time when the directory size is bigger 118Deletion is done at load time when the directory size is bigger
120than 'thumbs-thumbsdir-max-size'." 119than `thumbs-thumbsdir-max-size'."
121 :type 'boolean 120 :type 'boolean
122 :group 'thumbs) 121 :group 'thumbs)
123 122
124(defcustom thumbs-image-resizing-step 10 123(defcustom thumbs-image-resizing-step 10
125 "Step by wich to resize image." 124 "Step by which to resize image."
126 :type 'string 125 :type 'integer
127 :group 'thumbs) 126 :group 'thumbs)
128 127
129(defcustom thumbs-temp-dir 128(defcustom thumbs-temp-dir temporary-file-directory
130 "/tmp/"
131 "Temporary directory to use. 129 "Temporary directory to use.
132Leaving it to default '/tmp/' can let another user 130Defaults to `temporary-file-directory'. Leaving it to
133see some of your images." 131this value can let another user see some of your images."
134 :type 'directory 132 :type 'directory
135 :group 'thumbs) 133 :group 'thumbs)
136 134
@@ -140,10 +138,6 @@ see some of your images."
140 :group 'thumbs) 138 :group 'thumbs)
141 139
142;; Initialize some variable, for later use. 140;; Initialize some variable, for later use.
143(defvar thumbs-temp-file
144 (concat thumbs-temp-dir thumbs-temp-prefix)
145 "Temporary filename for images.")
146
147(defvar thumbs-current-tmp-filename 141(defvar thumbs-current-tmp-filename
148 nil 142 nil
149 "Temporary filename of current image.") 143 "Temporary filename of current image.")
@@ -163,28 +157,40 @@ see some of your images."
163 nil 157 nil
164 "List of marked files.") 158 "List of marked files.")
165 159
166;; Make sure auto-image-file-mode is ON. 160(defalias 'thumbs-gensym
167(auto-image-file-mode t) 161 (if (fboundp 'gensym)
168 162 'gensym
169;; Create the thumbs directory if it does not exists. 163 ;; Copied from cl-macs.el
170(setq thumbs-thumbsdir (expand-file-name thumbs-thumbsdir)) 164 (defvar thumbs-gensym-counter 0)
171 165 (lambda (&optional prefix)
172(when (not (file-directory-p thumbs-thumbsdir)) 166 "Generate a new uninterned symbol.
173 (progn 167The name is made by appending a number to PREFIX, default \"G\"."
174 (make-directory thumbs-thumbsdir) 168 (let ((pfix (if (stringp prefix) prefix "G"))
175 (message "Creating thumbnails directory"))) 169 (num (if (integerp prefix) prefix
176 170 (prog1 thumbs-gensym-counter
177(defvar thumbs-gensym-counter 0) 171 (setq thumbs-gensym-counter
178 172 (1+ thumbs-gensym-counter))))))
179(defun thumbs-gensym (&optional arg) 173 (make-symbol (format "%s%d" pfix num))))))
180 "Generate a new uninterned symbol. 174
181The name is made by appending a number to PREFIX, default \"Thumbs\"." 175(defsubst thumbs-temp-dir ()
182 (let ((prefix (if (stringp arg) arg "Thumbs")) 176 (file-name-as-directory (expand-file-name thumbs-temp-dir)))
183 (num (if (integerp arg) arg 177
184 (prog1 178(defun thumbs-temp-file ()
185 thumbs-gensym-counter 179 "Return a unique temporary filename for an image."
186 (setq thumbs-gensym-counter (1+ thumbs-gensym-counter)))))) 180 (format "%s%s-%s.jpg"
187 (make-symbol (format "%s%d" prefix num)))) 181 (thumbs-temp-dir)
182 thumbs-temp-prefix
183 (thumbs-gensym "T")))
184
185(defun thumbs-thumbsdir ()
186 "Return the current thumbnails directory (from `thumbs-thumbsdir').
187Create the thumbnails directory if it does not exist."
188 (let ((thumbs-thumbsdir (file-name-as-directory
189 (expand-file-name thumbs-thumbsdir))))
190 (unless (file-directory-p thumbs-thumbsdir)
191 (make-directory thumbs-thumbsdir)
192 (message "Creating thumbnails directory"))
193 thumbs-thumbsdir))
188 194
189(defun thumbs-cleanup-thumbsdir () 195(defun thumbs-cleanup-thumbsdir ()
190 "Clean the thumbnails directory. 196 "Clean the thumbnails directory.
@@ -197,8 +203,8 @@ reached."
197 (lambda (f) 203 (lambda (f)
198 (let ((fattribsL (file-attributes f))) 204 (let ((fattribsL (file-attributes f)))
199 `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f))) 205 `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f)))
200 (directory-files thumbs-thumbsdir t (image-file-name-regexp))) 206 (directory-files (thumbs-thumbsdir) t (image-file-name-regexp)))
201 '(lambda (l1 l2) (time-less-p (car l1)(car l2))))) 207 '(lambda (l1 l2) (time-less-p (car l1) (car l2)))))
202 (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL)))) 208 (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL))))
203 (while (> dirsize thumbs-thumbsdir-max-size) 209 (while (> dirsize thumbs-thumbsdir-max-size)
204 (progn 210 (progn
@@ -258,14 +264,14 @@ ACTION-PREFIX is the symbol to place before the ACTION command
258 264
259(defun thumbs-resize-image (&optional increment size) 265(defun thumbs-resize-image (&optional increment size)
260 "Resize image in current buffer. 266 "Resize image in current buffer.
261if INCREMENT is set, make the image bigger, else smaller. 267If INCREMENT is set, make the image bigger, else smaller.
262Or, alternatively, a SIZE may be specified." 268Or, alternatively, a SIZE may be specified."
263 (interactive) 269 (interactive)
264 ;; cleaning of old temp file 270 ;; cleaning of old temp file
265 (condition-case nil 271 (condition-case nil
266 (apply 'delete-file 272 (apply 'delete-file
267 (directory-files 273 (directory-files
268 thumbs-temp-dir t 274 (thumbs-temp-dir) t
269 thumbs-temp-prefix)) 275 thumbs-temp-prefix))
270 (error nil)) 276 (error nil))
271 (let ((buffer-read-only nil) 277 (let ((buffer-read-only nil)
@@ -276,7 +282,7 @@ Or, alternatively, a SIZE may be specified."
276 thumbs-current-image-size) 282 thumbs-current-image-size)
277 (thumbs-decrement-image-size 283 (thumbs-decrement-image-size
278 thumbs-current-image-size)))) 284 thumbs-current-image-size))))
279 (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym)))) 285 (tmp (thumbs-temp-file)))
280 (erase-buffer) 286 (erase-buffer)
281 (thumbs-call-convert thumbs-current-image-filename 287 (thumbs-call-convert thumbs-current-image-filename
282 tmp "sample" 288 tmp "sample"
@@ -286,7 +292,7 @@ Or, alternatively, a SIZE may be specified."
286 (setq thumbs-current-tmp-filename tmp))) 292 (setq thumbs-current-tmp-filename tmp)))
287 293
288(defun thumbs-resize-interactive (width height) 294(defun thumbs-resize-interactive (width height)
289 "Resize Image interactively to specified WIDTH and HEIGHT." 295 "Resize image interactively to specified WIDTH and HEIGHT."
290 (interactive "nWidth: \nnHeight: ") 296 (interactive "nWidth: \nnHeight: ")
291 (thumbs-resize-image nil (cons width height))) 297 (thumbs-resize-image nil (cons width height)))
292 298
@@ -304,8 +310,8 @@ Or, alternatively, a SIZE may be specified."
304 "Return a thumbnail name for the image IMG." 310 "Return a thumbnail name for the image IMG."
305 (convert-standard-filename 311 (convert-standard-filename
306 (let ((filename (expand-file-name img))) 312 (let ((filename (expand-file-name img)))
307 (format "%s/%08x-%s.jpg" 313 (format "%s%08x-%s.jpg"
308 thumbs-thumbsdir 314 (thumbs-thumbsdir)
309 (sxhash filename) 315 (sxhash filename)
310 (subst-char-in-string 316 (subst-char-in-string
311 ?\s ?\_ 317 ?\s ?\_
@@ -562,11 +568,7 @@ Open another window."
562(defun thumbs-kill-buffer () 568(defun thumbs-kill-buffer ()
563 "Kill the current buffer." 569 "Kill the current buffer."
564 (interactive) 570 (interactive)
565 (let ((buffer (current-buffer))) 571 (quit-window t (selected-window)))
566 (condition-case nil
567 (delete-window (selected-window))
568 (error nil))
569 (kill-buffer buffer)))
570 572
571(defun thumbs-show-image-num (num) 573(defun thumbs-show-image-num (num)
572 "Show the image with number NUM." 574 "Show the image with number NUM."
@@ -639,11 +641,11 @@ ACTION and ARG should be a valid convert command."
639 ;; cleaning of old temp file 641 ;; cleaning of old temp file
640 (mapc 'delete-file 642 (mapc 'delete-file
641 (directory-files 643 (directory-files
642 thumbs-temp-dir 644 (thumbs-temp-dir)
643 t 645 t
644 thumbs-temp-prefix)) 646 thumbs-temp-prefix))
645 (let ((buffer-read-only nil) 647 (let ((buffer-read-only nil)
646 (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym)))) 648 (tmp (thumbs-temp-file)))
647 (erase-buffer) 649 (erase-buffer)
648 (thumbs-call-convert thumbs-current-image-filename 650 (thumbs-call-convert thumbs-current-image-filename
649 tmp 651 tmp