Mercurial > emacs
annotate lisp/thumbs.el @ 110410:f2e111723c3a
Merge changes made in Gnus trunk.
Reimplement nnimap, and do tweaks to the rest of the code to support that.
* gnus-int.el (gnus-finish-retrieve-group-infos)
(gnus-retrieve-group-data-early): New functions.
* gnus-range.el (gnus-range-nconcat): New function.
* gnus-start.el (gnus-get-unread-articles): Support early retrieval of
data.
(gnus-read-active-for-groups): Support finishing the early retrieval of
data.
* gnus-sum.el (gnus-summary-move-article): Pass the move-to group name
if the move is internal, so that nnimap can do fast internal moves.
* gnus.el (gnus-article-special-mark-lists): Add uid/active tuples, for
nnimap usage.
* nnimap.el: Rewritten.
* nnmail.el (nnmail-inhibit-default-split-group): New internal variable
to allow the mail splitting to not return a default group. This is
useful for nnimap, which will leave unmatched mail in the inbox.
* utf7.el (utf7-encode): Autoload.
Implement shell connection.
* nnimap.el (nnimap-open-shell-stream): New function.
(nnimap-open-connection): Use it.
Get the number of lines by using BODYSTRUCTURE.
(nnimap-transform-headers): Get the number of lines in each message.
(nnimap-retrieve-headers): Query for BODYSTRUCTURE so that we get the
number of lines.
Not all servers return UIDNEXT. Work past this problem.
Remove junk from end of file.
Fix typo in "bogus" section.
Make capabilties be case-insensitive.
Require cl when compiling.
Don't bug out if the LIST command doesn't have any parameters.
2010-09-17 Knut Anders Hatlen <kahatlen@gmail.com> (tiny change)
* nnimap.el (nnimap-get-groups): Don't bug out if the LIST command
doesn't have any parameters.
(mm-text-html-renderer): Document gnus-article-html.
2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix)
* mm-decode.el (mm-text-html-renderer): Document gnus-article-html.
* dgnushack.el: Define netrc-credentials.
If the user doesn't have a /etc/services, supply some sensible port defaults.
Have `unseen-or-unread' select an unread unseen article first.
(nntp-open-server): Return whether the open was successful or not.
Throughout all files, replace (save-excursion (set-buffer ...)) with (with-current-buffer ... ).
Save result so that it doesn't say "failed" all the time.
Add ~/.authinfo to the default, since that's probably most useful for users.
Don't use the "finish" method when we're reading from the agent.
Add some more nnimap-relevant agent stuff to nnagent.el.
* nnimap.el (nnimap-with-process-buffer): Removed.
Revert one line that was changed by mistake in the last checkin.
(nnimap-open-connection): Don't error out when we can't make a connection
nnimap-related changes to avoid bugging out if we can't contact a server.
* gnus-start.el (gnus-get-unread-articles): Don't try to scan groups
from methods that are denied.
* nnimap.el (nnimap-possibly-change-group): Return nil if we can't log
in.
(nnimap-finish-retrieve-group-infos): Make sure we're not waiting for
nothing.
* gnus-sum.el (gnus-select-newsgroup): Indent.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 10:02:19 +0000 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
rev | line source |
---|---|
54186 | 1 ;;; thumbs.el --- Thumbnails previewer for images files |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
2 |
106815 | 3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
4 |
54186 | 5 ;; Author: Jean-Philippe Theberge <jphiltheberge@videotron.ca> |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
6 ;; Maintainer: FSF |
54186 | 7 ;; Keywords: Multimedia |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
54186 | 12 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
14 ;; (at your option) any later version. |
54186 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
54186 | 23 |
24 ;;; Commentary: | |
25 | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
26 ;; This package create two new modes: thumbs-mode and thumbs-view-image-mode. |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
27 ;; It is used for basic browsing and viewing of images from within Emacs. |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
28 ;; Minimal image manipulation functions are also available via external |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
29 ;; programs. If you want to do more complex tasks like categorise and tag |
77406 | 30 ;; your images, use image-dired.el |
54186 | 31 ;; |
32 ;; The 'convert' program from 'ImageMagick' | |
33 ;; [URL:http://www.imagemagick.org/] is required. | |
34 ;; | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
35 ;; Thanks: Alex Schroeder <alex@gnu.org> for maintaining the package at some |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
36 ;; time. The peoples at #emacs@freenode.net for numerous help. RMS |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
37 ;; for emacs and the GNU project. |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
38 ;; |
54186 | 39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
40 ;; |
54186 | 41 ;; CHANGELOG |
42 ;; | |
43 ;; This is version 2.0 | |
44 ;; | |
45 ;; USAGE | |
46 ;; | |
47 ;; Type M-x thumbs RET DIR RET to view the directory DIR in Thumbs mode. | |
48 ;; That should be a directory containing image files. | |
49 ;; from dired, C-t m enter in thumbs-mode with all marked files | |
50 ;; C-t a enter in thumbs-mode with all files in current-directory | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
51 ;; In thumbs-mode, pressing <return> on a image will bring you in image view |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
52 ;; mode for that image. C-h m will give you a list of available keybinding. |
54186 | 53 |
54 ;;; History: | |
55206
c2c29cafaa74
(time-less-p): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
54193
diff
changeset
|
55 ;; |
54186 | 56 |
57 ;;; Code: | |
58 | |
59 (require 'dired) | |
60 | |
61 ;; CUSTOMIZATIONS | |
62 | |
63 (defgroup thumbs nil | |
64 "Thumbnails previewer." | |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57831
diff
changeset
|
65 :version "22.1" |
54186 | 66 :group 'multimedia) |
67 | |
99106
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
95841
diff
changeset
|
68 (defcustom thumbs-thumbsdir (locate-user-emacs-file "thumbs") |
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
99106
diff
changeset
|
69 "Directory to store thumbnails." |
54186 | 70 :type 'directory |
71 :group 'thumbs) | |
72 | |
73 (defcustom thumbs-geometry "100x100" | |
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
99106
diff
changeset
|
74 "Size of thumbnails." |
54186 | 75 :type 'string |
76 :group 'thumbs) | |
77 | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
78 (defcustom thumbs-per-line 4 |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
79 "Number of thumbnails per line to show in directory." |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
80 :type 'integer |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
81 :group 'thumbs) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
82 |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
83 (defcustom thumbs-max-image-number 16 |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
84 "Maximum number of images initially displayed in thumbs buffer." |
63313
2d9ef16c13be
(thumbs-per-line, thumbs-thumbsdir-max-size)
Eli Zaretskii <eliz@gnu.org>
parents:
63280
diff
changeset
|
85 :type 'integer |
54186 | 86 :group 'thumbs) |
87 | |
88 (defcustom thumbs-thumbsdir-max-size 50000000 | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
89 "Maximum size for thumbnails directory. |
63078
2d7151e2c3ee
(thumbs-thumbsdir-max-size, thumbs-image-resizing-step,
Juanma Barranquero <lekktu@gmail.com>
parents:
62927
diff
changeset
|
90 When it reaches that size (in bytes), a warning is sent." |
63313
2d9ef16c13be
(thumbs-per-line, thumbs-thumbsdir-max-size)
Eli Zaretskii <eliz@gnu.org>
parents:
63280
diff
changeset
|
91 :type 'integer |
54186 | 92 :group 'thumbs) |
93 | |
87482
66dec6867b40
(thumbs-conversion-program): Add comment for Windows XP.
Nick Roberts <nickrob@snap.net.nz>
parents:
87441
diff
changeset
|
94 ;; Unfortunately Windows XP has a program called CONVERT.EXE in |
66dec6867b40
(thumbs-conversion-program): Add comment for Windows XP.
Nick Roberts <nickrob@snap.net.nz>
parents:
87441
diff
changeset
|
95 ;; C:/WINDOWS/SYSTEM32/ for partioning NTFS system. So Emacs |
66dec6867b40
(thumbs-conversion-program): Add comment for Windows XP.
Nick Roberts <nickrob@snap.net.nz>
parents:
87441
diff
changeset
|
96 ;; can find the one in your ImageMagick directory, you need to |
66dec6867b40
(thumbs-conversion-program): Add comment for Windows XP.
Nick Roberts <nickrob@snap.net.nz>
parents:
87441
diff
changeset
|
97 ;; customize this value to the absolute filename. |
54186 | 98 (defcustom thumbs-conversion-program |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
99 (if (eq system-type 'windows-nt) |
54186 | 100 "convert.exe" |
101 (or (executable-find "convert") | |
102 "/usr/X11R6/bin/convert")) | |
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
99106
diff
changeset
|
103 "Name of conversion program for thumbnails generation. |
54186 | 104 It must be 'convert'." |
105 :type 'string | |
106 :group 'thumbs) | |
107 | |
108 (defcustom thumbs-setroot-command | |
109 "xloadimage -onroot -fullscreen *" | |
110 "Command to set the root window." | |
111 :type 'string | |
112 :group 'thumbs) | |
113 | |
114 (defcustom thumbs-relief 5 | |
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
99106
diff
changeset
|
115 "Size of button-like border around thumbnails." |
63313
2d9ef16c13be
(thumbs-per-line, thumbs-thumbsdir-max-size)
Eli Zaretskii <eliz@gnu.org>
parents:
63280
diff
changeset
|
116 :type 'integer |
54186 | 117 :group 'thumbs) |
118 | |
119 (defcustom thumbs-margin 2 | |
99116
2e0e3e5cbd97
* completion.el (add-completion-to-head, add-completion): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
99106
diff
changeset
|
120 "Size of the margin around thumbnails. |
54186 | 121 This is where you see the cursor." |
63313
2d9ef16c13be
(thumbs-per-line, thumbs-thumbsdir-max-size)
Eli Zaretskii <eliz@gnu.org>
parents:
63280
diff
changeset
|
122 :type 'integer |
54186 | 123 :group 'thumbs) |
124 | |
125 (defcustom thumbs-thumbsdir-auto-clean t | |
126 "If set, delete older file in the thumbnails directory. | |
127 Deletion is done at load time when the directory size is bigger | |
63078
2d7151e2c3ee
(thumbs-thumbsdir-max-size, thumbs-image-resizing-step,
Juanma Barranquero <lekktu@gmail.com>
parents:
62927
diff
changeset
|
128 than `thumbs-thumbsdir-max-size'." |
54186 | 129 :type 'boolean |
130 :group 'thumbs) | |
131 | |
132 (defcustom thumbs-image-resizing-step 10 | |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
133 "Step by which to resize image as a percentage." |
63313
2d9ef16c13be
(thumbs-per-line, thumbs-thumbsdir-max-size)
Eli Zaretskii <eliz@gnu.org>
parents:
63280
diff
changeset
|
134 :type 'integer |
54186 | 135 :group 'thumbs) |
136 | |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
137 (defcustom thumbs-temp-dir temporary-file-directory |
54186 | 138 "Temporary directory to use. |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
139 Defaults to `temporary-file-directory'. Leaving it to |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
140 this value can let another user see some of your images." |
54186 | 141 :type 'directory |
142 :group 'thumbs) | |
143 | |
144 (defcustom thumbs-temp-prefix "emacsthumbs" | |
145 "Prefix to add to temp files." | |
146 :type 'string | |
147 :group 'thumbs) | |
148 | |
149 ;; Initialize some variable, for later use. | |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
150 (defvar thumbs-current-tmp-filename nil |
54186 | 151 "Temporary filename of current image.") |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
152 (make-variable-buffer-local 'thumbs-current-tmp-filename) |
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
153 |
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
154 (defvar thumbs-current-image-filename nil |
54186 | 155 "Filename of current image.") |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
156 (make-variable-buffer-local 'thumbs-current-image-filename) |
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
157 |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
158 (defvar thumbs-extra-images 1 |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
159 "Counter for showing extra images in thumbs buffer.") |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
160 (make-variable-buffer-local 'thumbs-extra-images) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
161 (put 'thumbs-extra-images 'permanent-local t) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
162 |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
163 (defvar thumbs-current-image-size nil |
54186 | 164 "Size of current image.") |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
165 |
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
166 (defvar thumbs-image-num nil |
54186 | 167 "Number of current image.") |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
168 (make-variable-buffer-local 'thumbs-image-num) |
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
169 |
68289
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
170 (defvar thumbs-buffer nil |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
171 "Name of buffer containing thumbnails associated with image.") |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
172 (make-variable-buffer-local 'thumbs-buffer) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
173 |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
174 (defvar thumbs-current-dir nil |
54186 | 175 "Current directory.") |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
176 |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
177 (defvar thumbs-marked-list nil |
54186 | 178 "List of marked files.") |
68486
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
179 (make-variable-buffer-local 'thumbs-marked-list) |
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
180 (put 'thumbs-marked-list 'permanent-local t) |
54186 | 181 |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
182 (defalias 'thumbs-gensym |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
183 (if (fboundp 'gensym) |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
184 'gensym |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
185 ;; Copied from cl-macs.el |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
186 (defvar thumbs-gensym-counter 0) |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
187 (lambda (&optional prefix) |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
188 "Generate a new uninterned symbol. |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
189 The name is made by appending a number to PREFIX, default \"G\"." |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
190 (let ((pfix (if (stringp prefix) prefix "G")) |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
191 (num (if (integerp prefix) prefix |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
192 (prog1 thumbs-gensym-counter |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
193 (setq thumbs-gensym-counter |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
194 (1+ thumbs-gensym-counter)))))) |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
195 (make-symbol (format "%s%d" pfix num)))))) |
54186 | 196 |
63280
69ae2aff114c
Fixes for changes of 2005-06-09.
Juanma Barranquero <lekktu@gmail.com>
parents:
63155
diff
changeset
|
197 (defsubst thumbs-temp-dir () |
69ae2aff114c
Fixes for changes of 2005-06-09.
Juanma Barranquero <lekktu@gmail.com>
parents:
63155
diff
changeset
|
198 (file-name-as-directory (expand-file-name thumbs-temp-dir))) |
69ae2aff114c
Fixes for changes of 2005-06-09.
Juanma Barranquero <lekktu@gmail.com>
parents:
63155
diff
changeset
|
199 |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
200 (defun thumbs-temp-file () |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
201 "Return a unique temporary filename for an image." |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
202 (format "%s%s-%s.jpg" |
63280
69ae2aff114c
Fixes for changes of 2005-06-09.
Juanma Barranquero <lekktu@gmail.com>
parents:
63155
diff
changeset
|
203 (thumbs-temp-dir) |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
204 thumbs-temp-prefix |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
205 (thumbs-gensym "T"))) |
54186 | 206 |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
207 (defun thumbs-thumbsdir () |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
208 "Return the current thumbnails directory (from `thumbs-thumbsdir'). |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
209 Create the thumbnails directory if it does not exist." |
63280
69ae2aff114c
Fixes for changes of 2005-06-09.
Juanma Barranquero <lekktu@gmail.com>
parents:
63155
diff
changeset
|
210 (let ((thumbs-thumbsdir (file-name-as-directory |
69ae2aff114c
Fixes for changes of 2005-06-09.
Juanma Barranquero <lekktu@gmail.com>
parents:
63155
diff
changeset
|
211 (expand-file-name thumbs-thumbsdir)))) |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
212 (unless (file-directory-p thumbs-thumbsdir) |
66568
624edd899d32
* thumbs.el (thumbs-thumbsdir): Default to ~/.emacs.d/thumbs.
Chong Yidong <cyd@stupidchicken.com>
parents:
66413
diff
changeset
|
213 (make-directory thumbs-thumbsdir t) |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
214 (message "Creating thumbnails directory")) |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
215 thumbs-thumbsdir)) |
54186 | 216 |
217 (defun thumbs-cleanup-thumbsdir () | |
218 "Clean the thumbnails directory. | |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
219 If the total size of all files in `thumbs-thumbsdir' is bigger than |
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
220 `thumbs-thumbsdir-max-size', files are deleted until the max size is |
54186 | 221 reached." |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
222 (let* ((files-list |
54186 | 223 (sort |
224 (mapcar | |
225 (lambda (f) | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
226 (let ((fattribs-list (file-attributes f))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
227 `(,(nth 4 fattribs-list) ,(nth 7 fattribs-list) ,f))) |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
228 (directory-files (thumbs-thumbsdir) t (image-file-name-regexp))) |
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
229 '(lambda (l1 l2) (time-less-p (car l1) (car l2))))) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
230 (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files-list)))) |
54186 | 231 (while (> dirsize thumbs-thumbsdir-max-size) |
232 (progn | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
233 (message "Deleting file %s" (cadr (cdar files-list)))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
234 (delete-file (cadr (cdar files-list))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
235 (setq dirsize (- dirsize (car (cdar files-list)))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
236 (setq files-list (cdr files-list))))) |
54186 | 237 |
238 ;; Check the thumbsnail directory size and clean it if necessary. | |
239 (when thumbs-thumbsdir-auto-clean | |
240 (thumbs-cleanup-thumbsdir)) | |
241 | |
242 (defun thumbs-call-convert (filein fileout action | |
243 &optional arg output-format action-prefix) | |
244 "Call the convert program. | |
245 FILEIN is the input file, | |
246 FILEOUT is the output file, | |
247 ACTION is the command to send to convert. | |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
248 Optional arguments are: |
54186 | 249 ARG any arguments to the ACTION command, |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
250 OUTPUT-FORMAT is the file format to output (default is jpeg), |
54186 | 251 ACTION-PREFIX is the symbol to place before the ACTION command |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
252 (defaults to '-' but can sometimes be '+')." |
87441
350032476821
(thumbs-call-convert): Use call-process directly
Nick Roberts <nickrob@snap.net.nz>
parents:
82140
diff
changeset
|
253 (call-process thumbs-conversion-program nil nil nil |
350032476821
(thumbs-call-convert): Use call-process directly
Nick Roberts <nickrob@snap.net.nz>
parents:
82140
diff
changeset
|
254 (or action-prefix "-") |
350032476821
(thumbs-call-convert): Use call-process directly
Nick Roberts <nickrob@snap.net.nz>
parents:
82140
diff
changeset
|
255 action |
350032476821
(thumbs-call-convert): Use call-process directly
Nick Roberts <nickrob@snap.net.nz>
parents:
82140
diff
changeset
|
256 (or arg "") |
350032476821
(thumbs-call-convert): Use call-process directly
Nick Roberts <nickrob@snap.net.nz>
parents:
82140
diff
changeset
|
257 filein |
350032476821
(thumbs-call-convert): Use call-process directly
Nick Roberts <nickrob@snap.net.nz>
parents:
82140
diff
changeset
|
258 (format "%s:%s" (or output-format "jpeg") fileout))) |
54186 | 259 |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
260 (defun thumbs-new-image-size (s increment) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
261 "New image (a cons of width x height)." |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
262 (let ((d (* increment thumbs-image-resizing-step))) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
263 (cons |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
264 (round (+ (car s) (/ (* d (car s)) 100))) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
265 (round (+ (cdr s) (/ (* d (cdr s)) 100)))))) |
54186 | 266 |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
267 (defun thumbs-resize-image-1 (&optional increment size) |
54186 | 268 "Resize image in current buffer. |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
269 If SIZE is specified use it. Otherwise make the image larger or |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
270 smaller according to whether INCREMENT is 1 or -1." |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
271 (let* ((buffer-read-only nil) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
272 (old thumbs-current-tmp-filename) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
273 (x (or size |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
274 (thumbs-new-image-size thumbs-current-image-size increment))) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
275 (tmp (thumbs-temp-file))) |
54186 | 276 (erase-buffer) |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
277 (thumbs-call-convert (or old thumbs-current-image-filename) |
54186 | 278 tmp "sample" |
279 (concat (number-to-string (car x)) "x" | |
280 (number-to-string (cdr x)))) | |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
281 (save-excursion |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
282 (thumbs-insert-image tmp 'jpeg 0)) |
54186 | 283 (setq thumbs-current-tmp-filename tmp))) |
284 | |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
285 (defun thumbs-resize-image (width height) |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
286 "Resize image interactively to specified WIDTH and HEIGHT." |
54186 | 287 (interactive "nWidth: \nnHeight: ") |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
288 (thumbs-resize-image-1 nil (cons width height))) |
55206
c2c29cafaa74
(time-less-p): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
54193
diff
changeset
|
289 |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
290 (defun thumbs-shrink-image () |
54186 | 291 "Resize image (smaller)." |
292 (interactive) | |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
293 (thumbs-resize-image-1 -1)) |
54186 | 294 |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
295 (defun thumbs-enlarge-image () |
54186 | 296 "Resize image (bigger)." |
297 (interactive) | |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
298 (thumbs-resize-image-1 1)) |
54186 | 299 |
300 (defun thumbs-thumbname (img) | |
301 "Return a thumbnail name for the image IMG." | |
62891
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
302 (convert-standard-filename |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
303 (let ((filename (expand-file-name img))) |
63280
69ae2aff114c
Fixes for changes of 2005-06-09.
Juanma Barranquero <lekktu@gmail.com>
parents:
63155
diff
changeset
|
304 (format "%s%08x-%s.jpg" |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
305 (thumbs-thumbsdir) |
62891
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
306 (sxhash filename) |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
307 (subst-char-in-string |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
308 ?\s ?\_ |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
309 (apply |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
310 'concat |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
311 (split-string filename "/"))))))) |
54186 | 312 |
313 (defun thumbs-make-thumb (img) | |
314 "Create the thumbnail for IMG." | |
62891
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
315 (let ((fn (expand-file-name img)) |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
316 (tn (thumbs-thumbname img))) |
54186 | 317 (if (or (not (file-exists-p tn)) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
318 ;; This is not the right fix, but I don't understand |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
319 ;; the external program or why it produces a geometry |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
320 ;; unequal to the one requested -- rms. |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
321 ;;; (not (equal (thumbs-file-size tn) thumbs-geometry)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
322 ) |
54186 | 323 (thumbs-call-convert fn tn "sample" thumbs-geometry)) |
324 tn)) | |
55206
c2c29cafaa74
(time-less-p): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
54193
diff
changeset
|
325 |
54186 | 326 (defun thumbs-image-type (img) |
327 "Return image type from filename IMG." | |
328 (cond ((string-match ".*\\.jpe?g\\'" img) 'jpeg) | |
329 ((string-match ".*\\.xpm\\'" img) 'xpm) | |
330 ((string-match ".*\\.xbm\\'" img) 'xbm) | |
66413
4e56b3fda002
* menu-bar.el (menu-bar-help-menu): Rename "psychiatrist", in line
Chong Yidong <cyd@stupidchicken.com>
parents:
64762
diff
changeset
|
331 ((string-match ".*\\.pbm\\'" img) 'pbm) |
54186 | 332 ((string-match ".*\\.gif\\'" img) 'gif) |
333 ((string-match ".*\\.bmp\\'" img) 'bmp) | |
334 ((string-match ".*\\.png\\'" img) 'png) | |
335 ((string-match ".*\\.tiff?\\'" img) 'tiff))) | |
336 | |
95841
b4e36ff621b3
Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
337 (declare-function image-size "image.c" (spec &optional pixels frame)) |
b4e36ff621b3
Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
338 |
54186 | 339 (defun thumbs-file-size (img) |
68486
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
340 (let ((i (image-size |
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
341 (find-image `((:type ,(thumbs-image-type img) :file ,img))) t))) |
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
342 (concat (number-to-string (round (car i))) "x" |
54186 | 343 (number-to-string (round (cdr i)))))) |
55206
c2c29cafaa74
(time-less-p): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
54193
diff
changeset
|
344 |
54186 | 345 ;;;###autoload |
346 (defun thumbs-find-thumb (img) | |
347 "Display the thumbnail for IMG." | |
348 (interactive "f") | |
349 (find-file (thumbs-make-thumb img))) | |
350 | |
351 (defun thumbs-insert-image (img type relief &optional marked) | |
352 "Insert image IMG at point. | |
353 TYPE and RELIEF will be used in constructing the image; see `image' | |
354 in the emacs-lisp manual for further documentation. | |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
355 If MARKED is non-nil, the image is marked." |
54186 | 356 (let ((i `(image :type ,type |
357 :file ,img | |
358 :relief ,relief | |
359 :conversion ,(if marked 'disabled) | |
360 :margin ,thumbs-margin))) | |
361 (insert-image i) | |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
362 (set (make-local-variable 'thumbs-current-image-size) |
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
363 (image-size i t)))) |
54186 | 364 |
365 (defun thumbs-insert-thumb (img &optional marked) | |
366 "Insert the thumbnail for IMG at point. | |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
367 If MARKED is non-nil, the image is marked." |
54186 | 368 (thumbs-insert-image |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
369 (thumbs-make-thumb img) 'jpeg thumbs-relief marked) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
370 (add-text-properties (1- (point)) (point) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
371 `(thumb-image-file ,img |
68486
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
372 help-echo ,(file-name-nondirectory img) |
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
373 rear-nonsticky help-echo))) |
54186 | 374 |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
375 (defun thumbs-do-thumbs-insertion (list) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
376 "Insert all thumbnails into thumbs buffer." |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
377 (let* ((i 0) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
378 (length (length list)) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
379 (diff (- length (* thumbs-max-image-number thumbs-extra-images)))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
380 (nbutlast list diff) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
381 (dolist (img list) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
382 (thumbs-insert-thumb img |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
383 (member img thumbs-marked-list)) |
54186 | 384 (when (= 0 (mod (setq i (1+ i)) thumbs-per-line)) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
385 (newline))) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
386 (unless (bobp) (newline)) |
68409
7ca2eae4cee2
(thumbs-do-thumbs-insertion): Suppress message when
Nick Roberts <nickrob@snap.net.nz>
parents:
68373
diff
changeset
|
387 (if (> diff 0) (message "Type + to display more images.")))) |
54186 | 388 |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
389 (defun thumbs-show-thumbs-list (list &optional dir same-window) |
62891
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
390 (unless (and (display-images-p) |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
391 (image-type-available-p 'jpeg)) |
58c1e48ab7bc
(thumbs-thumbname): The resulting thubname includes a hash value to improve its
Juanma Barranquero <lekktu@gmail.com>
parents:
62692
diff
changeset
|
392 (error "Required image type is not supported in this Emacs session")) |
54186 | 393 (funcall (if same-window 'switch-to-buffer 'pop-to-buffer) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
394 (if dir (concat "*Thumbs: " dir) "*THUMB-View*")) |
54186 | 395 (let ((inhibit-read-only t)) |
396 (erase-buffer) | |
397 (thumbs-mode) | |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
398 (setq thumbs-buffer (current-buffer)) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
399 (if dir (setq default-directory dir)) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
400 (thumbs-do-thumbs-insertion list) |
54186 | 401 (goto-char (point-min)) |
64718
40aaf4d2def3
(thumbs-find-image): Don't make variables automatically buffer local.
Juanma Barranquero <lekktu@gmail.com>
parents:
64091
diff
changeset
|
402 (set (make-local-variable 'thumbs-current-dir) default-directory))) |
54186 | 403 |
404 ;;;###autoload | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
405 (defun thumbs-show-from-dir (dir &optional reg same-window) |
54186 | 406 "Make a preview buffer for all images in DIR. |
407 Optional argument REG to select file matching a regexp, | |
408 and SAME-WINDOW to show thumbs in the same window." | |
409 (interactive "DDir: ") | |
410 (thumbs-show-thumbs-list | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
411 (directory-files dir t (or reg (image-file-name-regexp))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
412 dir same-window)) |
54186 | 413 |
414 ;;;###autoload | |
415 (defun thumbs-dired-show-marked () | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
416 "In dired, make a thumbs buffer with marked files." |
54186 | 417 (interactive) |
418 (thumbs-show-thumbs-list (dired-get-marked-files) nil t)) | |
419 | |
420 ;;;###autoload | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
421 (defun thumbs-dired-show () |
54186 | 422 "In dired, make a thumbs buffer with all files in current directory." |
423 (interactive) | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
424 (thumbs-show-from-dir default-directory nil t)) |
54186 | 425 |
426 ;;;###autoload | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
427 (defalias 'thumbs 'thumbs-show-from-dir) |
54186 | 428 |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
429 (defun thumbs-find-image (img &optional num otherwin) |
68289
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
430 (let ((buffer (current-buffer))) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
431 (funcall |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
432 (if otherwin 'switch-to-buffer-other-window 'switch-to-buffer) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
433 "*Image*") |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
434 (thumbs-view-image-mode) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
435 (setq mode-name |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
436 (concat "image-view-mode: " (file-name-nondirectory img) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
437 " - " (number-to-string num))) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
438 (setq thumbs-buffer buffer) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
439 (let ((inhibit-read-only t)) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
440 (setq thumbs-current-image-filename img |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
441 thumbs-current-tmp-filename nil |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
442 thumbs-image-num (or num 0)) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
443 (delete-region (point-min)(point-max)) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
444 (save-excursion |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
445 (thumbs-insert-image img (thumbs-image-type img) 0))))) |
54186 | 446 |
447 (defun thumbs-find-image-at-point (&optional img otherwin) | |
448 "Display image IMG for thumbnail at point. | |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
449 Use another window if OTHERWIN is t." |
54186 | 450 (interactive) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
451 (let* ((i (or img (thumbs-current-image)))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
452 (thumbs-find-image i (point) otherwin))) |
54186 | 453 |
454 (defun thumbs-find-image-at-point-other-window () | |
455 "Display image for thumbnail at point in the preview buffer. | |
456 Open another window." | |
457 (interactive) | |
458 (thumbs-find-image-at-point nil t)) | |
459 | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
460 (defun thumbs-mouse-find-image (event) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
461 "Display image for thumbnail at mouse click EVENT." |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
462 (interactive "e") |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
463 (mouse-set-point event) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
464 (thumbs-find-image-at-point)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
465 |
54186 | 466 (defun thumbs-call-setroot-command (img) |
467 "Call the setroot program for IMG." | |
468 (run-hooks 'thumbs-before-setroot-hook) | |
469 (shell-command (replace-regexp-in-string | |
470 "\\*" | |
471 (shell-quote-argument (expand-file-name img)) | |
472 thumbs-setroot-command nil t)) | |
473 (run-hooks 'thumbs-after-setroot-hook)) | |
55206
c2c29cafaa74
(time-less-p): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
54193
diff
changeset
|
474 |
54186 | 475 (defun thumbs-set-image-at-point-to-root-window () |
476 "Set the image at point as the desktop wallpaper." | |
477 (interactive) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
478 (thumbs-call-setroot-command |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
479 (thumbs-current-image))) |
54186 | 480 |
481 (defun thumbs-set-root () | |
482 "Set the current image as root." | |
483 (interactive) | |
484 (thumbs-call-setroot-command | |
485 (or thumbs-current-tmp-filename | |
486 thumbs-current-image-filename))) | |
487 | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
488 (defun thumbs-file-alist () |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
489 "Make an alist of elements (POS . FILENAME) for all images in thumb buffer." |
68289
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
490 (with-current-buffer thumbs-buffer |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
491 (save-excursion |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
492 (let (list) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
493 (goto-char (point-min)) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
494 (while (not (eobp)) |
68486
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
495 (unless (eolp) |
68340
5325b795290b
(thumbs-file-alist): Avoid creating duplicate entries.
Nick Roberts <nickrob@snap.net.nz>
parents:
68289
diff
changeset
|
496 (if (thumbs-current-image) |
5325b795290b
(thumbs-file-alist): Avoid creating duplicate entries.
Nick Roberts <nickrob@snap.net.nz>
parents:
68289
diff
changeset
|
497 (push (cons (point-marker) |
5325b795290b
(thumbs-file-alist): Avoid creating duplicate entries.
Nick Roberts <nickrob@snap.net.nz>
parents:
68289
diff
changeset
|
498 (thumbs-current-image)) |
5325b795290b
(thumbs-file-alist): Avoid creating duplicate entries.
Nick Roberts <nickrob@snap.net.nz>
parents:
68289
diff
changeset
|
499 list))) |
68289
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
500 (forward-char 1)) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
501 (nreverse list))))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
502 |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
503 (defun thumbs-file-list () |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
504 "Make a list of file names for all images in thumb buffer." |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
505 (save-excursion |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
506 (let (list) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
507 (goto-char (point-min)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
508 (while (not (eobp)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
509 (if (thumbs-current-image) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
510 (push (thumbs-current-image) list)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
511 (forward-char 1)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
512 (nreverse list)))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
513 |
54186 | 514 (defun thumbs-delete-images () |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
515 "Delete the image at point (and its thumbnail) (or marked files if any)." |
54186 | 516 (interactive) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
517 (let ((files (or thumbs-marked-list (list (thumbs-current-image))))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
518 (if (yes-or-no-p (format "Really delete %d files? " (length files))) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
519 (let ((thumbs-file-list (thumbs-file-alist)) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
520 (inhibit-read-only t)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
521 (dolist (x files) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
522 (let (failure) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
523 (condition-case () |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
524 (progn |
54186 | 525 (delete-file x) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
526 (delete-file (thumbs-thumbname x))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
527 (file-error (setq failure t))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
528 (unless failure |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
529 (when (rassoc x thumbs-file-list) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
530 (goto-char (car (rassoc x thumbs-file-list))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
531 (delete-region (point) (1+ (point)))) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
532 (setq thumbs-marked-list |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
533 (delq x thumbs-marked-list))))))))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
534 |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
535 (defun thumbs-rename-images (newfile) |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
536 "Rename the image at point (and its thumbnail) (or marked files if any)." |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
537 (interactive "FRename to file or directory: ") |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
538 (let ((files (or thumbs-marked-list (list (thumbs-current-image)))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
539 failures) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
540 (if (and (not (file-directory-p newfile)) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
541 thumbs-marked-list) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
542 (if (file-exists-p newfile) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
543 (error "Renaming marked files to file name `%s'" newfile) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
544 (make-directory newfile t))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
545 (if (yes-or-no-p (format "Really rename %d files? " (length files))) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
546 (let ((thumbs-file-list (thumbs-file-alist)) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
547 (inhibit-read-only t)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
548 (dolist (file files) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
549 (let (failure) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
550 (condition-case () |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
551 (if (file-directory-p newfile) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
552 (rename-file file |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
553 (expand-file-name |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
554 (file-name-nondirectory file) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
555 newfile)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
556 (rename-file file newfile)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
557 (file-error (setq failure t) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
558 (push file failures))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
559 (unless failure |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
560 (when (rassoc file thumbs-file-list) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
561 (goto-char (car (rassoc file thumbs-file-list))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
562 (delete-region (point) (1+ (point)))) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
563 (setq thumbs-marked-list |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
564 (delq file thumbs-marked-list))))))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
565 (if failures |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
566 (display-warning 'file-error |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
567 (format "Rename failures for %s into %s" |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
568 failures newfile) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
569 :error)))) |
54186 | 570 |
571 (defun thumbs-kill-buffer () | |
572 "Kill the current buffer." | |
573 (interactive) | |
63155
911109216331
Don't set `auto-image-file-mode'. Do not create the thumbnails directory on
Juanma Barranquero <lekktu@gmail.com>
parents:
63078
diff
changeset
|
574 (quit-window t (selected-window))) |
54186 | 575 |
576 (defun thumbs-show-image-num (num) | |
577 "Show the image with number NUM." | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
578 (let ((image-buffer (get-buffer-create "*Image*"))) |
68289
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
579 (let ((img (cdr (nth (1- num) (thumbs-file-alist))))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
580 (with-current-buffer image-buffer |
68289
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
581 (setq mode-name |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
582 (concat "image-view-mode: " (file-name-nondirectory img) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
583 " - " (number-to-string num))) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
584 (let ((inhibit-read-only t)) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
585 (erase-buffer) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
586 (thumbs-insert-image img (thumbs-image-type img) 0) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
587 (goto-char (point-min)))) |
55213
a911edb6dadf
(thumbs-delete-images): Fix formatting of prompt.
John Paul Wallington <jpw@pobox.com>
parents:
55206
diff
changeset
|
588 (setq thumbs-image-num num |
68289
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
589 thumbs-current-image-filename img)))) |
54186 | 590 |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
591 (defun thumbs-previous-image () |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
592 "Show the previous image." |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
593 (interactive) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
594 (let* ((i (- thumbs-image-num 1)) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
595 (number (length (thumbs-file-alist)))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
596 (if (= i 0) (setq i (1- number))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
597 (thumbs-show-image-num i))) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
598 |
54186 | 599 (defun thumbs-next-image () |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
600 "Show the next image." |
54186 | 601 (interactive) |
602 (let* ((i (1+ thumbs-image-num)) | |
68289
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
603 (number (length (thumbs-file-alist)))) |
be0164ac55f8
(thumbs-buffer): New variable. Make it buffer local.
Nick Roberts <nickrob@snap.net.nz>
parents:
66568
diff
changeset
|
604 (if (= i number) (setq i 1)) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
605 (thumbs-show-image-num i))) |
54186 | 606 |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
607 (defun thumbs-display-thumbs-buffer () |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
608 "Display the associated thumbs buffer." |
54186 | 609 (interactive) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
610 (display-buffer thumbs-buffer)) |
54186 | 611 |
612 (defun thumbs-redraw-buffer () | |
613 "Redraw the current thumbs buffer." | |
614 (let ((p (point)) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
615 (inhibit-read-only t) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
616 (files (thumbs-file-list))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
617 (erase-buffer) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
618 (thumbs-do-thumbs-insertion files) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
619 (goto-char p))) |
55206
c2c29cafaa74
(time-less-p): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
54193
diff
changeset
|
620 |
54186 | 621 (defun thumbs-mark () |
622 "Mark the image at point." | |
623 (interactive) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
624 (let ((elt (thumbs-current-image))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
625 (unless elt |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
626 (error "No image here")) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
627 (push elt thumbs-marked-list) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
628 (let ((inhibit-read-only t)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
629 (delete-char 1) |
68409
7ca2eae4cee2
(thumbs-do-thumbs-insertion): Suppress message when
Nick Roberts <nickrob@snap.net.nz>
parents:
68373
diff
changeset
|
630 (thumbs-insert-thumb elt t))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
631 (when (eolp) (forward-char))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
632 |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
633 (defun thumbs-unmark () |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
634 "Unmark the image at point." |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
635 (interactive) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
636 (let ((elt (thumbs-current-image))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
637 (unless elt |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
638 (error "No image here")) |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
639 (setq thumbs-marked-list (delete elt thumbs-marked-list)) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
640 (let ((inhibit-read-only t)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
641 (delete-char 1) |
68409
7ca2eae4cee2
(thumbs-do-thumbs-insertion): Suppress message when
Nick Roberts <nickrob@snap.net.nz>
parents:
68373
diff
changeset
|
642 (thumbs-insert-thumb elt nil))) |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
643 (when (eolp) (forward-char))) |
55206
c2c29cafaa74
(time-less-p): Remove.
Juanma Barranquero <lekktu@gmail.com>
parents:
54193
diff
changeset
|
644 |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
645 ;; cleaning of old temp files |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
646 (mapc 'delete-file |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
647 (directory-files (thumbs-temp-dir) t thumbs-temp-prefix)) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
648 |
54186 | 649 ;; Image modification routines |
650 | |
651 (defun thumbs-modify-image (action &optional arg) | |
652 "Call convert to do ACTION on image with argument ARG. | |
60920
242e5edee3ce
* complete.el, thumbs.el: Replace `legal' with `valid'.
Werner LEMBERG <wl@gnu.org>
parents:
59996
diff
changeset
|
653 ACTION and ARG should be a valid convert command." |
54186 | 654 (interactive "sAction: \nsValue: ") |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
655 (let* ((buffer-read-only nil) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
656 (old thumbs-current-tmp-filename) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
657 (tmp (thumbs-temp-file))) |
54186 | 658 (erase-buffer) |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
659 (thumbs-call-convert (or old thumbs-current-image-filename) |
54186 | 660 tmp |
661 action | |
662 (or arg "")) | |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
663 (save-excursion |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
664 (thumbs-insert-image tmp 'jpeg 0)) |
54186 | 665 (setq thumbs-current-tmp-filename tmp))) |
666 | |
667 (defun thumbs-emboss-image (emboss) | |
668 "Emboss the image with value EMBOSS." | |
669 (interactive "nEmboss value: ") | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
670 (if (or (< emboss 3) (> emboss 31) (zerop (% emboss 2))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
671 (error "Arg must be an odd number between 3 and 31")) |
54186 | 672 (thumbs-modify-image "emboss" (number-to-string emboss))) |
673 | |
674 (defun thumbs-monochrome-image () | |
675 "Turn the image to monochrome." | |
676 (interactive) | |
677 (thumbs-modify-image "monochrome")) | |
678 | |
679 (defun thumbs-negate-image () | |
680 "Negate the image." | |
681 (interactive) | |
682 (thumbs-modify-image "negate")) | |
683 | |
684 (defun thumbs-rotate-left () | |
685 "Rotate the image 90 degrees counter-clockwise." | |
686 (interactive) | |
687 (thumbs-modify-image "rotate" "270")) | |
688 | |
689 (defun thumbs-rotate-right () | |
690 "Rotate the image 90 degrees clockwise." | |
691 (interactive) | |
692 (thumbs-modify-image "rotate" "90")) | |
693 | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
694 (defun thumbs-current-image () |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
695 "Return the name of the image file name at point." |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
696 (get-text-property (point) 'thumb-image-file)) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
697 |
54186 | 698 (defun thumbs-forward-char () |
699 "Move forward one image." | |
700 (interactive) | |
701 (forward-char) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
702 (while (and (not (eobp)) (not (thumbs-current-image))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
703 (forward-char)) |
54186 | 704 (thumbs-show-name)) |
705 | |
706 (defun thumbs-backward-char () | |
707 "Move backward one image." | |
708 (interactive) | |
709 (forward-char -1) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
710 (while (and (not (bobp)) (not (thumbs-current-image))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
711 (forward-char -1)) |
54186 | 712 (thumbs-show-name)) |
713 | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
714 (defun thumbs-backward-line () |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
715 "Move up one line." |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
716 (interactive) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
717 (forward-line -1) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
718 (thumbs-show-name)) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
719 |
54186 | 720 (defun thumbs-forward-line () |
721 "Move down one line." | |
722 (interactive) | |
723 (forward-line 1) | |
724 (thumbs-show-name)) | |
725 | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
726 (defun thumbs-show-more-images (&optional arg) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
727 "Show more than `thumbs-max-image-number' images, if present." |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
728 (interactive "P") |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
729 (or arg (setq arg 1)) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
730 (setq thumbs-extra-images (+ thumbs-extra-images arg)) |
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
731 (thumbs-dired-show)) |
54186 | 732 |
733 (defun thumbs-show-name () | |
734 "Show the name of the current file." | |
735 (interactive) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
736 (let ((f (thumbs-current-image))) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
737 (and f (message "%s [%s]" f (thumbs-file-size f))))) |
54186 | 738 |
739 (defun thumbs-save-current-image () | |
740 "Save the current image." | |
741 (interactive) | |
742 (let ((f (or thumbs-current-tmp-filename | |
743 thumbs-current-image-filename)) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
744 (sa (read-from-minibuffer "Save image file as: " |
54186 | 745 thumbs-current-image-filename))) |
746 (copy-file f sa))) | |
747 | |
748 (defun thumbs-dired () | |
749 "Use `dired' on the current thumbs directory." | |
750 (interactive) | |
751 (dired thumbs-current-dir)) | |
752 | |
753 ;; thumbs-mode | |
754 | |
755 (defvar thumbs-mode-map | |
756 (let ((map (make-sparse-keymap))) | |
757 (define-key map [return] 'thumbs-find-image-at-point) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
758 (define-key map [mouse-2] 'thumbs-mouse-find-image) |
54186 | 759 (define-key map [(meta return)] 'thumbs-find-image-at-point-other-window) |
760 (define-key map [(control return)] 'thumbs-set-image-at-point-to-root-window) | |
761 (define-key map [delete] 'thumbs-delete-images) | |
762 (define-key map [right] 'thumbs-forward-char) | |
763 (define-key map [left] 'thumbs-backward-char) | |
764 (define-key map [up] 'thumbs-backward-line) | |
765 (define-key map [down] 'thumbs-forward-line) | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
766 (define-key map "+" 'thumbs-show-more-images) |
54186 | 767 (define-key map "d" 'thumbs-dired) |
768 (define-key map "m" 'thumbs-mark) | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
769 (define-key map "u" 'thumbs-unmark) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
770 (define-key map "R" 'thumbs-rename-images) |
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
771 (define-key map "x" 'thumbs-delete-images) |
54186 | 772 (define-key map "s" 'thumbs-show-name) |
773 (define-key map "q" 'thumbs-kill-buffer) | |
774 map) | |
775 "Keymap for `thumbs-mode'.") | |
776 | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
777 (put 'thumbs-mode 'mode-class 'special) |
54186 | 778 (define-derived-mode thumbs-mode |
779 fundamental-mode "thumbs" | |
780 "Preview images in a thumbnails buffer" | |
68486
6511ba48ed7a
(thumbs-marked-list): Make buffer-local and
Nick Roberts <nickrob@snap.net.nz>
parents:
68409
diff
changeset
|
781 (setq buffer-read-only t)) |
54186 | 782 |
783 (defvar thumbs-view-image-mode-map | |
784 (let ((map (make-sparse-keymap))) | |
785 (define-key map [prior] 'thumbs-previous-image) | |
786 (define-key map [next] 'thumbs-next-image) | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
787 (define-key map "^" 'thumbs-display-thumbs-buffer) |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
788 (define-key map "-" 'thumbs-shrink-image) |
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
789 (define-key map "+" 'thumbs-enlarge-image) |
54186 | 790 (define-key map "<" 'thumbs-rotate-left) |
791 (define-key map ">" 'thumbs-rotate-right) | |
792 (define-key map "e" 'thumbs-emboss-image) | |
68373
3bff02a6d438
(thumbs-new-image-size): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
68362
diff
changeset
|
793 (define-key map "r" 'thumbs-resize-image) |
54186 | 794 (define-key map "s" 'thumbs-save-current-image) |
795 (define-key map "q" 'thumbs-kill-buffer) | |
56934
ff141f26a0cb
(thumbs-view-image-mode-map): Fix `thumbs-set-root' command name typo.
John Paul Wallington <jpw@pobox.com>
parents:
55827
diff
changeset
|
796 (define-key map "w" 'thumbs-set-root) |
54186 | 797 map) |
798 "Keymap for `thumbs-view-image-mode'.") | |
799 | |
800 ;; thumbs-view-image-mode | |
55827
c5c73c8c2b3e
Don't include cl. Don't bother with old Emacs versions.
Richard M. Stallman <rms@gnu.org>
parents:
55221
diff
changeset
|
801 (put 'thumbs-view-image-mode 'mode-class 'special) |
54186 | 802 (define-derived-mode thumbs-view-image-mode |
56934
ff141f26a0cb
(thumbs-view-image-mode-map): Fix `thumbs-set-root' command name typo.
John Paul Wallington <jpw@pobox.com>
parents:
55827
diff
changeset
|
803 fundamental-mode "image-view-mode" |
ff141f26a0cb
(thumbs-view-image-mode-map): Fix `thumbs-set-root' command name typo.
John Paul Wallington <jpw@pobox.com>
parents:
55827
diff
changeset
|
804 (setq buffer-read-only t)) |
54186 | 805 |
806 ;;;###autoload | |
807 (defun thumbs-dired-setroot () | |
62692
6dd34b690fa9
(thumbs-thumbsdir-max-size, thumbs-temp-file, thumbs-cleanup-thumbsdir,
Juanma Barranquero <lekktu@gmail.com>
parents:
60920
diff
changeset
|
808 "In dired, call the setroot program on the image at point." |
54186 | 809 (interactive) |
810 (thumbs-call-setroot-command (dired-get-filename))) | |
811 | |
812 ;; Modif to dired mode map | |
68362
3b10b20b3387
(thumbs-extra-images): New variable. Make it buffer-local
Nick Roberts <nickrob@snap.net.nz>
parents:
68340
diff
changeset
|
813 (define-key dired-mode-map "\C-ta" 'thumbs-dired-show) |
54186 | 814 (define-key dired-mode-map "\C-tm" 'thumbs-dired-show-marked) |
815 (define-key dired-mode-map "\C-tw" 'thumbs-dired-setroot) | |
816 | |
817 (provide 'thumbs) | |
818 | |
62927
bb23fe0bf1d3
(thumbs-mode): Fix misuse of make-variable-buffer-local.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
62891
diff
changeset
|
819 ;; arch-tag: f9ac1ef8-83fc-42c0-8069-1fae43fd2e5c |
54186 | 820 ;;; thumbs.el ends here |