67302
|
1 ;;; tumme.el --- use dired to browse and manipulate your images
|
|
2 ;;
|
|
3 ;; Copyright (C) 2005 Free Software Foundation, Inc.
|
|
4 ;;
|
|
5 ;; Version: 0.4.10
|
68404
|
6 ;; Keywords: multimedia
|
67302
|
7 ;; Author: Mathias Dahl <mathias.rem0veth1s.dahl@gmail.com>
|
|
8
|
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
14 ;; any later version.
|
|
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
|
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
24 ;; Boston, MA 02110-1301, USA.
|
|
25
|
|
26 ;;; Commentary:
|
|
27 ;;
|
|
28 ;; BACKGROUND
|
|
29 ;; ==========
|
|
30 ;;
|
|
31 ;; I needed a program to browse, organize and tag my pictures. I got
|
|
32 ;; tired of the old gallery program I used as it did not allow
|
|
33 ;; multi-file operations easily. Also, it put things out of my
|
|
34 ;; control. Image viewing programs I tested did not allow multi-file
|
|
35 ;; operations or did not do what I wanted it to.
|
|
36 ;;
|
|
37 ;; So, I got the idea to use the wonderful functionality of Emacs and
|
|
38 ;; `dired' to do it. It would allow me to do almost anything I wanted,
|
|
39 ;; which is basically just to browse all my pictures in an easy way,
|
|
40 ;; letting me manipulate and tag them in various ways. `dired' already
|
|
41 ;; provide all the file handling and navigation facilities; I only
|
|
42 ;; needed to add some functions to display the images.
|
|
43 ;;
|
|
44 ;; I briefly tried out thumbs.el, and although it seemed more
|
|
45 ;; powerful than this package, it did not work the way I wanted to. It
|
|
46 ;; was too slow to created thumbnails of all files in a directory (I
|
|
47 ;; currently keep all my 2000+ images in the same directory) and
|
|
48 ;; browsing the thumbnail buffer was slow too. tumme.el will not
|
|
49 ;; create thumbnails until they are needed and the browsing is done
|
|
50 ;; quickly and easily in dired. I copied a great deal of ideas and
|
|
51 ;; code from there though... :)
|
|
52 ;;
|
|
53 ;; About the name: tumme means thumb in Swedish and it is used for
|
|
54 ;; working with thumbnails, so... :) If you want to know how to
|
|
55 ;; pronounce it, go to the page on EmacsWiki and download the .ogg
|
|
56 ;; file from there.
|
|
57 ;;
|
|
58 ;; `tumme' stores the thumbnail files in `tumme-dir' using the file
|
|
59 ;; name format ORIGNAME.thumb.ORIGEXT. For example
|
|
60 ;; ~/.tumme/myimage01.thumb.jpg. The "database" is for now just a
|
|
61 ;; plain text file with the following format:
|
|
62 ;;
|
|
63 ;; file-name-non-directory;comment:comment-text;tag1;tag2;tag3;...;tagN
|
|
64 ;;
|
|
65 ;;
|
|
66 ;; PREREQUISITES
|
|
67 ;; =============
|
|
68 ;;
|
|
69 ;; * The ImageMagick package. Currently, `convert' and `mogrify' are
|
|
70 ;; used. Find it here: http://www.imagemagick.org.
|
|
71 ;;
|
|
72 ;; * For non-lossy rotation of JPEG images, the JpegTRAN program is
|
|
73 ;; needed.
|
|
74 ;;
|
|
75 ;; * For `tumme-get-exif-data' and `tumme-write-exif-data' to work,
|
|
76 ;; the command line tool `exiftool' is needed. It can be found here:
|
|
77 ;; http://www.sno.phy.queensu.ca/~phil/exiftool/. These two functions
|
|
78 ;; are, among other things, used for writing comments to image files
|
|
79 ;; using `tumme-thumbnail-set-image-description' and to create
|
|
80 ;; "unique" file names using `tumme-get-exif-file-name' (used by
|
|
81 ;; `tumme-copy-with-exif-file-name').
|
|
82 ;;
|
|
83 ;;
|
|
84 ;; USAGE
|
|
85 ;; =====
|
|
86 ;;
|
|
87 ;; If you plan to use tumme much, setting up key bindings for it in
|
|
88 ;; dired is a good idea:
|
|
89 ;;
|
|
90 ;; (tumme-setup-dired-keybindings)
|
|
91 ;;
|
|
92 ;; Next, do M-x tumme-dired RET. This will ask you for a directory
|
|
93 ;; where image files are stored, setup a useful window configuration
|
|
94 ;; and enable the two special modes that tumme provides. NOTE: If you
|
|
95 ;; do not want tumme to split your windows, call it with a prefix
|
|
96 ;; argument.
|
|
97 ;;
|
|
98 ;; Start viewing thumbnails by doing C-S-n and C-S-p to go up and down
|
|
99 ;; in the dired buffer while at the same time displaying a thumbnail
|
|
100 ;; image. The thumbnail images will be created on the fly, and
|
|
101 ;; cached. This means that the first time you browse your images, it
|
|
102 ;; will be a bit slow because the thumbnails are created. If you want
|
|
103 ;; to avoid this, you can pre-create the thumbnail images by marking
|
|
104 ;; all images in dired (% m \.jpg$ RET) and then do M-x
|
|
105 ;; tumme-create-thumbs.
|
|
106 ;;
|
|
107 ;; Next, try `tumme-display-thumbs' (C-t d). If no file is marked, a
|
|
108 ;; thumbnail for the file at point will show up in
|
|
109 ;; `tumme-thumbnail-buffer'. If one or more files are marked,
|
|
110 ;; thumbnails for those files will be displayed.
|
|
111 ;;
|
|
112 ;; Pressing TAB will switch to the window containing the
|
|
113 ;; `tumme-thumbnail-buffer' buffer. In there you can move between
|
|
114 ;; thumbnail images and display a semi-sized version in an Emacs
|
|
115 ;; buffer (RET), or the original image in an external viewer
|
|
116 ;; (C-RET). By pressing SPC or DEL you will navigate back and fort
|
|
117 ;; while at the same time displaying each image in Emacs. You can also
|
|
118 ;; navigate using arrow keys. Comment a file by pressing "c". Press
|
|
119 ;; TAB to get back to dired.
|
|
120 ;;
|
|
121 ;; While in dired mode, you can tag and comment files, you can tell
|
|
122 ;; `tumme' to mark files with a certain tag (using a regexp) etc.
|
|
123 ;;
|
|
124 ;; The easiest way to see the available commands is to use the Tumme
|
|
125 ;; menus added in tumme-thumbnail-mode and dired-mode.
|
|
126 ;;
|
|
127 ;;
|
|
128 ;; LIMITATIONS
|
|
129 ;; ===========
|
|
130 ;;
|
|
131 ;; * In order to work well, `tumme' require that all your images have
|
|
132 ;; unique names. The reason is the way thumbnail file names are
|
|
133 ;; generated. I will probably not fix this problem as my images all
|
|
134 ;; have unique names.
|
|
135 ;;
|
|
136 ;; * Supports all image formats that Emacs and convert supports, but
|
|
137 ;; the thumbnails are hard-coded to JPEG format.
|
|
138 ;;
|
|
139 ;; * WARNING: The "database" format used might be changed so keep a
|
|
140 ;; backup of `tumme-db-file' when testing new versions.
|
|
141 ;;
|
|
142 ;;
|
|
143 ;;; History:
|
|
144 ;; ========
|
|
145 ;;
|
|
146 ;; Version 0.1, 2005-04-16
|
|
147 ;;
|
|
148 ;; * First release, only browsing support for now.
|
|
149 ;;
|
|
150 ;; Version 0.2, 2005-04-21
|
|
151 ;;
|
|
152 ;; * Changed calls to dired-filename-at-point to dired-get-filename
|
|
153 ;;
|
|
154 ;; Version 0.3, 2005-04-25
|
|
155 ;;
|
|
156 ;; Quite a lot of changes:
|
|
157 ;;
|
|
158 ;; * Added basic image tagging support. No commands that make use of
|
|
159 ;; it yet.
|
|
160 ;;
|
|
161 ;; * Added text properties for the thumbnail images to be able to
|
|
162 ;; track where they came from originally. Used in `tumme-mode'.
|
|
163 ;;
|
|
164 ;; * Added `tumme-mode' to be used when navigating the thumbnail
|
|
165 ;; buffer. Currently, there are commands to mark, unmark, flag and
|
|
166 ;; jump to the original file in associated dired buffer.
|
|
167 ;;
|
|
168 ;; * When moving around in the thumbnail buffer (in `tumme-mode'), the
|
|
169 ;; user can turn on tracking of the movements and let them be
|
|
170 ;; mirrored in the associated dired buffer.
|
|
171 ;;
|
|
172 ;; * In this version I have been looking at some ideas in thumbs.el,
|
|
173 ;; for example the image margin and relief and the `thumbs-mode'
|
|
174 ;; which I copied and made the `tumme-mode' from.
|
|
175 ;;
|
|
176 ;; Version 0.4, 2005-05-02
|
|
177 ;;
|
|
178 ;; * Renamed the functions that are to be used in `tumme-mode' in the
|
|
179 ;; thumbnail buffer.
|
|
180 ;;
|
|
181 ;; * The mark, unmark and flag commands in `tumme-mode' now also moves
|
|
182 ;; to next thumbnail, like how dired normally works.
|
|
183 ;;
|
|
184 ;; * Added `tumme-mode-line-up', `tumme-display-thumbs-append' and
|
|
185 ;; `tumme-mode-delete-char'.
|
|
186 ;;
|
|
187 ;; * Each thumbnail's tags is now displayed when navigating among the
|
|
188 ;; thumbnails in the thumbnail buffer.
|
|
189 ;;
|
|
190 ;; * Added simple slideshow functionality.
|
|
191 ;;
|
|
192 ;; Version 0.4.1, 2005-05-05
|
|
193 ;;
|
|
194 ;; * Fixed bug in `tumme-flag-thumb-original-file'
|
|
195 ;;
|
|
196 ;; * Added commands to display original image in external viewer
|
|
197 ;; (`tumme-display-external') and in a Emacs buffer
|
|
198 ;; (`tumme-display-image').
|
|
199 ;;
|
|
200 ;; * Minor code clean-up
|
|
201 ;;
|
|
202 ;; * Renamed some functions back again...
|
|
203 ;;
|
|
204 ;; * Added rotation of thumbnail images (90 degrees left and right)
|
|
205 ;;
|
|
206 ;; Version 0.4.2, 2005-05-06
|
|
207 ;;
|
|
208 ;; * Removed need for `tumme-display-image-size' in
|
|
209 ;; `tumme-display-image'. Now, the maximum image size that fits in
|
|
210 ;; `tumme-display-buffer' is calculated automatically. Introduced
|
|
211 ;; two correction variables, `tumme-display-window-width-correction'
|
|
212 ;; and `tumme-display-window-height-correction' to be used to
|
|
213 ;; correct width and height depending on width and height of window
|
|
214 ;; decorations, fringes etc. This works really well!
|
|
215 ;;
|
|
216 ;; Version 0.4.3, 2005-05-07
|
|
217 ;;
|
|
218 ;; * Added menus to `dired-mode' and `tumme-mode'
|
|
219 ;;
|
|
220 ;; * Added `tumme-mark-and-display-next'
|
|
221 ;;
|
|
222 ;; * Added `tumme-jump-thumbnail-buffer'
|
|
223 ;;
|
|
224 ;; * Bound TAB in `dired-mode-map' and `tumme-mode-map' to
|
|
225 ;; `tumme-jump-thumbnail-buffer' and
|
|
226 ;; `tumme-jump-original-dired-buffer', respectively.
|
|
227 ;;
|
|
228 ;; * Changed `tumme-display-image' to be more general. Now, it can be
|
|
229 ;; used from both thumbnail buffer and dired buffer by calling
|
|
230 ;; `tumme-display-thumbnail-original-image' and
|
|
231 ;; `tumme-display-dired-image', respectively.
|
|
232 ;;
|
|
233 ;; Version 0.4.4, 2005-05-10
|
|
234 ;;
|
|
235 ;; * Added `tumme-get-exif-file-name' and
|
|
236 ;; `tumme-copy-with-exif-file-name'. These commands might not be
|
|
237 ;; useful for all people because they are very specific. See the
|
|
238 ;; documentation for each function for more information.
|
|
239 ;;
|
|
240 ;; * Added `tumme-display-next-thumbnail-original' and
|
|
241 ;; `tumme-display-previous-thumbnail-original' to be used for easy
|
|
242 ;; image browsing in thumbnail buffer.
|
|
243 ;;
|
|
244 ;; * Added support for comments. New function
|
|
245 ;; `tumme-comment-thumbnail' added, to be used in thumbnail buffer.
|
|
246 ;;
|
|
247 ;; * Added `tumme-mark-tagged-files'. Use it in dired buffer to mark
|
|
248 ;; tagged files.
|
|
249 ;;
|
|
250 ;; * Added `mouse-face' property `highlight' for mouse highlighting
|
|
251 ;; and had to add a space between each thumbnail to avoid whole rows
|
|
252 ;; to be highlighted. Doing this meant that I had to update
|
|
253 ;; `tumme-line-up' too...
|
|
254 ;;
|
|
255 ;; * Added `tumme-mouse-display-image'. Use mouse-2 to display image
|
|
256 ;; thumbnail when is highlighted.
|
|
257 ;;
|
|
258 ;; * As suggested by Ehud Karni on gnu.emacs.help, changed
|
|
259 ;; `tumme-window-DIMENSION-pixels' to use `frame-char-DIMENSION'
|
|
260 ;; instead of `frame-pixel-DIMENSION'. Feels better
|
|
261 ;;
|
|
262 ;; * Corrected a bug in `tumme-window-height-pixels'. I did not know
|
|
263 ;; that the mode-line consumed one line. Also, after experimenting, it
|
|
264 ;; seems that the only correction needed for the image display width
|
|
265 ;; is one single pixel. I left the corection variables in there, just
|
|
266 ;; in case someone has a system that differs.
|
|
267 ;;
|
|
268 ;; Version 0.4.5, 2005-05-19
|
|
269 ;;
|
|
270 ;; * Added `tumme-line-up-dynamic' that calculates the number of
|
|
271 ;; thumbnails that will fit in the thumbnail buffer's window and
|
|
272 ;; `tumme-line-up-interactive' that asks the user.
|
|
273 ;;
|
|
274 ;; * Changed `tumme-display-thumbs' to call one of the `tumme-line-up'
|
|
275 ;; functions instead of doing the line-up itself.
|
|
276 ;;
|
|
277 ;; * Finally! Added experimental gallery creation. See customizable
|
|
278 ;; variables `tumme-gallery-dir', `tumme-gallery-image-root-url' and
|
|
279 ;; `tumme-gallery-thumb-image-root-url' and new command
|
|
280 ;; `tumme-gallery-generate'. Not beatiful, but it works quite
|
|
281 ;; well. Probably needs some CSS-stuff in it eventually. Also, I'm not
|
|
282 ;; sure this is the way I want to generate my image galleries in the
|
|
283 ;; future. After all, static pages cannot do what dynamic pages using
|
|
284 ;; PHP et al can do. Serves like a proof-of-concept of the tagging
|
|
285 ;; though.
|
|
286 ;;
|
|
287 ;; * Added option to hide images with certain tags. See
|
|
288 ;; `tumme-gallery-hidden-tags'.
|
|
289 ;;
|
|
290 ;; * Added `tumme-tag-thumbnail' for tagging files from thumbnail
|
|
291 ;; buffer.
|
|
292 ;;
|
|
293 ;; * Added `tumme-tag-remove' and `tumme-tag-thumbnail-remove' so that
|
|
294 ;; you can remove tags. Sorry if I have kept you waiting for
|
|
295 ;; this... :)
|
|
296 ;;
|
|
297 ;; * Added option `tumme-append-when-browsing' and new command
|
|
298 ;; `tumme-toggle-append-browsing'.
|
|
299 ;;
|
|
300 ;; Version 0.4.6, 2005-05-21
|
|
301 ;;
|
|
302 ;; * Changed `tumme-thumb-name' to always use ".jpg" as file extension
|
|
303 ;; for thumbnail files, instead of using the extension from the
|
|
304 ;; original file's name. This was a very easy way to open up for
|
|
305 ;; allowing browsing of all image file types that Emacs support,
|
|
306 ;; assuming ImageMagick supports it too.
|
|
307 ;;
|
|
308 ;; * Fixed bug in `tumme-create-thumb' `tumme-rotate-thumbnail' and
|
|
309 ;; `tumme-display-image' by adding quotes around the file names. The
|
|
310 ;; conversion failed if the file name, or path, contained a
|
|
311 ;; space. Also expanded the file name, as convert (or is it bash?)
|
|
312 ;; does not work as expected for paths like "~/.tumme...".
|
|
313 ;;
|
|
314 ;; * Fixed another "space bug" :) in `tumme-display-external'.
|
|
315 ;;
|
|
316 ;; * In call to convert, added "jpeg:" in front of the output file
|
|
317 ;; name, so that all generated files becomes JPEG files. For now, only
|
|
318 ;; useful if `tumme-temp-image-file' does not end in .jpg.
|
|
319 ;;
|
|
320 ;; Version 0.4.7, 2005-05-26
|
|
321 ;;
|
|
322 ;; * Change header line of tumme.el so that it does not wrap and cause
|
|
323 ;; evaluation problems for people getting the source from Usenet.
|
|
324 ;;
|
|
325 ;; * Changed `tumme-write-tag' slightly to get better performance when
|
|
326 ;; tagging many files.
|
|
327 ;;
|
|
328 ;; * Fixed bug in `tumme-create-gallery-lists' that made it puke if
|
|
329 ;; there was empty lines in the database. Changed the code so that it
|
|
330 ;; does not car about that. Also, fixed `tumme-remove-tag' so that it
|
|
331 ;; tries not to add empty lines at the end of the database.
|
|
332 ;;
|
|
333 ;; * Changed all commands that execute shell commands to be
|
|
334 ;; configurable using the `tumme-cmd-x' custom variables. This makes
|
|
335 ;; it easier to switch among different image conversion tools which
|
|
336 ;; might use different syntax and options.
|
|
337 ;;
|
|
338 ;; * Added `tumme-toggle-dired-display-properties'.
|
|
339 ;;
|
|
340 ;; * Added `tumme-thumb-file-name-format' and changed
|
|
341 ;; `tumme-thumb-name' to make it possible to configure the format of
|
|
342 ;; thumbnail files. Did not make it customizable yet though. It might
|
|
343 ;; be a bad idea to be able to switch between formats...
|
|
344 ;;
|
|
345 ;; * Changed `tumme-display-window' so that it looks for tumme's
|
|
346 ;; display window in all frames. Useful if you want to create an own
|
|
347 ;; frame for displaying the temporary image.
|
|
348 ;;
|
|
349 ;; * After changing the call to `get-window-with-predicate' to scan
|
|
350 ;; all frames for tumme's special buffers in visible windows, and also
|
|
351 ;; changing the way tumme tracks thumbnail movement in the dired
|
|
352 ;; buffer (now using `set-buffer' together with `set-window-point'),
|
|
353 ;; tumme now works quite happily with all three buffers in different
|
|
354 ;; frames. This empowers the user to setup the special buffers the way
|
|
355 ;; that best fits his need at the time. Jumping between dired and
|
|
356 ;; `tumme-thumbnail-buffer' work independent on in which frames they
|
|
357 ;; are.
|
|
358 ;;
|
|
359 ;; * Renamed `tumme-track-movement-in-dired' to
|
|
360 ;; `tumme-toggle-movement-tracking'.
|
|
361 ;;
|
|
362 ;; * Added `tumme-track-thumbnail' for movement tracking from dired
|
|
363 ;; buffer, analoguous to the tracking done in thumbnail buffer. Both
|
|
364 ;; uses the same custom variable `tumme-track-movement' which can be
|
|
365 ;; toggled on and off with `tumme-toggle-movement-tracking'. This is
|
|
366 ;; neat. :) Changed `tumme-setup-dired-keybindings' to make use of
|
|
367 ;; this in the best way. Read more about this there.
|
|
368 ;;
|
|
369 ;; Version 0.4.8, 2005-06-05
|
|
370 ;;
|
|
371 ;; * Changed `tumme-display-dired-image' and
|
|
372 ;; `tumme-display-thumbnail-original-image' so that when called with a
|
|
373 ;; prefix argument, the image is not resized in the display
|
|
374 ;; buffer. This will be useful for later additions of image
|
|
375 ;; manipulation commands.
|
|
376 ;;
|
|
377 ;; * Added `tumme-kill-buffer-and-window' to make it easy to kill the
|
|
378 ;; tumme buffers.
|
|
379 ;;
|
|
380 ;; * Renamed `tumme-mode' to `tumme-thumbnail-mode'.
|
|
381 ;;
|
|
382 ;; * `tumme-tag-thumbnail' and `tumme-tag-thumbnail-remove' now
|
|
383 ;; updates the tags property for the thumbnail.
|
|
384 ;;
|
|
385 ;; * Added `tumme-dired-display-external' to display images in
|
|
386 ;; external viewer from dired buffer.
|
|
387 ;;
|
|
388 ;; * Added support for multiple files in `tumme-remove-tag' to
|
|
389 ;; increase performance.
|
|
390 ;;
|
|
391 ;; * Added `tumme-display-image-mode' so that we can add image
|
|
392 ;; manipulation commands there.
|
|
393 ;;
|
|
394 ;; * Added call to `tumme-display-thumb-properties' in
|
|
395 ;; `tumme-track-thumbnail'.
|
|
396 ;;
|
|
397 ;; * Added command `tumme-display-current-image-in-full-size' to be
|
|
398 ;; used in `tumme-display-image-mode'.
|
|
399 ;;
|
|
400 ;; * Changed `tumme-display-image' to call
|
|
401 ;; `tumme-create-display-image-buffer' so that we are sure that
|
|
402 ;; `tumme-display-image-buffer' is always available.
|
|
403 ;;
|
|
404 ;; * Added optional prefix argument to `tumme-dired-folder' that tells
|
|
405 ;; it to skip the window splitting and just creates the needed
|
|
406 ;; buffers.
|
|
407 ;;
|
|
408 ;; * Fixed bug somewhere that relied on `tumme-dired-folder' having
|
|
409 ;; created the `tumme-display-image-buffer'. Now `tumme-dired-folder'
|
|
410 ;; *should* not be necessary to call at all, just convenient.
|
|
411 ;;
|
|
412 ;; * Added tracking to `tumme-mouse-display-image'.
|
|
413 ;;
|
|
414 ;; * Added `tumme-mouse-select-thumbnail' and bound mouse-1 to it, so
|
|
415 ;; that selecting a thumbnail will track the original file.
|
|
416 ;;
|
|
417 ;; * Added three new custom variables, `tumme-cmd-ACTION-program' to
|
|
418 ;; make the command options cleaner and easier to read.
|
|
419 ;;
|
|
420 ;; * Added `tumme-display-properties-format' and
|
|
421 ;; `tumme-format-properties-string' to make it possible to configure
|
|
422 ;; the display format of the image file's properties.
|
|
423 ;;
|
|
424 ;; * Added missing (require 'format-spec)
|
|
425 ;;
|
|
426 ;; Version 0.4.9, 2005-09-25
|
|
427 ;;
|
|
428 ;; * Fixed bug in `tumme-display-thumbs'. If a thumbnail file could
|
|
429 ;; not be created for some reason (bad file for example), even if
|
|
430 ;; several other thumbnails was created sucessfully, the code
|
|
431 ;; generated an error and never continued doing the line-up.
|
|
432 ;;
|
|
433 ;; * Made tumme.el pass the M-x checkdoc test, phew!
|
|
434 ;;
|
|
435 ;; * Added `tumme-rotate-original', `tumme-rotate-original-left' and
|
|
436 ;; `tumme-rotate-original-right' to rotate the original image from
|
|
437 ;; thumbnail view. By default it uses JpegTRAN to rotate the images
|
|
438 ;; non-lossy. Only works on JPEG images. The two new commands were
|
|
439 ;; added to thumbnail mode. Thanks to Colin Marquardt who told me
|
|
440 ;; about the "-copy all" option to jpegtran.
|
|
441 ;;
|
|
442 ;; * Added the functions `tumme-get-exif-data' and
|
|
443 ;; `tumme-set-exif-data' for reading and writing EXIF data to image files.
|
|
444 ;;
|
|
445 ;; * Rewrote `tumme-get-exif-file-name': now uses
|
|
446 ;; `tumme-get-exif-data'. Slight change to replace spaces with
|
|
447 ;; underscores (tt seems not all cameras use the exact same format for
|
|
448 ;; DateTimeOriginal). Added code for handling files that has no
|
|
449 ;; EXIF-data (use file's timestamp instead).
|
|
450 ;;
|
|
451 ;; * Changed from using the exif program to exiftool because exiftool
|
|
452 ;; also handles writing of EXIF data, which is very useful.
|
|
453 ;;
|
|
454 ;; * Added the command `tumme-thumbnail-set-image-description' that
|
|
455 ;; can be used to set the EXIF tag ImageDescription. Thanks to Colin
|
|
456 ;; Marquardt for the suggestion.
|
|
457 ;;
|
|
458 ;; * Added `tumme-toggle-mark-thumb-original-file' and
|
|
459 ;; `tumme-mouse-toggle-mark' and changed
|
|
460 ;; `tumme-modify-mark-on-thumb-original-file' to support toggling of
|
|
461 ;; mark of original image file in dired, from
|
|
462 ;; `tumme-thumbnail-mode'. Bound C-down-mouse-1
|
|
463 ;; `tumme-mouse-toggle-mark' to in `tumme-thumbnail-mode'.
|
|
464 ;;
|
|
465 ;; * Changed `tumme-mouse-select-thumbnail' to also display properties
|
|
466 ;; after the file is selected.
|
|
467 ;;
|
|
468 ;; Version 0.4.10, 2005-11-07
|
|
469 ;;
|
|
470 ;; * Renamed `tumme-dired-folder' to `tumme-dired'.
|
|
471 ;;
|
|
472 ;; * Changed format of the database file slightly, now the full path
|
|
473 ;; and file name is used. Had to change most of the tag functions
|
|
474 ;; (writing, reading, searching) slightly to cope with the change. If
|
|
475 ;; you are an old tumme user, you have to update your database
|
|
476 ;; manually, probably you only need to prefix all rows with a
|
|
477 ;; directory name to get the full path and file name.
|
|
478 ;;
|
|
479 ;; * Removed `tumme-thumb-file-name-format'. Added
|
|
480 ;; `tumme-thumbnail-storage' and changed `tumme-thumb-name' to provide
|
|
481 ;; two different thumbnail storage schemes. It is no longer necessary
|
|
482 ;; to have unique image file names to use tumme fully.
|
|
483 ;;
|
|
484 ;; * As a consequence of the above, gallery generation is currently
|
|
485 ;; not supported if per-directory thumbnail file storage is used.
|
|
486 ;;
|
|
487 ;; * Changed parameters to `tumme-create-thumb'.
|
|
488 ;;
|
|
489 ;; * To be included in Emacs 22.
|
|
490 ;;
|
|
491 ;;
|
|
492 ;;
|
|
493 ;; TODO
|
|
494 ;; ====
|
|
495 ;;
|
|
496 ;; * Support gallery creation when using per-directory thumbnail
|
|
497 ;; storage.
|
|
498 ;;
|
|
499 ;; * Some sort of auto-rotate function based on rotate info in the
|
|
500 ;; EXIF data.
|
|
501 ;;
|
|
502 ;; * Check if exiftool exist before trying to call it to give a better
|
|
503 ;; error message.
|
|
504 ;;
|
|
505 ;; * Investigate if it is possible to also write the tags to the image
|
|
506 ;; files.
|
|
507 ;;
|
|
508 ;; * From thumbs.el: Add an option for clean-up/max-size functionality
|
|
509 ;; for thumbnail directory.
|
|
510 ;;
|
|
511 ;; * From thumbs.el: Add setroot function.
|
|
512 ;;
|
|
513 ;; * Asynchronous creation of thumbnails.
|
|
514 ;;
|
|
515 ;; * Add `tumme-display-thumbs-ring' and functions to cycle that. Find
|
|
516 ;; out which is best, saving old batch just before inserting new, or
|
|
517 ;; saving the current batch in the ring when inserting it. Adding it
|
|
518 ;; probably needs rewriting `tumme-display-thumbs' to be more general.
|
|
519 ;;
|
|
520 ;; * Find some way of toggling on and off really nice keybindings in
|
|
521 ;; dired (for example, using C-n or <down> instead of C-S-n). Richard
|
|
522 ;; suggested that we could keep C-t as prefix for tumme commands as it
|
|
523 ;; is currently not used in dired. He also suggested that
|
|
524 ;; `dired-next-line' and `dired-previous-line' figure out if tumme is
|
|
525 ;; enabled in the current buffer and, if it is, call
|
|
526 ;; `tumme-dired-next-line' and `tumme-dired-previous-line',
|
|
527 ;; respectively.
|
|
528 ;;
|
|
529 ;; * Enhanced gallery creation with basic CSS-support and pagination
|
|
530 ;; of tag pages with many pictures.
|
|
531 ;;
|
|
532 ;; * Rewrite `tumme-modify-mark-on-thumb-original-file' to be less
|
|
533 ;; ugly.
|
|
534 ;;
|
|
535 ;; * In some way keep track of buffers and windows and stuff so that
|
|
536 ;; it works as the user expects.
|
|
537 ;;
|
|
538 ;; * More/better documentation
|
|
539 ;;
|
|
540 ;;
|
|
541 ;;; Code:
|
|
542
|
|
543 (require 'dired)
|
|
544 (require 'format-spec)
|
|
545
|
|
546 (defgroup tumme nil
|
|
547 "Use dired to browse your images as thumbnails, and more."
|
|
548 :prefix "tumme-"
|
|
549 :group 'files)
|
|
550
|
|
551 (defcustom tumme-dir "~/.tumme/"
|
|
552 "*Directory where thumbnail images for are stored."
|
|
553 :type 'string
|
|
554 :group 'tumme)
|
|
555
|
|
556 (defcustom tumme-thumbnail-storage 'use-tumme-dir
|
|
557 "*How to store tumme's thumbnail files.
|
|
558 Tumme can store thumbnail files in one of two ways and this is
|
|
559 controlled by this variable. \"Use tumme dir\" means that the
|
|
560 thumbnails are stored in a central directory. \"Per directory\"
|
|
561 means that each thumbnail is stored in a subdirectory called
|
|
562 \".tumme\" in the same directory where the image file is."
|
|
563 :type '(choice :tag "How to store thumbnail files"
|
|
564 (const :tag "Use tumme-dir" use-tumme-dir)
|
|
565 (const :tag "Per-directory" per-directory))
|
|
566 :group 'tumme)
|
|
567
|
|
568 (defcustom tumme-db-file "~/.tumme/.tumme_db"
|
|
569 "*Database file where file names and their associated tags are stored."
|
|
570 :type 'string
|
|
571 :group 'tumme)
|
|
572
|
|
573 (defcustom tumme-temp-image-file "~/.tumme/.tumme_temp"
|
|
574 "*Name of temporary image file used by various commands."
|
|
575 :type 'string
|
|
576 :group 'tumme)
|
|
577
|
|
578 (defcustom tumme-gallery-dir "~/.tumme/.tumme_gallery"
|
|
579 "*Directory to store generated gallery html pages.
|
|
580 This path needs to be \"shared\" to the public so that it can access
|
|
581 the index.html page that tumme creates."
|
|
582 :type 'string
|
|
583 :group 'tumme)
|
|
584
|
|
585 (defcustom tumme-gallery-image-root-url
|
|
586 "http://your.own.server/tummepics"
|
|
587 "*URL where the full size images are to be found.
|
|
588 Note that this path has to be configured in your web server. Tumme
|
|
589 expects to find pictures in this directory."
|
|
590 :type 'string
|
|
591 :group 'tumme)
|
|
592
|
|
593 (defcustom tumme-gallery-thumb-image-root-url
|
|
594 "http://your.own.server/tummethumbs"
|
|
595 "*URL where the thumbnail images are to be found.
|
|
596 Note that this path has to be configured in your web server. Tumme
|
|
597 expects to find pictures in this directory."
|
|
598 :type 'string
|
|
599 :group 'tumme)
|
|
600
|
|
601 (defcustom tumme-cmd-create-thumbnail-program
|
|
602 "convert"
|
|
603 "*Executable used to create thumbnail.
|
|
604 Used together with `tumme-cmd-create-thumbnail-options'."
|
|
605 :type 'string
|
|
606 :group 'tumme)
|
|
607
|
|
608 (defcustom tumme-cmd-create-thumbnail-options
|
|
609 "%p -size %sx%s \"%f\" -resize %sx%s +profile \"*\" jpeg:\"%t\""
|
|
610 "*Format of command used to create thumbnail image.
|
|
611 Available options are %p which is replaced by
|
|
612 `tumme-cmd-create-thumbnail-program', %s which is replaced by
|
|
613 `tumme-thumb-size', %f which is replaced by the file name of the
|
|
614 original image and %t which is replaced by the file name of the
|
|
615 thumbnail file."
|
|
616 :type 'string
|
|
617 :group 'tumme)
|
|
618
|
|
619 (defcustom tumme-cmd-create-temp-image-program
|
|
620 "convert"
|
|
621 "*Executable used to create temporary image.
|
|
622 Used together with `tumme-cmd-create-temp-image-options'."
|
|
623 :type 'string
|
|
624 :group 'tumme)
|
|
625
|
|
626 (defcustom tumme-cmd-create-temp-image-options
|
|
627 "%p -size %xx%y \"%f\" -resize %xx%y +profile \"*\" jpeg:\"%t\""
|
|
628 "*Format of command used to create temporary image for display window.
|
|
629 Available options are %p which is replaced by
|
|
630 `tumme-cmd-create-temp-image-program', %x and %y which is replaced by
|
|
631 the calculated max size for x and y in the image display window, %f
|
|
632 which is replaced by the file name of the original image and %t which
|
|
633 is replaced by the file name of the temporary file."
|
|
634 :type 'string
|
|
635 :group 'tumme)
|
|
636
|
|
637 (defcustom tumme-cmd-rotate-thumbnail-program
|
|
638 "mogrify"
|
|
639 "*Executable used to rotate thumbnail.
|
|
640 Used together with `tumme-cmd-rotate-thumbnail-options'."
|
|
641 :type 'string
|
|
642 :group 'tumme)
|
|
643
|
|
644 (defcustom tumme-cmd-rotate-thumbnail-options
|
|
645 "%p -rotate %d \"%t\""
|
|
646 "*Format of command used to rotate thumbnail image.
|
|
647 Available options are %p which is replaced by
|
|
648 `tumme-cmd-rotate-thumbnail-program', %d which is replaced by the
|
|
649 number of (positive) degrees to rotate the image, normally 90 or 270
|
|
650 \(for 90 degrees right and left), %t which is replaced by the file name
|
|
651 of the thumbnail file."
|
|
652 :type 'string
|
|
653 :group 'tumme)
|
|
654
|
|
655 (defcustom tumme-cmd-rotate-original-program
|
|
656 "jpegtran"
|
|
657 "*Executable used to rotate original image.
|
|
658 Used together with `tumme-cmd-rotate-original-options'."
|
|
659 :type 'string
|
|
660 :group 'tumme)
|
|
661
|
|
662 (defcustom tumme-cmd-rotate-original-options
|
|
663 "%p -rotate %d -copy all \"%o\" > %t"
|
|
664 "*Format of command used to rotate original image.
|
|
665 Available options are %p which is replaced by
|
|
666 `tumme-cmd-rotate-original-program', %d which is replaced by the
|
|
667 number of (positive) degrees to rotate the image, normally 90 or
|
|
668 270 \(for 90 degrees right and left), %o which is replaced by the
|
|
669 original image file name and %t which is replaced by
|
|
670 `tumme-temp-image-file'"
|
|
671 :type 'string
|
|
672 :group 'tumme)
|
|
673
|
|
674 (defcustom tumme-temp-rotate-image-file
|
|
675 "~/.tumme/.tumme_rotate_temp"
|
|
676 "*Temporary file for rotate operations."
|
|
677 :type 'string
|
|
678 :group 'tumme)
|
|
679
|
|
680 (defcustom tumme-rotate-original-ask-before-overwrite t
|
|
681 "Confirm overwrite of original file after rotate operation.
|
|
682 If non-nil, ask user for confirmation before overwriting the
|
|
683 original file with `tumme-temp-rotate-image-file'."
|
|
684 :type 'boolean
|
|
685 :group 'tumme)
|
|
686
|
|
687 (defcustom tumme-cmd-write-exif-data-program
|
|
688 "exiftool"
|
|
689 "*Program used to write EXIF data to image.
|
|
690 Used together with `tumme-cmd-write-exif-data-options'."
|
|
691 :type 'string
|
|
692 :group 'tumme)
|
|
693
|
|
694 (defcustom tumme-cmd-write-exif-data-options
|
|
695 "%p -%t=\"%v\" \"%f\""
|
|
696 "*Format of command used to write EXIF data.
|
|
697 Available options are %p which is replaced by
|
|
698 `tumme-cmd-write-exif-data-program', %f which is replaced by the
|
|
699 image file name, %t which is replaced by the tag name and %v
|
|
700 which is replaced by the tag value."
|
|
701 :type 'string
|
|
702 :group 'tumme)
|
|
703
|
|
704 (defcustom tumme-cmd-read-exif-data-program
|
|
705 "exiftool"
|
|
706 "*Program used to read EXIF data to image.
|
|
707 Used together with `tumme-cmd-read-exif-data-program-options'."
|
|
708 :type 'string
|
|
709 :group 'tumme)
|
|
710
|
|
711 (defcustom tumme-cmd-read-exif-data-options
|
|
712 "%p -s -s -s -%t \"%f\""
|
|
713 "*Format of command used to read EXIF data.
|
|
714 Available options are %p which is replaced by
|
|
715 `tumme-cmd-write-exif-data-options', %f which is replaced
|
|
716 by the image file name and %t which is replaced by the tag name."
|
|
717 :type 'string
|
|
718 :group 'tumme)
|
|
719
|
|
720 (defcustom tumme-gallery-hidden-tags
|
|
721 (list "private" "hidden" "pending")
|
|
722 "*List of \"hidden\" tags.
|
|
723 Used by `tumme-gallery-generate' to leave out \"hidden\" images."
|
|
724 :type '(repeat string)
|
|
725 :group 'tumme)
|
|
726
|
|
727 (defcustom tumme-thumb-size 100
|
|
728 "Size of thumbnails, in pixels."
|
|
729 :type 'integer
|
|
730 :group 'tumme)
|
|
731
|
|
732 (defcustom tumme-thumb-relief 2
|
|
733 "*Size of button-like border around thumbnails."
|
|
734 :type 'integer
|
|
735 :group 'tumme)
|
|
736
|
|
737 (defcustom tumme-thumb-margin 2
|
|
738 "*Size of the margin around thumbnails.
|
|
739 This is where you see the cursor."
|
|
740 :type 'integer
|
|
741 :group 'tumme)
|
|
742
|
|
743 (defcustom tumme-line-up-method 'dynamic
|
|
744 "*Default method for line-up of thumbnails in thumbnail buffer.
|
|
745 Used by `tumme-display-thumbs' and other functions that needs to
|
|
746 line-up thumbnails. Dynamic means to use the available width of the
|
|
747 window containing the thumbnail buffer, Fixed means to use
|
|
748 `tumme-thumbs-per-row', Interactive is for asking the user, and No
|
|
749 line-up means that no automatic line-up will be done."
|
|
750 :type '(choice :tag "Default line-up method"
|
|
751 (const :tag "Dynamic" dynamic)
|
|
752 (const :tag "Fixed" fixed)
|
|
753 (const :tag "Interactive" interactive)
|
|
754 (const :tag "No line-up" none))
|
|
755 :group 'tumme)
|
|
756
|
|
757 (defcustom tumme-thumbs-per-row 3
|
|
758 "*Number of thumbnails to display per row in thumb buffer."
|
|
759 :type 'integer
|
|
760 :group 'tumme)
|
|
761
|
|
762 (defcustom tumme-display-window-width-correction 1
|
|
763 "*Number to be used to correct image display window height.
|
|
764 Change if the default (1) does not work (i.e. if the image does not
|
|
765 completely fit)."
|
|
766 :type 'integer
|
|
767 :group 'tumme)
|
|
768
|
|
769 (defcustom tumme-display-window-height-correction 0
|
|
770 "*Number to be used to correct image display window height.
|
|
771 Use if the default (0) does not work (i.e. if the image does not
|
|
772 completely fit)."
|
|
773 :type 'integer
|
|
774 :group 'tumme)
|
|
775
|
|
776 (defcustom tumme-track-movement nil
|
|
777 "The current state of the tracking and mirroring.
|
|
778 For more information, see the documentation for
|
|
779 `tumme-toggle-movement-tracking'."
|
|
780 :type 'boolean
|
|
781 :group 'tumme)
|
|
782
|
|
783 (defcustom tumme-append-when-browsing nil
|
|
784 "Append thumbnails in thumbnail buffer when browsing.
|
|
785 If non-nil, using `tumme-next-line-and-display' and
|
|
786 `tumme-previous-line-and-display' will leave a trail of thumbnail
|
|
787 images in the thumbnail buffer. If you enable this and want to clean
|
|
788 the thumbnail buffer because it is filled with too many thumbmnails,
|
|
789 just call `tumme-display-thumb' to display only the image at point.
|
|
790 This value can be toggled using `tumme-toggle-append-browsing'."
|
|
791 :type 'boolean
|
|
792 :group 'tumme)
|
|
793
|
|
794 (defcustom tumme-dired-disp-props t
|
|
795 "If non-nil, display properties for dired file when browsing.
|
|
796 Used by `tumme-next-line-and-display',
|
|
797 `tumme-previous-line-and-display' and `tumme-mark-and-display-next'.
|
|
798 If the database file is large, this can slow down image browsing in
|
|
799 dired and you might want to turn it off."
|
|
800 :type 'boolean
|
|
801 :group 'tumme)
|
|
802
|
|
803 (defcustom tumme-display-properties-format "%b: %f (%t): %c"
|
|
804 "* Display format for thumbnail properties.
|
|
805 %b is replaced with associated dired buffer name, %f with file name
|
|
806 \(without path) of original image file, %t with the list of tags and %c
|
|
807 with the comment."
|
|
808 :type 'string
|
|
809 :group 'tumme)
|
|
810
|
|
811 (defcustom tumme-external-viewer "qiv -t"
|
|
812 "*Name of external viewer.
|
|
813 Including parameters. Used when displaying original image from
|
|
814 `tumme-thumbnail-mode'."
|
|
815 :type 'string
|
|
816 :group 'tumme)
|
|
817
|
|
818 (defcustom tumme-main-image-directory "~/pics/"
|
|
819 "*Name of main image directory, if any.
|
|
820 Used by `tumme-copy-with-exif-file-name'."
|
|
821 :type 'string
|
|
822 :group 'tumme)
|
|
823
|
|
824 (defun tumme-insert-image (file type relief margin)
|
|
825 "Insert image FILE of image TYPE, using RELIEF and MARGIN, at point."
|
|
826
|
|
827 (let ((i `(image :type ,type
|
|
828 :file ,file
|
|
829 :relief ,relief
|
|
830 :margin ,margin)))
|
|
831 (insert-image i)))
|
|
832
|
|
833 (defun tumme-insert-thumbnail (file original-file-name
|
|
834 associated-dired-buffer)
|
|
835 "Insert thumbnail image FILE.
|
|
836 Add text properties ORIGINAL-FILE-NAME and ASSOCIATED-DIRED-BUFFER."
|
|
837 (let (beg end)
|
|
838 (setq beg (point))
|
|
839 (tumme-insert-image file
|
|
840 'jpeg
|
|
841 tumme-thumb-relief
|
|
842 tumme-thumb-margin)
|
|
843 (setq end (point))
|
|
844 (add-text-properties
|
|
845 beg end
|
|
846 (list 'tumme-thumbnail t
|
|
847 'original-file-name original-file-name
|
|
848 'associated-dired-buffer associated-dired-buffer
|
|
849 'tags (tumme-list-tags original-file-name)
|
|
850 'mouse-face 'highlight
|
|
851 'comment (tumme-get-comment original-file-name)))))
|
|
852
|
|
853 (defun tumme-thumb-name (file)
|
|
854 "Return thumbnail file name for FILE.
|
|
855 Depending on the value of `tumme-thumbnail-storage', the file
|
|
856 name will vary. For central thumbnail file storage, make a
|
|
857 MD5-hash of the image file's directory name and add that to make
|
|
858 the thumbnail file name unique. For per-directory storage, just
|
|
859 add a subdirectory."
|
|
860 (let ((f (expand-file-name file))
|
|
861 md5-hash)
|
|
862 (format "%s%s%s.thumb.%s"
|
|
863 (cond ((eq 'use-tumme-dir tumme-thumbnail-storage)
|
|
864 ;; Is MD5 hashes fast enough? The checksum of a
|
|
865 ;; thumbnail file name need not be that
|
|
866 ;; "cryptographically" good so a faster one could
|
|
867 ;; be used here.
|
|
868 (setq md5-hash (md5 (file-name-as-directory
|
|
869 (file-name-directory file))))
|
|
870 (file-name-as-directory (expand-file-name tumme-dir)))
|
|
871 ((eq 'per-directory tumme-thumbnail-storage)
|
|
872 (format "%s.tumme/"
|
|
873 (file-name-directory f))))
|
|
874 (file-name-sans-extension
|
|
875 (file-name-nondirectory f))
|
|
876 (if md5-hash
|
|
877 (concat "_" md5-hash)
|
|
878 "")
|
|
879 (file-name-extension f))))
|
|
880
|
|
881 (defun tumme-create-thumb (original-file thumbnail-file)
|
|
882 "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE."
|
|
883 (let* ((size (int-to-string tumme-thumb-size))
|
|
884 (command
|
|
885 (format-spec
|
|
886 tumme-cmd-create-thumbnail-options
|
|
887 (list
|
|
888 (cons ?p tumme-cmd-create-thumbnail-program)
|
|
889 (cons ?s size)
|
|
890 (cons ?f original-file)
|
|
891 (cons ?t thumbnail-file))))
|
|
892 thumbnail-dir)
|
|
893 (when (not (file-exists-p
|
|
894 (setq thumbnail-dir (file-name-directory thumbnail-file))))
|
|
895 (message "Creating thumbnail directory.")
|
|
896 (make-directory thumbnail-dir))
|
|
897 (shell-command command nil)))
|
|
898
|
|
899 (defun tumme-next-line-and-display ()
|
|
900 "Move to next dired line and display thumbnail image."
|
|
901 (interactive)
|
|
902 (dired-next-line 1)
|
|
903 (tumme-display-thumbs
|
|
904 t (or tumme-append-when-browsing nil))
|
|
905 (if tumme-dired-disp-props
|
|
906 (tumme-dired-display-properties)))
|
|
907
|
|
908 (defun tumme-previous-line-and-display ()
|
|
909 "Move to previous dired line and display thumbnail image."
|
|
910 (interactive)
|
|
911 (dired-previous-line 1)
|
|
912 (tumme-display-thumbs
|
|
913 t (or tumme-append-when-browsing nil))
|
|
914 (if tumme-dired-disp-props
|
|
915 (tumme-dired-display-properties)))
|
|
916
|
|
917 (defun tumme-toggle-append-browsing ()
|
|
918 "Toggle `tumme-append-when-browsing'."
|
|
919 (interactive)
|
|
920 (setq tumme-append-when-browsing
|
|
921 (not tumme-append-when-browsing))
|
|
922 (message "Append browsing %s."
|
|
923 (if tumme-append-when-browsing
|
|
924 "on"
|
|
925 "off")))
|
|
926
|
|
927 (defun tumme-mark-and-display-next ()
|
|
928 "Mark current file in dired and display next thumbnail image."
|
|
929 (interactive)
|
|
930 (dired-mark 1)
|
|
931 (tumme-display-thumbs
|
|
932 t (or tumme-append-when-browsing nil))
|
|
933 (if tumme-dired-disp-props
|
|
934 (tumme-dired-display-properties)))
|
|
935
|
|
936 (defun tumme-toggle-dired-display-properties ()
|
|
937 "Toggle `tumme-dired-disp-props'."
|
|
938 (interactive)
|
|
939 (setq tumme-dired-disp-props
|
|
940 (not tumme-dired-disp-props))
|
|
941 (message "Dired display properties %s."
|
|
942 (if tumme-dired-disp-props
|
|
943 "on"
|
|
944 "off")))
|
|
945
|
|
946 (defvar tumme-thumbnail-buffer "*tumme*"
|
|
947 "Tumme's thumbnail buffer.")
|
|
948
|
|
949 (defun tumme-create-thumbnail-buffer ()
|
|
950 "Create thumb buffer and set `tumme-thumbnail-mode'."
|
|
951 (let ((buf (get-buffer-create tumme-thumbnail-buffer)))
|
|
952 (save-excursion
|
|
953 (set-buffer buf)
|
|
954 (setq buffer-read-only t)
|
|
955 (if (not (eq major-mode 'tumme-thumbnail-mode))
|
|
956 (tumme-thumbnail-mode)))
|
|
957 buf))
|
|
958
|
|
959 (defvar tumme-display-image-buffer "*tumme-display-image*"
|
|
960 "Where larger versions of the images are display.")
|
|
961
|
|
962 (defun tumme-create-display-image-buffer ()
|
|
963 "Create image display buffer and set `tumme-display-image-mode'."
|
|
964 (let ((buf (get-buffer-create tumme-display-image-buffer)))
|
|
965 (save-excursion
|
|
966 (set-buffer buf)
|
|
967 (setq buffer-read-only t)
|
|
968 (if (not (eq major-mode 'tumme-display-image-mode))
|
|
969 (tumme-display-image-mode)))
|
|
970 buf))
|
|
971
|
68404
|
972 ;;;###autoload
|
67302
|
973 (defun tumme-dired (dir &optional arg)
|
|
974 "Open directory DIR and create a default window configuration.
|
|
975
|
|
976 Convenience command that:
|
|
977
|
|
978 - Opens dired in folder DIR
|
|
979 - Splits windows in most useful (?) way
|
|
980 - Set `truncate-lines' to t
|
|
981
|
|
982 If called with prefix argument ARG, skip splitting of windows."
|
|
983 (interactive "DDirectory: \nP")
|
|
984 (let ((buf (tumme-create-thumbnail-buffer))
|
|
985 (buf2 (tumme-create-display-image-buffer)))
|
|
986 (dired dir)
|
|
987 (when (not arg)
|
|
988 (split-window-horizontally)
|
|
989 (setq truncate-lines t)
|
|
990 (save-excursion
|
|
991 (other-window 1)
|
|
992 (switch-to-buffer buf)
|
|
993 (split-window-vertically)
|
|
994 (other-window 1)
|
|
995 (switch-to-buffer buf2)
|
|
996 (other-window -2)))))
|
|
997
|
|
998 (defun tumme-display-thumbs (&optional arg append)
|
|
999 "Display thumbnails of all marked files, in `tumme-thumbnail-buffer'.
|
|
1000 If a thumbnail image does not exist for a file, it is created on the
|
|
1001 fly. With prefix argument ARG, display only thumbnail for file at
|
|
1002 point (this is useful if you have marked some files but want to show
|
|
1003 another one).
|
|
1004
|
|
1005 Recommended usage is to split the current frame horizontally so that
|
|
1006 you have the dired buffer in the left window and the
|
|
1007 `tumme-thumbnail-buffer' buffer in the right window.
|
|
1008
|
|
1009 With optional argument APPEND, append thumbnail to thumbnail buffer
|
|
1010 instead of erasing it first."
|
|
1011 (interactive "P")
|
|
1012 (let ((buf (tumme-create-thumbnail-buffer))
|
|
1013 curr-file thumb-name files count dired-buf beg)
|
|
1014 (if arg
|
|
1015 (setq files (list (dired-get-filename)))
|
|
1016 (setq files (dired-get-marked-files)))
|
|
1017 (setq dired-buf (current-buffer))
|
|
1018 (save-excursion
|
|
1019 (set-buffer buf)
|
|
1020 (let ((inhibit-read-only t))
|
|
1021 (if (not append)
|
|
1022 (erase-buffer)
|
|
1023 (goto-char (point-max)))
|
|
1024 (mapcar
|
|
1025 (lambda (curr-file)
|
|
1026 (setq thumb-name (tumme-thumb-name curr-file))
|
|
1027 (if (and (not (file-exists-p thumb-name))
|
|
1028 (not (= 0 (tumme-create-thumb curr-file thumb-name))))
|
|
1029 (message "Thumb could not be created for file %s" curr-file)
|
|
1030 (tumme-insert-thumbnail thumb-name curr-file dired-buf)))
|
|
1031 files))
|
|
1032 (cond ((eq 'dynamic tumme-line-up-method)
|
|
1033 (tumme-line-up-dynamic))
|
|
1034 ((eq 'fixed tumme-line-up-method)
|
|
1035 (tumme-line-up))
|
|
1036 ((eq 'interactive tumme-line-up-method)
|
|
1037 (tumme-line-up-interactive))
|
|
1038 ((eq 'none tumme-line-up-method)
|
|
1039 nil)
|
|
1040 (t
|
|
1041 (tumme-line-up-dynamic))))))
|
|
1042
|
|
1043 (defun tumme-write-tag (files tag)
|
|
1044 "For all FILES, writes TAG to the image database."
|
|
1045 (save-excursion
|
|
1046 (let (end buf)
|
|
1047 (setq buf (find-file tumme-db-file))
|
|
1048 (if (not (listp files))
|
|
1049 (if (stringp files)
|
|
1050 (setq files (list files))
|
|
1051 (error "Files must be a string or a list of strings!")))
|
|
1052 (mapcar
|
|
1053 (lambda (file)
|
|
1054 (goto-char (point-min))
|
|
1055 (if (search-forward-regexp
|
|
1056 (format "^%s" file) nil t)
|
|
1057 (progn
|
|
1058 (end-of-line)
|
|
1059 (setq end (point))
|
|
1060 (beginning-of-line)
|
|
1061 (if (not (search-forward (format ";%s" tag) end t))
|
|
1062 (progn
|
|
1063 (end-of-line)
|
|
1064 (insert (format ";%s" tag)))))
|
|
1065 (goto-char (point-max))
|
|
1066 (insert (format "\n%s;%s" file tag))))
|
|
1067 files)
|
|
1068 (save-buffer)
|
|
1069 (kill-buffer buf))))
|
|
1070
|
|
1071 (defun tumme-remove-tag (files tag)
|
|
1072 "For all FILES, remove TAG from the image database."
|
|
1073 (save-excursion
|
|
1074 (let (end buf start)
|
|
1075 (setq buf (find-file tumme-db-file))
|
|
1076 (if (not (listp files))
|
|
1077 (if (stringp files)
|
|
1078 (setq files (list files))
|
|
1079 (error "Files must be a string or a list of strings!")))
|
|
1080 (mapcar
|
|
1081 (lambda (file)
|
|
1082 (goto-char (point-min))
|
|
1083 (if (search-forward-regexp
|
|
1084 (format "^%s" file) nil t)
|
|
1085 (progn
|
|
1086 (end-of-line)
|
|
1087 (setq end (point))
|
|
1088 (beginning-of-line)
|
|
1089 (if (search-forward-regexp (format "\\(;%s\\)" tag) end t)
|
|
1090 (progn
|
|
1091 (delete-region (match-beginning 1) (match-end 1))
|
|
1092 ;; Check if file should still be in the database. If
|
|
1093 ;; it has no tags or comments, it will be removed.
|
|
1094 (end-of-line)
|
|
1095 (setq end (point))
|
|
1096 (beginning-of-line)
|
|
1097 (if (not (search-forward ";" end t))
|
|
1098 (progn
|
|
1099 (kill-line 1)
|
|
1100 ;; If on empty line at end of buffer
|
|
1101 (if (and (eobp)
|
|
1102 (looking-at "^$"))
|
|
1103 (delete-backward-char 1)))))))))
|
|
1104 files)
|
|
1105 (save-buffer)
|
|
1106 (kill-buffer buf))))
|
|
1107
|
|
1108 (defun tumme-list-tags (file)
|
|
1109 "Read all tags for image FILE from the image database."
|
|
1110 (save-excursion
|
|
1111 (let (end buf (tags ""))
|
|
1112 (setq buf (find-file tumme-db-file))
|
|
1113 (goto-char (point-min))
|
|
1114 (if (search-forward-regexp
|
|
1115 (format "^%s" file) nil t)
|
|
1116 (progn
|
|
1117 (end-of-line)
|
|
1118 (setq end (point))
|
|
1119 (beginning-of-line)
|
|
1120 (if (search-forward ";" end t)
|
|
1121 (if (search-forward "comment:" end t)
|
|
1122 (if (search-forward ";" end t)
|
|
1123 (setq tags (buffer-substring (point) end)))
|
|
1124 (setq tags (buffer-substring (point) end))))))
|
|
1125 (kill-buffer buf)
|
|
1126 (split-string tags ";"))))
|
|
1127
|
|
1128 (defun tumme-tag-files (arg)
|
|
1129 "Tag marked file(s) in dired. With prefix ARG, tag file at point."
|
|
1130 (interactive "P")
|
|
1131 (let ((tag (read-string "Tag to add: "))
|
|
1132 curr-file files)
|
|
1133 (if arg
|
|
1134 (setq files (dired-get-filename))
|
|
1135 (setq files (dired-get-marked-files)))
|
|
1136 (tumme-write-tag files tag)))
|
|
1137
|
|
1138 (defun tumme-tag-thumbnail ()
|
|
1139 "Tag current thumbnail."
|
|
1140 (interactive)
|
|
1141 (let ((tag (read-string "Tag to add: ")))
|
|
1142 (tumme-write-tag (tumme-original-file-name) tag))
|
|
1143 (tumme-update-property
|
|
1144 'tags (tumme-list-tags (tumme-original-file-name))))
|
|
1145
|
|
1146 (defun tumme-tag-remove (arg)
|
|
1147 "Remove tag for selected file(s).
|
|
1148 With prefix argument ARG, remove tag from file at point."
|
|
1149 (interactive "P")
|
|
1150 (let ((tag (read-string "Tag to remove: "))
|
|
1151 files)
|
|
1152 (if arg
|
|
1153 (setq files (list (dired-get-filename)))
|
|
1154 (setq files (dired-get-marked-files)))
|
|
1155 (tumme-remove-tag files tag)))
|
|
1156
|
|
1157 (defun tumme-tag-thumbnail-remove ()
|
|
1158 "Remove tag from thumbnail."
|
|
1159 (interactive)
|
|
1160 (let ((tag (read-string "Tag to remove: ")))
|
|
1161 (tumme-remove-tag (tumme-original-file-name) tag))
|
|
1162 (tumme-update-property
|
|
1163 'tags (tumme-list-tags (tumme-original-file-name))))
|
|
1164
|
|
1165 (defun tumme-original-file-name ()
|
|
1166 "Get original file name for thumbnail or display image at point."
|
|
1167 (get-text-property (point) 'original-file-name))
|
|
1168
|
|
1169 (defun tumme-associated-dired-buffer ()
|
|
1170 "Get associated dired buffer at point."
|
|
1171 (get-text-property (point) 'associated-dired-buffer))
|
|
1172
|
|
1173 (defun tumme-get-buffer-window (buf)
|
|
1174 "Return window where buffer BUF is."
|
|
1175 (get-window-with-predicate
|
|
1176 (lambda (window)
|
|
1177 (equal (window-buffer window) buf))
|
|
1178 nil t))
|
|
1179
|
|
1180 (defun tumme-track-original-file ()
|
|
1181 "Track the original file in the associated dired buffer.
|
|
1182 See documentation for `tumme-toggle-movement-tracking'. Interactive
|
|
1183 use only useful if `tumme-track-movement' is nil."
|
|
1184 (interactive)
|
|
1185 (let ((old-buf (current-buffer))
|
|
1186 (dired-buf (tumme-associated-dired-buffer))
|
|
1187 (file-name (tumme-original-file-name)))
|
|
1188 (if (and dired-buf file-name)
|
|
1189 (progn
|
|
1190 (setq file-name (file-name-nondirectory file-name))
|
|
1191 (set-buffer dired-buf)
|
|
1192 (goto-char (point-min))
|
|
1193 (if (not (search-forward file-name nil t))
|
|
1194 (message "Could not track file")
|
|
1195 (dired-move-to-filename)
|
|
1196 (set-window-point
|
|
1197 (tumme-get-buffer-window dired-buf) (point)))
|
|
1198 (set-buffer old-buf)))))
|
|
1199
|
|
1200 (defun tumme-toggle-movement-tracking ()
|
|
1201 "Turn on and off `tumme-track-movement'.
|
|
1202 Tracking of the movements between thumbnail and dired buffer so that
|
|
1203 they are \"mirrored\" in the dired buffer. When this is on, moving
|
|
1204 around in the thumbnail or dired buffer will find the matching
|
|
1205 position in the other buffer."
|
|
1206 (interactive)
|
|
1207 (setq tumme-track-movement (not tumme-track-movement))
|
|
1208 (message "Tracking %s" (if tumme-track-movement "on" "off")))
|
|
1209
|
|
1210 (defun tumme-track-thumbnail ()
|
|
1211 "Track current dired file's thumb in `tumme-thumbnail-buffer'.
|
|
1212 This is almost the same as what `tumme-track-original-file' does, but
|
|
1213 the other way around."
|
|
1214 (let ((file (dired-get-filename))
|
|
1215 (old-buf (current-buffer))
|
|
1216 prop-val found)
|
|
1217 (if (get-buffer tumme-thumbnail-buffer)
|
|
1218 (progn
|
|
1219 (set-buffer tumme-thumbnail-buffer)
|
|
1220 (goto-char (point-min))
|
|
1221 (while (and (not (eobp))
|
|
1222 (not found))
|
|
1223 (if (and (setq prop-val
|
|
1224 (get-text-property (point) 'original-file-name))
|
|
1225 (string= prop-val file))
|
|
1226 (setq found t))
|
|
1227 (if (not found)
|
|
1228 (forward-char 1)))
|
|
1229 (if found
|
|
1230 (progn
|
|
1231 (set-window-point
|
|
1232 (tumme-thumbnail-window) (point))
|
|
1233 (tumme-display-thumb-properties)))
|
|
1234 (set-buffer old-buf)))))
|
|
1235
|
|
1236 (defun tumme-dired-next-line (&optional arg)
|
|
1237 "Call `dired-next-line', then track thumbnail.
|
|
1238 This can safely replace `dired-next-line'. With prefix argument, move
|
|
1239 ARG lines."
|
|
1240 (interactive "P")
|
|
1241 (dired-next-line (or arg 1))
|
|
1242 (if tumme-track-movement
|
|
1243 (tumme-track-thumbnail)))
|
|
1244
|
|
1245 (defun tumme-dired-previous-line (&optional arg)
|
|
1246 "Call `dired-previous-line', then track thumbnail.
|
|
1247 This can safely replace `dired-previous-line'. With prefix argument,
|
|
1248 move ARG lines."
|
|
1249 (interactive "P")
|
|
1250 (dired-previous-line (or arg 1))
|
|
1251 (if tumme-track-movement
|
|
1252 (tumme-track-thumbnail)))
|
|
1253
|
|
1254 (defun tumme-forward-char ()
|
|
1255 "Move to next image and display properties."
|
|
1256 (interactive)
|
|
1257 ;; Before we move, make sure that there is an image two positions
|
|
1258 ;; forward.
|
|
1259 (if (save-excursion
|
|
1260 (forward-char 2)
|
|
1261 (tumme-image-at-point-p))
|
|
1262 (progn
|
|
1263 (forward-char)
|
|
1264 (while (and (not (eobp))
|
|
1265 (not (tumme-image-at-point-p)))
|
|
1266 (forward-char))
|
|
1267 (if tumme-track-movement
|
|
1268 (tumme-track-original-file))))
|
|
1269 (tumme-display-thumb-properties))
|
|
1270
|
|
1271 (defun tumme-backward-char ()
|
|
1272 "Move to previous image and display properties."
|
|
1273 (interactive)
|
|
1274 (if (not (bobp))
|
|
1275 (progn
|
|
1276 (backward-char)
|
|
1277 (while (and (not (bobp))
|
|
1278 (not (tumme-image-at-point-p)))
|
|
1279 (backward-char))
|
|
1280 (if tumme-track-movement
|
|
1281 (tumme-track-original-file))))
|
|
1282 (tumme-display-thumb-properties))
|
|
1283
|
|
1284 (defun tumme-next-line ()
|
|
1285 "Move to next line and display properties."
|
|
1286 (interactive)
|
|
1287 (next-line 1)
|
|
1288 ;; If we end up in an empty spot, back up to the next thumbnail.
|
|
1289 (if (not (tumme-image-at-point-p))
|
|
1290 (tumme-backward-char))
|
|
1291 (if tumme-track-movement
|
|
1292 (tumme-track-original-file))
|
|
1293 (tumme-display-thumb-properties))
|
|
1294
|
|
1295
|
|
1296 (defun tumme-previous-line ()
|
|
1297 "Move to previous line and display properties."
|
|
1298 (interactive)
|
|
1299 (previous-line 1)
|
|
1300 ;; If we end up in an empty spot, back up to the next
|
|
1301 ;; thumbnail. This should only happen if the user deleted a
|
|
1302 ;; thumbnail and did not refresh, so it is not very common. But we
|
|
1303 ;; can handle it in a good manner, so why not?
|
|
1304 (if (not (tumme-image-at-point-p))
|
|
1305 (tumme-backward-char))
|
|
1306 (if tumme-track-movement
|
|
1307 (tumme-track-original-file))
|
|
1308 (tumme-display-thumb-properties))
|
|
1309
|
|
1310 (defun tumme-format-properties-string (buf file props comment)
|
|
1311 "Format display properties.
|
|
1312 BUF is the associated dired buffer, FILE is the original image file
|
|
1313 name, PROPS is a list of tags and COMMENT is the images files's
|
|
1314 comment."
|
|
1315 (format-spec
|
|
1316 tumme-display-properties-format
|
|
1317 (list
|
|
1318 (cons ?b buf)
|
|
1319 (cons ?f file)
|
|
1320 (cons ?t (or (princ props) ""))
|
|
1321 (cons ?c (or comment "")))))
|
|
1322
|
|
1323 (defun tumme-display-thumb-properties ()
|
|
1324 "Display thumbnail properties in the echo area."
|
|
1325 (if (not (eobp))
|
|
1326 (let ((file-name (file-name-nondirectory (tumme-original-file-name)))
|
|
1327 (dired-buf (buffer-name (tumme-associated-dired-buffer)))
|
|
1328 (props (mapconcat
|
|
1329 'princ
|
|
1330 (get-text-property (point) 'tags)
|
|
1331 ", "))
|
|
1332 (comment (get-text-property (point) 'comment)))
|
|
1333 (if file-name
|
|
1334 (message
|
|
1335 (tumme-format-properties-string
|
|
1336 dired-buf
|
|
1337 file-name
|
|
1338 props
|
|
1339 comment))))))
|
|
1340
|
|
1341 (defun tumme-dired-file-marked-p ()
|
|
1342 "Check whether file on current line is marked or not."
|
|
1343 (save-excursion
|
|
1344 (beginning-of-line)
|
|
1345 (not (looking-at "^ .*$"))))
|
|
1346
|
|
1347 (defun tumme-modify-mark-on-thumb-original-file (command)
|
|
1348 "Modify mark in dired buffer.
|
|
1349 This is quite ugly but I don't know how to implemented in a better
|
|
1350 way. COMMAND is one of 'mark for marking file in dired, 'unmark for
|
|
1351 unmarking file in dired or 'flag for flagging file for delete in
|
|
1352 dired."
|
|
1353 (let ((file-name (tumme-original-file-name))
|
|
1354 (dired-buf (tumme-associated-dired-buffer)))
|
|
1355 (if (not (and dired-buf file-name))
|
|
1356 (message "No image, or image with correct properties, at point.")
|
|
1357 (save-excursion
|
|
1358 (message file-name)
|
|
1359 (setq file-name (file-name-nondirectory file-name))
|
|
1360 (set-buffer dired-buf)
|
|
1361 (goto-char (point-min))
|
|
1362 (if (search-forward file-name nil t)
|
|
1363 (cond ((eq command 'mark) (dired-mark 1))
|
|
1364 ((eq command 'unmark) (dired-unmark 1))
|
|
1365 ((eq command 'toggle)
|
|
1366 (if (tumme-dired-file-marked-p)
|
|
1367 (dired-unmark 1)
|
|
1368 (dired-mark 1)))
|
|
1369 ((eq command 'flag) (dired-flag-file-deletion 1))))))))
|
|
1370
|
|
1371 (defun tumme-mark-thumb-original-file ()
|
|
1372 "Mark original image file in associated dired buffer."
|
|
1373 (interactive)
|
|
1374 (tumme-modify-mark-on-thumb-original-file 'mark)
|
|
1375 (tumme-forward-char))
|
|
1376
|
|
1377 (defun tumme-unmark-thumb-original-file ()
|
|
1378 "Unmark original image file in associated dired buffer."
|
|
1379 (interactive)
|
|
1380 (tumme-modify-mark-on-thumb-original-file 'unmark)
|
|
1381 (tumme-forward-char))
|
|
1382
|
|
1383 (defun tumme-flag-thumb-original-file ()
|
|
1384 "Flag original image file for deletion in associated dired buffer."
|
|
1385 (interactive)
|
|
1386 (tumme-modify-mark-on-thumb-original-file 'flag)
|
|
1387 (tumme-forward-char))
|
|
1388
|
|
1389 (defun tumme-toggle-mark-thumb-original-file ()
|
|
1390 "Toggle mark on original image file in associated dired buffer."
|
|
1391 (interactive)
|
|
1392 (tumme-modify-mark-on-thumb-original-file 'toggle))
|
|
1393
|
|
1394 (defun tumme-jump-original-dired-buffer ()
|
|
1395 "Jump to the dired buffer associated with the current image file.
|
|
1396 You probably want to use this together with
|
|
1397 `tumme-track-original-file'."
|
|
1398 (interactive)
|
|
1399 (let ((buf (tumme-associated-dired-buffer))
|
|
1400 window frame)
|
|
1401 (setq window (tumme-get-buffer-window buf))
|
|
1402 (if window
|
|
1403 (progn
|
|
1404 (if (not (equal (selected-frame) (setq frame (window-frame window))))
|
|
1405 (select-frame-set-input-focus frame))
|
|
1406 (select-window window))
|
|
1407 (message "Associated dired buffer not visible"))))
|
|
1408
|
|
1409 (defun tumme-jump-thumbnail-buffer ()
|
|
1410 "Jump to thumbnail buffer."
|
|
1411 (interactive)
|
|
1412 (let ((window (tumme-thumbnail-window))
|
|
1413 frame)
|
|
1414 (if window
|
|
1415 (progn
|
|
1416 (if (not (equal (selected-frame) (setq frame (window-frame window))))
|
|
1417 (select-frame-set-input-focus frame))
|
|
1418 (select-window window))
|
|
1419 (message "Thumbnail buffer not visible"))))
|
|
1420
|
|
1421 (defvar tumme-thumbnail-mode-map (make-sparse-keymap)
|
|
1422 "Keymap for `tumme-thumbnail-mode'.")
|
|
1423
|
|
1424 (defvar tumme-thumbnail-mode-line-up-map (make-sparse-keymap)
|
|
1425 "Keymap for line-up commands in `tumme-thumbnail-mode'.")
|
|
1426
|
|
1427 (defvar tumme-thumbnail-mode-tag-map (make-sparse-keymap)
|
|
1428 "Keymap for tag commands in `tumme-thumbnail-mode'.")
|
|
1429
|
|
1430 (defun tumme-define-thumbnail-mode-keymap ()
|
|
1431 "Define keymap for `tumme-thumbnail-mode'."
|
|
1432
|
|
1433 ;; Keys
|
|
1434 (define-key tumme-thumbnail-mode-map [right] 'tumme-forward-char)
|
|
1435 (define-key tumme-thumbnail-mode-map [left] 'tumme-backward-char)
|
|
1436 (define-key tumme-thumbnail-mode-map [up] 'tumme-previous-line)
|
|
1437 (define-key tumme-thumbnail-mode-map [down] 'tumme-next-line)
|
|
1438 (define-key tumme-thumbnail-mode-map "\C-f" 'tumme-forward-char)
|
|
1439 (define-key tumme-thumbnail-mode-map "\C-b" 'tumme-backward-char)
|
|
1440 (define-key tumme-thumbnail-mode-map "\C-p" 'tumme-previous-line)
|
|
1441 (define-key tumme-thumbnail-mode-map "\C-n" 'tumme-next-line)
|
|
1442
|
|
1443 (define-key tumme-thumbnail-mode-map "d" 'tumme-flag-thumb-original-file)
|
|
1444 (define-key tumme-thumbnail-mode-map [delete]
|
|
1445 'tumme-flag-thumb-original-file)
|
|
1446 (define-key tumme-thumbnail-mode-map "m" 'tumme-mark-thumb-original-file)
|
|
1447 (define-key tumme-thumbnail-mode-map "u" 'tumme-unmark-thumb-original-file)
|
|
1448 (define-key tumme-thumbnail-mode-map "." 'tumme-track-original-file)
|
|
1449 (define-key tumme-thumbnail-mode-map [tab] 'tumme-jump-original-dired-buffer)
|
|
1450
|
|
1451 ;; add line-up map
|
|
1452 (define-key tumme-thumbnail-mode-map "g" tumme-thumbnail-mode-line-up-map)
|
|
1453
|
|
1454 ;; map it to "g" so that the user can press it more quickly
|
|
1455 (define-key tumme-thumbnail-mode-line-up-map "g" 'tumme-line-up-dynamic)
|
|
1456 ;; "f" for "fixed" number of thumbs per row
|
|
1457 (define-key tumme-thumbnail-mode-line-up-map "f" 'tumme-line-up)
|
|
1458 ;; "i" for "interactive"
|
|
1459 (define-key tumme-thumbnail-mode-line-up-map "i" 'tumme-line-up-interactive)
|
|
1460
|
|
1461 ;; add tag map
|
|
1462 (define-key tumme-thumbnail-mode-map "t" tumme-thumbnail-mode-tag-map)
|
|
1463
|
|
1464 ;; map it to "t" so that the user can press it more quickly
|
|
1465 (define-key tumme-thumbnail-mode-tag-map "t" 'tumme-tag-thumbnail)
|
|
1466 ;; "r" for "remove"
|
|
1467 (define-key tumme-thumbnail-mode-tag-map "r" 'tumme-tag-thumbnail-remove)
|
|
1468
|
|
1469 (define-key tumme-thumbnail-mode-map "\C-m"
|
|
1470 'tumme-display-thumbnail-original-image)
|
|
1471 (define-key tumme-thumbnail-mode-map [C-return]
|
|
1472 'tumme-thumbnail-display-external)
|
|
1473
|
|
1474 (define-key tumme-thumbnail-mode-map "l" 'tumme-rotate-thumbnail-left)
|
|
1475 (define-key tumme-thumbnail-mode-map "r" 'tumme-rotate-thumbnail-right)
|
|
1476
|
|
1477 (define-key tumme-thumbnail-mode-map "L" 'tumme-rotate-original-left)
|
|
1478 (define-key tumme-thumbnail-mode-map "R" 'tumme-rotate-original-right)
|
|
1479
|
|
1480 (define-key tumme-thumbnail-mode-map "D" 'tumme-thumbnail-set-image-description)
|
|
1481
|
|
1482 (define-key tumme-thumbnail-mode-map "\C-d" 'tumme-delete-char)
|
|
1483 (define-key tumme-thumbnail-mode-map " "
|
|
1484 'tumme-display-next-thumbnail-original)
|
|
1485 (define-key tumme-thumbnail-mode-map
|
|
1486 (kbd "DEL") 'tumme-display-previous-thumbnail-original)
|
|
1487 (define-key tumme-thumbnail-mode-map "c" 'tumme-comment-thumbnail)
|
|
1488 (define-key tumme-thumbnail-mode-map "q" 'tumme-kill-buffer-and-window)
|
|
1489
|
|
1490 ;; Mouse
|
|
1491 (define-key tumme-thumbnail-mode-map [mouse-2] 'tumme-mouse-display-image)
|
|
1492 (define-key tumme-thumbnail-mode-map [mouse-1] 'tumme-mouse-select-thumbnail)
|
|
1493
|
|
1494 ;; Seems I must first set C-down-mouse-1 to undefined, or else it
|
|
1495 ;; will trigger the buffer menu. If I try to instead bind
|
|
1496 ;; C-down-mouse-1 to `tumme-mouse-toggle-mark', I get a message
|
|
1497 ;; about C-mouse-1 not being defined afterwards. Annoying, but I
|
|
1498 ;; probably do not completely understand mouse events.
|
|
1499
|
|
1500 (define-key tumme-thumbnail-mode-map [C-down-mouse-1] 'undefined)
|
|
1501 (define-key tumme-thumbnail-mode-map [C-mouse-1] 'tumme-mouse-toggle-mark)
|
|
1502
|
|
1503 ;; Menu
|
|
1504 (define-key tumme-thumbnail-mode-map [menu-bar tumme]
|
|
1505 (cons "Tumme" (make-sparse-keymap "Tumme")))
|
|
1506
|
|
1507 (define-key tumme-thumbnail-mode-map
|
|
1508 [menu-bar tumme tumme-kill-buffer-and-window]
|
|
1509 '("Quit" . tumme-kill-buffer-and-window))
|
|
1510
|
|
1511 (define-key tumme-thumbnail-mode-map
|
|
1512 [menu-bar tumme tumme-delete-char]
|
|
1513 '("Delete thumbnail from buffer" . tumme-delete-char))
|
|
1514
|
|
1515 (define-key tumme-thumbnail-mode-map
|
|
1516 [menu-bar tumme tumme-tag-thumbnail-remove]
|
|
1517 '("Remove tag from thumbnail" . tumme-tag-thumbnail-remove))
|
|
1518
|
|
1519 (define-key tumme-thumbnail-mode-map
|
|
1520 [menu-bar tumme tumme-tag-thumbnail]
|
|
1521 '("Tag thumbnail" . tumme-tag-thumbnail))
|
|
1522
|
|
1523 (define-key tumme-thumbnail-mode-map
|
|
1524 [menu-bar tumme tumme-comment-thumbnail]
|
|
1525 '("Comment thumbnail" . tumme-comment-thumbnail))
|
|
1526
|
|
1527 (define-key tumme-thumbnail-mode-map
|
|
1528 [menu-bar tumme tumme-refresh-thumb]
|
|
1529 '("Refresh thumb" . tumme-refresh-thumb))
|
|
1530 (define-key tumme-thumbnail-mode-map
|
|
1531 [menu-bar tumme tumme-line-up-dynamic]
|
|
1532 '("Dynamic line up" . tumme-line-up-dynamic))
|
|
1533 (define-key tumme-thumbnail-mode-map
|
|
1534 [menu-bar tumme tumme-line-up]
|
|
1535 '("Line up thumbnails" . tumme-line-up))
|
|
1536
|
|
1537 (define-key tumme-thumbnail-mode-map
|
|
1538 [menu-bar tumme tumme-rotate-thumbnail-left]
|
|
1539 '("Rotate thumbnail left" . tumme-rotate-thumbnail-left))
|
|
1540 (define-key tumme-thumbnail-mode-map
|
|
1541 [menu-bar tumme tumme-rotate-thumbnail-right]
|
|
1542 '("Rotate thumbnail right" . tumme-rotate-thumbnail-right))
|
|
1543
|
|
1544 (define-key tumme-thumbnail-mode-map
|
|
1545 [menu-bar tumme tumme-rotate-original-left]
|
|
1546 '("Rotate original left" . tumme-rotate-original-left))
|
|
1547 (define-key tumme-thumbnail-mode-map
|
|
1548 [menu-bar tumme tumme-rotate-original-right]
|
|
1549 '("Rotate original right" . tumme-rotate-original-right))
|
|
1550
|
|
1551 (define-key tumme-thumbnail-mode-map
|
|
1552 [menu-bar tumme tumme-toggle-movement-tracking]
|
|
1553 '("Toggle movement tracking on/off" . tumme-toggle-movement-tracking))
|
|
1554
|
|
1555 (define-key tumme-thumbnail-mode-map
|
|
1556 [menu-bar tumme tumme-jump-original-dired-buffer]
|
|
1557 '("Jump to dired buffer" . tumme-jump-original-dired-buffer))
|
|
1558 (define-key tumme-thumbnail-mode-map
|
|
1559 [menu-bar tumme tumme-track-original-file]
|
|
1560 '("Track original" . tumme-track-original-file))
|
|
1561
|
|
1562 (define-key tumme-thumbnail-mode-map
|
|
1563 [menu-bar tumme tumme-flag-thumb-original-file]
|
|
1564 '("Flag original for deletion" . tumme-flag-thumb-original-file))
|
|
1565 (define-key tumme-thumbnail-mode-map
|
|
1566 [menu-bar tumme tumme-unmark-thumb-original-file]
|
|
1567 '("Unmark original" . tumme-unmark-thumb-original-file))
|
|
1568 (define-key tumme-thumbnail-mode-map
|
|
1569 [menu-bar tumme tumme-mark-thumb-original-file]
|
|
1570 '("Mark original" . tumme-mark-thumb-original-file))
|
|
1571
|
|
1572 (define-key tumme-thumbnail-mode-map
|
|
1573 [menu-bar tumme tumme-thumbnail-display-external]
|
|
1574 '("Display in external viewer" . tumme-thumbnail-display-external))
|
|
1575 (define-key tumme-thumbnail-mode-map
|
|
1576 [menu-bar tumme tumme-display-thumbnail-original-image]
|
|
1577 '("Display image" . tumme-display-thumbnail-original-image)))
|
|
1578
|
|
1579 (defvar tumme-display-image-mode-map (make-sparse-keymap)
|
|
1580 "Keymap for `tumme-display-image-mode'.")
|
|
1581
|
|
1582 (defun tumme-define-display-image-mode-keymap ()
|
|
1583 "Define keymap for `tumme-display-image-mode'."
|
|
1584
|
|
1585 ;; Keys
|
|
1586 (define-key tumme-display-image-mode-map "q" 'tumme-kill-buffer-and-window)
|
|
1587
|
|
1588 (define-key tumme-display-image-mode-map "f"
|
|
1589 'tumme-display-current-image-full)
|
|
1590
|
|
1591 (define-key tumme-display-image-mode-map "s"
|
|
1592 'tumme-display-current-image-sized)
|
|
1593
|
|
1594 ;; Menu
|
|
1595 (define-key tumme-display-image-mode-map [menu-bar tumme]
|
|
1596 (cons "Tumme" (make-sparse-keymap "Tumme")))
|
|
1597
|
|
1598 (define-key tumme-display-image-mode-map
|
|
1599 [menu-bar tumme tumme-kill-buffer-and-window]
|
|
1600 '("Quit" . tumme-kill-buffer-and-window))
|
|
1601
|
|
1602 (define-key tumme-display-image-mode-map
|
|
1603 [menu-bar tumme tumme-display-current-image-sized]
|
|
1604 '("Display original, sized to fit" . tumme-display-current-image-sized))
|
|
1605
|
|
1606 (define-key tumme-display-image-mode-map
|
|
1607 [menu-bar tumme tumme-display-current-image-full]
|
|
1608 '("Display original, full size" . tumme-display-current-image-full))
|
|
1609
|
|
1610 )
|
|
1611
|
|
1612 (defun tumme-display-current-image-full ()
|
|
1613 "Display current image in full size."
|
|
1614 (interactive)
|
|
1615 (let ((file (tumme-original-file-name)))
|
|
1616 (if file
|
|
1617 (progn
|
|
1618 (tumme-display-image file t)
|
|
1619 (message "Full size image displayed"))
|
|
1620 (error "No original file name at point"))))
|
|
1621
|
|
1622 (defun tumme-display-current-image-sized ()
|
|
1623 "Display current image in sized to fit window dimensions."
|
|
1624 (interactive)
|
|
1625 (let ((file (tumme-original-file-name)))
|
|
1626 (if file
|
|
1627 (progn
|
|
1628 (tumme-display-image file)
|
|
1629 (message "Full size image displayed"))
|
|
1630 (error "No original file name at point"))))
|
|
1631
|
|
1632 (define-derived-mode tumme-thumbnail-mode
|
|
1633 fundamental-mode "tumme-thumbnail"
|
|
1634 "Browse and manipulate thumbnail images using dired.
|
|
1635 Use `tumme-dired' and `tumme-setup-dired-keybindings' to get a
|
|
1636 nice setup to start with."
|
|
1637 (tumme-define-thumbnail-mode-keymap)
|
|
1638 (message "tumme-thumbnail-mode enabled"))
|
|
1639
|
|
1640 (define-derived-mode tumme-display-image-mode
|
|
1641 fundamental-mode "tumme-image-display"
|
|
1642 "Mode for displaying and manipulating original image.
|
|
1643 Resized or in full-size."
|
|
1644 (tumme-define-display-image-mode-keymap)
|
|
1645 (message "tumme-display-image-mode enabled"))
|
|
1646
|
68404
|
1647 ;;;###autoload
|
67302
|
1648 (defun tumme-setup-dired-keybindings ()
|
|
1649 "Setup easy-to-use keybindings for the commands to be used in dired mode.
|
|
1650 Note that n, p and <down> and <up> will be hijacked and bound to
|
|
1651 `tumme-dired-x-line'."
|
|
1652 (interactive)
|
|
1653
|
|
1654 ;; Hijack previous and next line movement. Let C-p and C-b be
|
|
1655 ;; though...
|
|
1656
|
|
1657 (define-key dired-mode-map "p" 'tumme-dired-previous-line)
|
|
1658 (define-key dired-mode-map "n" 'tumme-dired-next-line)
|
|
1659 (define-key dired-mode-map [up] 'tumme-dired-previous-line)
|
|
1660 (define-key dired-mode-map [down] 'tumme-dired-next-line)
|
|
1661
|
|
1662 (define-key dired-mode-map (kbd "C-S-n") 'tumme-next-line-and-display)
|
|
1663 (define-key dired-mode-map (kbd "C-S-p") 'tumme-previous-line-and-display)
|
|
1664 (define-key dired-mode-map (kbd "C-S-m") 'tumme-mark-and-display-next)
|
|
1665
|
|
1666 (define-key dired-mode-map "\C-td" 'tumme-display-thumbs)
|
|
1667 (define-key dired-mode-map "\C-tt" 'tumme-tag-files)
|
|
1668 (define-key dired-mode-map "\C-tr" 'tumme-tag-remove)
|
|
1669 (define-key dired-mode-map [tab] 'tumme-jump-thumbnail-buffer)
|
|
1670 (define-key dired-mode-map "\C-ti" 'tumme-display-dired-image)
|
|
1671 (define-key dired-mode-map "\C-tx" 'tumme-dired-display-external)
|
|
1672 (define-key dired-mode-map "\C-ta" 'tumme-display-thumbs-append)
|
|
1673 (define-key dired-mode-map "\C-t." 'tumme-display-thumb)
|
|
1674 (define-key dired-mode-map "\C-tc" 'tumme-dired-comment-files)
|
|
1675 (define-key dired-mode-map "\C-tf" 'tumme-mark-tagged-files)
|
|
1676
|
|
1677 ;; Menu for dired
|
|
1678 (define-key dired-mode-map [menu-bar tumme]
|
|
1679 (cons "Tumme" (make-sparse-keymap "Tumme")))
|
|
1680
|
|
1681 (define-key dired-mode-map [menu-bar tumme tumme-copy-with-exif-file-name]
|
|
1682 '("Copy with EXIF file name" . tumme-copy-with-exif-file-name))
|
|
1683
|
|
1684 (define-key dired-mode-map [menu-bar tumme tumme-dired-comment-files]
|
|
1685 '("Comment files" . tumme-dired-comment-files))
|
|
1686
|
|
1687 (define-key dired-mode-map [menu-bar tumme tumme-mark-tagged-files]
|
|
1688 '("Mark tagged files" . tumme-mark-tagged-files))
|
|
1689
|
|
1690 (define-key dired-mode-map [menu-bar tumme tumme-tag-remove]
|
|
1691 '("Remove tag from files" . tumme-tag-remove))
|
|
1692
|
|
1693 (define-key dired-mode-map [menu-bar tumme tumme-tag-files]
|
|
1694 '("Tag files" . tumme-tag-files))
|
|
1695
|
|
1696 (define-key dired-mode-map [menu-bar tumme tumme-jump-thumbnail-buffer]
|
|
1697 '("Jump to thumbnail buffer" . tumme-jump-thumbnail-buffer))
|
|
1698
|
|
1699 (define-key dired-mode-map [menu-bar tumme tumme-toggle-movement-tracking]
|
|
1700 '("Toggle movement tracking" . tumme-toggle-movement-tracking))
|
|
1701
|
|
1702 (define-key dired-mode-map
|
|
1703 [menu-bar tumme tumme-toggle-append-browsing]
|
|
1704 '("Toggle append browsing" . tumme-toggle-append-browsing))
|
|
1705
|
|
1706 (define-key dired-mode-map
|
|
1707 [menu-bar tumme tumme-toggle-disp-props]
|
|
1708 '("Toggle display properties" . tumme-toggle-dired-display-properties))
|
|
1709
|
|
1710 (define-key dired-mode-map
|
|
1711 [menu-bar tumme tumme-dired-display-external]
|
|
1712 '("Display in external viewer" . tumme-dired-display-external))
|
|
1713 (define-key dired-mode-map
|
|
1714 [menu-bar tumme tumme-display-dired-image]
|
|
1715 '("Display image" . tumme-display-dired-image))
|
|
1716 (define-key dired-mode-map
|
|
1717 [menu-bar tumme tumme-display-thumb]
|
|
1718 '("Display this thumbnail" . tumme-display-thumb))
|
|
1719 (define-key dired-mode-map
|
|
1720 [menu-bar tumme tumme-display-thumbs-append]
|
|
1721 '("Display thumbnails append" . tumme-display-thumbs-append))
|
|
1722 (define-key dired-mode-map
|
|
1723 [menu-bar tumme tumme-display-thumbs]
|
|
1724 '("Display thumbnails" . tumme-display-thumbs))
|
|
1725
|
|
1726 (define-key dired-mode-map
|
|
1727 [menu-bar tumme tumme-create-thumbs]
|
|
1728 '("Create thumbnails for marked files" . tumme-create-thumbs))
|
|
1729
|
|
1730 (define-key dired-mode-map
|
|
1731 [menu-bar tumme tumme-mark-and-display-next]
|
|
1732 '("Mark and display next" . tumme-mark-and-display-next))
|
|
1733 (define-key dired-mode-map
|
|
1734 [menu-bar tumme tumme-previous-line-and-display]
|
|
1735 '("Display thumb for previous file" . tumme-previous-line-and-display))
|
|
1736 (define-key dired-mode-map
|
|
1737 [menu-bar tumme tumme-next-line-and-display]
|
|
1738 '("Display thumb for next file" . tumme-next-line-and-display)))
|
|
1739
|
|
1740 (defun tumme-create-thumbs (&optional arg)
|
|
1741 "Create thumbnail images for all marked files in dired.
|
|
1742 With prefix argument ARG, create thumbnails even if they already exist
|
|
1743 \(i.e. use this to refresh your thumbnails)."
|
|
1744 (interactive "P")
|
|
1745 (let (curr-file thumb-name files count)
|
|
1746 (setq files (dired-get-marked-files))
|
|
1747 (mapcar
|
|
1748 (lambda (curr-file)
|
|
1749 (setq thumb-name (tumme-thumb-name curr-file))
|
|
1750 ;; If the user overrides the exist check, we must clear the
|
|
1751 ;; image cache so that if the user wants to display the
|
|
1752 ;; thumnail, it is not fetched from cache.
|
|
1753 (if arg
|
|
1754 (clear-image-cache))
|
|
1755 (if (or (not (file-exists-p thumb-name))
|
|
1756 arg)
|
|
1757 (if (not (= 0 (tumme-create-thumb curr-file
|
|
1758 (tumme-thumb-name curr-file))))
|
|
1759 (error "Thumb could not be created"))))
|
|
1760 files)))
|
|
1761
|
|
1762 (defvar tumme-slideshow-timer nil
|
|
1763 "Slideshow timer.")
|
|
1764
|
|
1765 (defvar tumme-slideshow-count 0
|
|
1766 "Keeping track on number of images in slideshow.")
|
|
1767
|
|
1768 (defvar tumme-slideshow-times 0
|
|
1769 "Number of pictures to display in slideshow.")
|
|
1770
|
|
1771 (defun tumme-slideshow-step ()
|
|
1772 "Step to next file, if `tumme-slideshow-times' has not been reached."
|
|
1773 (if (< tumme-slideshow-count tumme-slideshow-times)
|
|
1774 (progn
|
|
1775 (message "%s" (1+ tumme-slideshow-count))
|
|
1776 (setq tumme-slideshow-count (1+ tumme-slideshow-count))
|
|
1777 (tumme-next-line-and-display))
|
|
1778 (tumme-slideshow-stop)))
|
|
1779
|
|
1780 (defun tumme-slideshow-start ()
|
|
1781 "Start slideshow.
|
|
1782 Ask user for number of images to show and the delay in between."
|
|
1783 (interactive)
|
|
1784 (setq tumme-slideshow-count 0)
|
|
1785 (setq tumme-slideshow-times (string-to-number (read-string "How many: ")))
|
|
1786 (let ((repeat (string-to-number
|
|
1787 (read-string
|
|
1788 "Delay, in seconds. Decimals are accepted : " "1"))))
|
|
1789 (setq tumme-slideshow-timer
|
|
1790 (run-with-timer
|
|
1791 0 repeat
|
|
1792 'tumme-slideshow-step))))
|
|
1793
|
|
1794 (defun tumme-slideshow-stop ()
|
|
1795 "Cancel slideshow."
|
|
1796 (interactive)
|
|
1797 (cancel-timer tumme-slideshow-timer))
|
|
1798
|
|
1799 (defun tumme-delete-char ()
|
|
1800 "Remove current thumbnail from thumbnail buffer and line up."
|
|
1801 (interactive)
|
|
1802 (let ((inhibit-read-only t))
|
|
1803 (delete-char 1)
|
|
1804 (if (looking-at " ")
|
|
1805 (delete-char 1))))
|
|
1806
|
|
1807 (defun tumme-display-thumbs-append ()
|
|
1808 "Append thumbnails to `tumme-thumbnail-buffer'."
|
|
1809 (interactive)
|
|
1810 (tumme-display-thumbs nil t))
|
|
1811
|
|
1812 (defun tumme-display-thumb ()
|
|
1813 "Shorthard for `tumme-display-thumbs' with prefix argument."
|
|
1814 (interactive)
|
|
1815 (tumme-display-thumbs t))
|
|
1816
|
|
1817 (defun tumme-line-up ()
|
|
1818 "Line up thumbnails according to `tumme-thumbs-per-row'.
|
|
1819 See also `tumme-line-up-dynamic'."
|
|
1820 (interactive)
|
|
1821 (let ((inhibit-read-only t))
|
|
1822 (goto-char (point-min))
|
|
1823 (while (and (not (tumme-image-at-point-p))
|
|
1824 (not (eobp)))
|
|
1825 (delete-char 1))
|
|
1826 (while (not (eobp))
|
|
1827 (forward-char)
|
|
1828 (while (and (not (tumme-image-at-point-p))
|
|
1829 (not (eobp)))
|
|
1830 (delete-char 1)))
|
|
1831 (goto-char (point-min))
|
|
1832 (let ((count 0))
|
|
1833 (while (not (eobp))
|
|
1834 (forward-char)
|
|
1835 (if (= tumme-thumbs-per-row 1)
|
|
1836 (insert "\n")
|
|
1837 (insert " ")
|
|
1838 (setq count (1+ count))
|
|
1839 (if (= count (- tumme-thumbs-per-row 1))
|
|
1840 (progn
|
|
1841 (forward-char)
|
|
1842 (insert "\n")
|
|
1843 (setq count 0))))))
|
|
1844 (goto-char (point-min))))
|
|
1845
|
|
1846 (defun tumme-line-up-dynamic ()
|
|
1847 "Line up thumbnails images dynamically.
|
|
1848 Calculate how many thumbnails that fits."
|
|
1849 (interactive)
|
|
1850 (let* ((char-width (frame-char-width))
|
|
1851 (width (tumme-window-width-pixels (tumme-thumbnail-window)))
|
|
1852 (tumme-thumbs-per-row
|
|
1853 (/ width
|
|
1854 (+ (* 2 tumme-thumb-relief)
|
|
1855 (* 2 tumme-thumb-margin)
|
|
1856 tumme-thumb-size char-width))))
|
|
1857 (tumme-line-up)))
|
|
1858
|
|
1859 (defun tumme-line-up-interactive ()
|
|
1860 "Line up thumbnails interactively.
|
|
1861 Ask user how many thumbnails that should be displayed per row."
|
|
1862 (interactive)
|
|
1863 (let ((tumme-thumbs-per-row
|
|
1864 (string-to-number (read-string "How many thumbs per row: "))))
|
|
1865 (if (not (> tumme-thumbs-per-row 0))
|
|
1866 (message "Number must be greater than 0")
|
|
1867 (tumme-line-up))))
|
|
1868
|
|
1869 (defun tumme-thumbnail-display-external ()
|
|
1870 "Display original image for thumbnail at point using external viewer."
|
|
1871
|
|
1872 (interactive)
|
|
1873 (let ((file (tumme-original-file-name)))
|
|
1874 (if (not (tumme-image-at-point-p))
|
|
1875 (message "No thumbnail at point")
|
|
1876 (if (not file)
|
|
1877 (message "No original file name found")
|
|
1878 (shell-command (format "%s \"%s\""
|
|
1879 tumme-external-viewer
|
|
1880 file))))))
|
|
1881
|
|
1882 (defun tumme-dired-display-external ()
|
|
1883 "Display file at point using an external viewer."
|
|
1884 (interactive)
|
|
1885 (let ((file (dired-get-filename)))
|
|
1886 (shell-command (format "%s \"%s\""
|
|
1887 tumme-external-viewer
|
|
1888 file))))
|
|
1889
|
|
1890 (defun tumme-window-width-pixels (window)
|
|
1891 "Calculate WINDOW width in pixels."
|
|
1892 (* (window-width window) (frame-char-width)))
|
|
1893
|
|
1894 (defun tumme-window-height-pixels (window)
|
|
1895 "Calculate WINDOW height in pixels."
|
|
1896 ;; Note: The mode-line consumes one line
|
|
1897 (* (- (window-height window) 1) (frame-char-height)))
|
|
1898
|
|
1899 (defun tumme-display-window ()
|
|
1900 "Return window where `tumme-display-image-buffer' is visible."
|
|
1901 (get-window-with-predicate
|
|
1902 (lambda (window)
|
|
1903 (equal (buffer-name (window-buffer window)) tumme-display-image-buffer))
|
|
1904 nil t))
|
|
1905
|
|
1906 (defun tumme-thumbnail-window ()
|
|
1907 "Return window where `tumme-thumbnail-buffer' is visible."
|
|
1908 (get-window-with-predicate
|
|
1909 (lambda (window)
|
|
1910 (equal (buffer-name (window-buffer window)) tumme-thumbnail-buffer))
|
|
1911 nil t))
|
|
1912
|
|
1913 (defun tumme-associated-dired-buffer-window ()
|
|
1914 "Return window where associated dired buffer is visible."
|
|
1915 (let (buf)
|
|
1916 (if (tumme-image-at-point-p)
|
|
1917 (progn
|
|
1918 (setq buf (tumme-associated-dired-buffer))
|
|
1919 (get-window-with-predicate
|
|
1920 (lambda (window)
|
|
1921 (equal (window-buffer window) buf))))
|
|
1922 (error "No thumbnail image at point"))))
|
|
1923
|
|
1924 (defun tumme-display-window-width ()
|
|
1925 "Return width, in pixels, of tumme's image display window."
|
|
1926 (- (tumme-window-width-pixels (tumme-display-window))
|
|
1927 tumme-display-window-width-correction))
|
|
1928
|
|
1929 (defun tumme-display-window-height ()
|
|
1930 "Return height, in pixels, of tumme's image display window."
|
|
1931 (- (tumme-window-height-pixels (tumme-display-window))
|
|
1932 tumme-display-window-height-correction))
|
|
1933
|
|
1934 (defun tumme-display-image (file &optional original-size)
|
|
1935 "Display image FILE in image buffer.
|
|
1936 Use this when you want to display the image, semi sized, in a window
|
|
1937 next to the thumbnail window - typically a three-window configuration
|
|
1938 with dired to the left, thumbnail window to the upper right and image
|
|
1939 window to the lower right. The image is sized to fit the display
|
|
1940 window (using a temporary file, don't worry). Because of this, it
|
|
1941 will not be as quick as opening it directly, but on most modern
|
|
1942 systems it should feel snappy enough.
|
|
1943
|
|
1944 If optional argument ORIGINAL-SIZE is non-nil, display image in its
|
|
1945 original size."
|
|
1946 (let ((new-file (expand-file-name tumme-temp-image-file))
|
|
1947 size-x size-y command ret)
|
|
1948 (setq file (expand-file-name file))
|
|
1949 (if (not original-size)
|
|
1950 (progn
|
|
1951 (setq size-x (tumme-display-window-width))
|
|
1952 (setq size-y (tumme-display-window-height))
|
|
1953 (setq command
|
|
1954 (format-spec
|
|
1955 tumme-cmd-create-temp-image-options
|
|
1956 (list
|
|
1957 (cons ?p tumme-cmd-create-temp-image-program)
|
|
1958 (cons ?x size-x)
|
|
1959 (cons ?y size-y)
|
|
1960 (cons ?f file)
|
|
1961 (cons ?t new-file))))
|
|
1962 (setq ret (shell-command command nil))
|
|
1963 (if (not (= 0 ret))
|
|
1964 (error "Could not resize image")))
|
|
1965 (copy-file file new-file t))
|
|
1966 (save-excursion
|
|
1967 (set-buffer (tumme-create-display-image-buffer))
|
|
1968 (let ((inhibit-read-only t))
|
|
1969 (erase-buffer)
|
|
1970 (clear-image-cache)
|
|
1971 (tumme-insert-image tumme-temp-image-file 'jpeg 0 0)
|
|
1972 (goto-char (point-min))
|
|
1973 (tumme-update-property 'original-file-name file)))))
|
|
1974
|
|
1975 (defun tumme-display-thumbnail-original-image (&optional arg)
|
|
1976 "Display current thumbnail's original image in display buffer.
|
|
1977 See documentation for `tumme-display-image' for more information.
|
|
1978 With prefix argument ARG, display image in its original size."
|
|
1979 (interactive "P")
|
|
1980 (let ((file (tumme-original-file-name)))
|
|
1981 (if (not (string-equal major-mode "tumme-thumbnail-mode"))
|
|
1982 (message "Not in tumme-thumbnail-mode")
|
|
1983 (if (not (tumme-image-at-point-p))
|
|
1984 (message "No thumbnail at point")
|
|
1985 (if (not file)
|
|
1986 (message "No original file name found")
|
|
1987 (tumme-display-image file arg))))))
|
|
1988
|
|
1989 (defun tumme-display-dired-image (&optional arg)
|
|
1990 "Display current image file.
|
|
1991 See documentation for `tumme-display-image' for more information.
|
|
1992 With prefix argument ARG, display image in its original size."
|
|
1993 (interactive "P")
|
|
1994 (tumme-display-image (dired-get-filename) arg))
|
|
1995
|
|
1996 (defun tumme-image-at-point-p ()
|
|
1997 "Return true if there is a tumme thumbnail at point."
|
|
1998 (get-text-property (point) 'tumme-thumbnail))
|
|
1999
|
|
2000 (defun tumme-rotate-thumbnail (degrees)
|
|
2001 "Rotate thumbnail DEGREES degrees."
|
|
2002 (if (not (tumme-image-at-point-p))
|
|
2003 (message "No thumbnail at point")
|
|
2004 (let ((file (tumme-thumb-name (tumme-original-file-name)))
|
|
2005 command)
|
|
2006 (setq command (format-spec
|
|
2007 tumme-cmd-rotate-thumbnail-options
|
|
2008 (list
|
|
2009 (cons ?p tumme-cmd-rotate-thumbnail-program)
|
|
2010 (cons ?d degrees)
|
|
2011 (cons ?t (expand-file-name file)))))
|
|
2012 (shell-command command nil)
|
|
2013 ;; Clear the cache to refresh image. I wish I could just refresh
|
|
2014 ;; the current file but I do not know how to do that. Yet...
|
|
2015 (clear-image-cache))))
|
|
2016
|
|
2017 (defun tumme-rotate-thumbnail-left ()
|
|
2018 "Rotate thumbnail left (counter clockwise) 90 degrees.
|
|
2019 The result of the rotation is displayed in the image display area
|
|
2020 and a confirmation is needed before the original image files is
|
|
2021 overwritten. This confirmation can be turned off using
|
|
2022 `tumme-rotate-original-ask-before-overwrite'."
|
|
2023 (interactive)
|
|
2024 (tumme-rotate-thumbnail "270"))
|
|
2025
|
|
2026 (defun tumme-rotate-thumbnail-right ()
|
|
2027 "Rotate thumbnail counter right (clockwise) 90 degrees.
|
|
2028 The result of the rotation is displayed in the image display area
|
|
2029 and a confirmation is needed before the original image files is
|
|
2030 overwritten. This confirmation can be turned off using
|
|
2031 `tumme-rotate-original-ask-before-overwrite'."
|
|
2032 (interactive)
|
|
2033 (tumme-rotate-thumbnail "90"))
|
|
2034
|
|
2035 (defun tumme-refresh-thumb ()
|
|
2036 "Force creation of new image for current thumbnail."
|
|
2037 (interactive)
|
|
2038 (let ((file (tumme-original-file-name)))
|
|
2039 (clear-image-cache)
|
|
2040 (tumme-create-thumb file (tumme-thumb-name file))))
|
|
2041
|
|
2042 (defun tumme-rotate-original (degrees)
|
|
2043 "Rotate original image DEGREES degrees."
|
|
2044 (if (not (tumme-image-at-point-p))
|
|
2045 (message "No image at point")
|
|
2046 (let ((file (tumme-original-file-name))
|
|
2047 command temp-file)
|
|
2048 (if (not (string-match "\.[jJ][pP[eE]?[gG]$" file))
|
|
2049 (error "Only JPEG images can be rotated!"))
|
|
2050 (setq command (format-spec
|
|
2051 tumme-cmd-rotate-original-options
|
|
2052 (list
|
|
2053 (cons ?p tumme-cmd-rotate-original-program)
|
|
2054 (cons ?d degrees)
|
|
2055 (cons ?o (expand-file-name file))
|
|
2056 (cons ?t tumme-temp-rotate-image-file))))
|
|
2057 (if (not (= 0 (shell-command command nil)))
|
|
2058 (error "Could not rotate image")
|
|
2059 (tumme-display-image tumme-temp-rotate-image-file)
|
|
2060 (if (or (and tumme-rotate-original-ask-before-overwrite
|
|
2061 (y-or-n-p "Rotate to temp file OK. Overwrite original image? "))
|
|
2062 (not tumme-rotate-original-ask-before-overwrite))
|
|
2063 (progn
|
|
2064 (copy-file tumme-temp-rotate-image-file file t)
|
|
2065 (tumme-refresh-thumb))
|
|
2066 (tumme-display-image file))))))
|
|
2067
|
|
2068 (defun tumme-rotate-original-left ()
|
|
2069 "Rotate original image left (counter clockwise) 90 degrees."
|
|
2070 (interactive)
|
|
2071 (tumme-rotate-original "270"))
|
|
2072
|
|
2073 (defun tumme-rotate-original-right ()
|
|
2074 "Rotate original image right (clockwise) 90 degrees."
|
|
2075 (interactive)
|
|
2076 (tumme-rotate-original "90"))
|
|
2077
|
|
2078 (defun tumme-get-exif-file-name (file)
|
|
2079 "Use the image's EXIF information to return a unique file name.
|
|
2080 The file name should be unique as long as you do not take more than
|
|
2081 one picture per second. The original file name is suffixed at the end
|
|
2082 for traceability. The format of the returned file name is
|
|
2083 YYYY_MM_DD_HH_MM_DD_ORIG_FILE_NAME.jpg. Used from
|
|
2084 `tumme-copy-with-exif-file-name'."
|
|
2085 (let (data no-exif-data-found)
|
|
2086 (if (not (string-match "\.[Jj][Pp][Ee]?[Gg]$" (expand-file-name file)))
|
|
2087 (progn
|
|
2088 (setq no-exif-data-found t)
|
|
2089 (setq data
|
|
2090 (format-time-string
|
|
2091 "%Y:%m:%d %H:%M:%S"
|
|
2092 (nth 5 (file-attributes (expand-file-name file))))))
|
|
2093 (setq data (tumme-get-exif-data (expand-file-name file) "DateTimeOriginal")))
|
|
2094 (while (string-match "[ :]" data)
|
|
2095 (setq data (replace-match "_" nil nil data)))
|
|
2096 (format "%s%s%s" data
|
|
2097 (if no-exif-data-found
|
|
2098 "_noexif_"
|
|
2099 "_")
|
|
2100 (file-name-nondirectory file))))
|
|
2101
|
|
2102 (defun tumme-thumbnail-set-image-description ()
|
|
2103 "Set the ImageDescription EXIF tag for the original image.
|
|
2104 If the image already has a value for this tag, it is used as the
|
|
2105 default value at the prompt."
|
|
2106 (interactive)
|
|
2107 (if (not (tumme-image-at-point-p))
|
|
2108 (message "No thumbnail at point")
|
|
2109 (let* ((file (tumme-original-file-name))
|
|
2110 (old-value (tumme-get-exif-data file "ImageDescription")))
|
|
2111 (if (eq 0
|
|
2112 (tumme-set-exif-data file "ImageDescription"
|
|
2113 (read-string "Value of ImageDescription: " old-value)))
|
|
2114 (message "Successfully wrote ImageDescription tag.")
|
|
2115 (error "Could not write ImageDescription tag")))))
|
|
2116
|
|
2117 (defun tumme-set-exif-data (file tag-name tag-value)
|
|
2118 "In FILE, set EXIF tag TAG-NAME to value TAG-VALUE."
|
|
2119 (let (command)
|
|
2120 (setq command (format-spec
|
|
2121 tumme-cmd-write-exif-data-options
|
|
2122 (list
|
|
2123 (cons ?p tumme-cmd-write-exif-data-program)
|
|
2124 (cons ?f (expand-file-name file))
|
|
2125 (cons ?t tag-name)
|
|
2126 (cons ?v tag-value))))
|
|
2127 (shell-command command nil)))
|
|
2128
|
|
2129 (defun tumme-get-exif-data (file tag-name)
|
|
2130 "From FILE, return EXIF tag TAG-NAME."
|
|
2131 (let ((buf (get-buffer-create "*tumme-get-exif-data*"))
|
|
2132 command tag-value)
|
|
2133 (setq command (format-spec
|
|
2134 tumme-cmd-read-exif-data-options
|
|
2135 (list
|
|
2136 (cons ?p tumme-cmd-read-exif-data-program)
|
|
2137 (cons ?f file)
|
|
2138 (cons ?t tag-name))))
|
|
2139 (save-excursion
|
|
2140 (set-buffer buf)
|
|
2141 (delete-region (point-min) (point-max))
|
|
2142 (if (not (eq (shell-command command buf) 0))
|
|
2143 (error "Could not get EXIF tag")
|
|
2144 (goto-char (point-min))
|
|
2145 ;; Clean buffer from newlines and carriage returns before
|
|
2146 ;; getting final info
|
|
2147 (while (search-forward-regexp "[\n\r]" nil t)
|
|
2148 (replace-match "" nil t))
|
|
2149 (setq tag-value (buffer-substring (point-min) (point-max)))))
|
|
2150 tag-value))
|
|
2151
|
|
2152 (defun tumme-copy-with-exif-file-name ()
|
|
2153 "Copy file with unique name to main image directory.
|
|
2154 Copy current or all marked files in dired to a new file in your main
|
|
2155 image directory, using a file name generated by
|
|
2156 `tumme-get-exif-file-name'. This might or might not be useful for
|
|
2157 other people, but I use it each time I fetch images from my digital
|
|
2158 camera, for copying the images into my main image directory.
|
|
2159
|
|
2160 Typically I open up the folder where I store my incoming digital
|
|
2161 images, with file names like dscn0319.jpg, dscn0320.jpg etc., mark the
|
|
2162 files I want to copy into my main image directory, and execute this
|
|
2163 function. The result is a couple of new files in
|
|
2164 `tumme-main-image-directory' called 2005_05_08_12_52_00_dscn0319.jpg,
|
|
2165 2005_05_08_14_27_45_dscn0320.jpg etc.
|
|
2166
|
|
2167 When the images are safely in my main image directory I start to
|
|
2168 browse and tag them using rest of the functionality in `tumme'."
|
|
2169 (interactive)
|
|
2170 (let (new-name
|
|
2171 (files (dired-get-marked-files)))
|
|
2172 (mapcar
|
|
2173 (lambda (curr-file)
|
|
2174 (setq new-name
|
|
2175 (format "%s/%s"
|
|
2176 (file-name-as-directory
|
|
2177 (expand-file-name tumme-main-image-directory))
|
|
2178 (tumme-get-exif-file-name curr-file)))
|
|
2179 (message "Copying %s to %s" curr-file new-name)
|
|
2180 (copy-file curr-file new-name))
|
|
2181 files)))
|
|
2182
|
|
2183 (defun tumme-display-next-thumbnail-original ()
|
|
2184 "In thubnail buffer, move to next thumbnail and display the image."
|
|
2185 (interactive)
|
|
2186 (tumme-forward-char)
|
|
2187 (tumme-display-thumbnail-original-image))
|
|
2188
|
|
2189 (defun tumme-display-previous-thumbnail-original ()
|
|
2190 "Move to previous thumbnail and display image."
|
|
2191
|
|
2192 (interactive)
|
|
2193 (tumme-backward-char)
|
|
2194 (tumme-display-thumbnail-original-image))
|
|
2195
|
|
2196 (defun tumme-write-comment (file comment)
|
|
2197 "For FILE, write comment COMMENT in database."
|
|
2198 (save-excursion
|
|
2199 (let (end buf comment-beg
|
|
2200 (base-name (file-name-nondirectory file)))
|
|
2201 (setq buf (find-file tumme-db-file))
|
|
2202 (goto-char (point-min))
|
|
2203 (if (search-forward-regexp
|
|
2204 (format "^%s" base-name) nil t)
|
|
2205 (progn
|
|
2206 (end-of-line)
|
|
2207 (setq end (point))
|
|
2208 (beginning-of-line)
|
|
2209 ;; Delete old comment, if any
|
|
2210 (cond ((search-forward ";comment:" end t)
|
|
2211 (setq comment-beg (match-beginning 0))
|
|
2212 ;; Any tags after the comment?
|
|
2213 (if (search-forward ";" end t)
|
|
2214 (setq comment-end (- (point) 1))
|
|
2215 (setq comment-end end))
|
|
2216 ;; Delete comment tag and comment
|
|
2217 (delete-region comment-beg comment-end)))
|
|
2218 ;; Insert new comment
|
|
2219 (beginning-of-line)
|
|
2220 (if (not (search-forward ";" end t))
|
|
2221 (progn
|
|
2222 (end-of-line)
|
|
2223 (insert ";")))
|
|
2224 (insert (format "comment:%s;" comment)))
|
|
2225 ;; File does not exist in databse - add it.
|
|
2226 (goto-char (point-max))
|
|
2227 (insert (format "\n%s;comment:%s" base-name comment)))
|
|
2228 (save-buffer)
|
|
2229 (kill-buffer buf))))
|
|
2230
|
|
2231 (defun tumme-update-property (prop value)
|
|
2232 "Update text property PROP with value VALUE at point."
|
|
2233 (let ((inhibit-read-only t))
|
|
2234 (put-text-property
|
|
2235 (point) (1+ (point))
|
|
2236 prop
|
|
2237 value)))
|
|
2238
|
|
2239 (defun tumme-dired-comment-files ()
|
|
2240 "Add comment to current or marked files in dired."
|
|
2241 (interactive)
|
|
2242 (let ((files (dired-get-marked-files))
|
|
2243 (comment (tumme-read-comment)))
|
|
2244 (mapcar
|
|
2245 (lambda (curr-file)
|
|
2246 (tumme-write-comment curr-file comment))
|
|
2247 files)))
|
|
2248
|
|
2249 (defun tumme-comment-thumbnail ()
|
|
2250 "Add comment to current thumbnail in thumbnail buffer."
|
|
2251 (interactive)
|
|
2252 (let* ((file (tumme-original-file-name))
|
|
2253 (comment (tumme-read-comment file)))
|
|
2254 (tumme-write-comment file comment)
|
|
2255 (tumme-update-property 'comment comment))
|
|
2256 (tumme-display-thumb-properties))
|
|
2257
|
|
2258 (defun tumme-read-comment (&optional file)
|
|
2259 "Read comment, optionally using old comment from FILE as initial value."
|
|
2260
|
|
2261 (let ((comment
|
|
2262 (read-string
|
|
2263 "Comment: "
|
|
2264 (if file (tumme-get-comment file)))))
|
|
2265 comment))
|
|
2266
|
|
2267 (defun tumme-get-comment (file)
|
|
2268 "Get comment for file FILE."
|
|
2269 (save-excursion
|
|
2270 (let (end buf comment-beg comment (base-name (file-name-nondirectory file)))
|
|
2271 (setq buf (find-file tumme-db-file))
|
|
2272 (goto-char (point-min))
|
|
2273 (if (search-forward-regexp
|
|
2274 (format "^%s" base-name) nil t)
|
|
2275 (progn
|
|
2276 (end-of-line)
|
|
2277 (setq end (point))
|
|
2278 (beginning-of-line)
|
|
2279 (cond ((search-forward ";comment:" end t)
|
|
2280 (setq comment-beg (point))
|
|
2281 (if (search-forward ";" end t)
|
|
2282 (setq comment-end (- (point) 1))
|
|
2283 (setq comment-end end))
|
|
2284 (setq comment (buffer-substring
|
|
2285 comment-beg comment-end))))))
|
|
2286 (kill-buffer buf)
|
|
2287 comment)))
|
|
2288
|
|
2289 (defun tumme-mark-tagged-files ()
|
|
2290 "Use regexp to mark files with matching tag."
|
|
2291 (interactive)
|
|
2292 (let ((tag (read-string "Mark tagged files (regexp): "))
|
|
2293 (hits 0)
|
|
2294 files buf)
|
|
2295 (save-excursion
|
|
2296 (setq buf (find-file tumme-db-file))
|
|
2297 (goto-char (point-min))
|
|
2298 ;; Collect matches
|
|
2299 (while (search-forward-regexp
|
|
2300 (concat "\\(^[^;]+\\);.*" tag ".*$") nil t)
|
|
2301 (setq files (append (list (match-string 1)) files)))
|
|
2302 (kill-buffer buf)
|
|
2303 ;; Mark files
|
|
2304 (mapcar
|
|
2305 ;; I tried using `dired-mark-files-regexp' but it was
|
|
2306 ;; waaaay to slow.
|
|
2307 (lambda (curr-file)
|
|
2308 ;; Don't bother about hits found in other directories than
|
|
2309 ;; the current one.
|
|
2310 (when (string= (file-name-as-directory
|
|
2311 (expand-file-name default-directory))
|
|
2312 (file-name-as-directory
|
|
2313 (file-name-directory curr-file)))
|
|
2314 (setq curr-file (file-name-nondirectory curr-file))
|
|
2315 (goto-char (point-min))
|
|
2316 (when (search-forward-regexp (format "\\s %s$" curr-file) nil t)
|
|
2317 (setq hits (+ hits 1))
|
|
2318 (dired-mark 1))))
|
|
2319 files))
|
|
2320 (message "%d files with matching tag marked." hits)))
|
|
2321
|
|
2322 (defun tumme-mouse-display-image (event)
|
|
2323 "Use mouse EVENT, call `tumme-display-image' to display image.
|
|
2324 Track this in associated dired buffer if `tumme-track-movement' is
|
|
2325 non-nil."
|
|
2326 (interactive "e")
|
|
2327 (let (file)
|
|
2328 (mouse-set-point event)
|
|
2329 (goto-char (posn-point (event-end event)))
|
|
2330 (setq file (tumme-original-file-name))
|
|
2331 (if tumme-track-movement
|
|
2332 (tumme-track-original-file))
|
|
2333 (tumme-display-image file)))
|
|
2334
|
|
2335 (defun tumme-mouse-select-thumbnail (event)
|
|
2336 "Use mouse EVENT to select thumbnail image.
|
|
2337 Track this in associated dired buffer if `tumme-track-movement' is
|
|
2338 non-nil."
|
|
2339 (interactive "e")
|
|
2340 (let (file)
|
|
2341 (mouse-set-point event)
|
|
2342 (goto-char (posn-point (event-end event)))
|
|
2343 (if tumme-track-movement
|
|
2344 (tumme-track-original-file)))
|
|
2345 (tumme-display-thumb-properties))
|
|
2346
|
|
2347 (defun tumme-mouse-toggle-mark (event)
|
|
2348 "Use mouse EVENT to toggle dired mark for thumbnail.
|
|
2349 Track this in associated dired buffer if `tumme-track-movement' is
|
|
2350 non-nil."
|
|
2351 (interactive "e")
|
|
2352 (let (file)
|
|
2353 (mouse-set-point event)
|
|
2354 (goto-char (posn-point (event-end event)))
|
|
2355 (if tumme-track-movement
|
|
2356 (tumme-track-original-file)))
|
|
2357 (tumme-toggle-mark-thumb-original-file))
|
|
2358
|
|
2359 (defun tumme-dired-display-properties ()
|
|
2360 "Display properties for dired file in the echo area."
|
|
2361 (interactive)
|
|
2362 (let* ((file (dired-get-filename))
|
|
2363 (file-name (file-name-nondirectory file))
|
|
2364 (dired-buf (buffer-name (current-buffer)))
|
|
2365 (props (mapconcat
|
|
2366 'princ
|
|
2367 (tumme-list-tags file)
|
|
2368 ", "))
|
|
2369 (comment (tumme-get-comment file)))
|
|
2370 (if file-name
|
|
2371 (message
|
|
2372 (tumme-format-properties-string
|
|
2373 dired-buf
|
|
2374 file-name
|
|
2375 props
|
|
2376 comment)))))
|
|
2377
|
|
2378 (defvar tumme-tag-file-list nil
|
|
2379 "List to store tag-file structure.")
|
|
2380
|
|
2381 (defvar tumme-file-tag-list nil
|
|
2382 "List to store file-tag structure.")
|
|
2383
|
|
2384 (defvar tumme-file-comment-list nil
|
|
2385 "List to store file comments.")
|
|
2386
|
|
2387 (defun tumme-add-to-tag-file-list (tag file)
|
|
2388 "Add relation between TAG and FILE."
|
|
2389 (let (curr)
|
|
2390 (if tumme-tag-file-list
|
|
2391 (if (setq curr (assoc tag tumme-tag-file-list))
|
|
2392 (if (not (member file curr))
|
|
2393 (setcdr curr (cons file (cdr curr))))
|
|
2394 (setcdr tumme-tag-file-list
|
|
2395 (cons (list tag file) (cdr tumme-tag-file-list))))
|
|
2396 (setq tumme-tag-file-list (list (list tag file))))))
|
|
2397
|
|
2398 (defun tumme-add-to-tag-file-lists (tag file)
|
|
2399 "Helper function used from `tumme-create-gallery-lists'.
|
|
2400
|
|
2401 Add TAG to FILE in one list and FILE to TAG in the other.
|
|
2402
|
|
2403 Lisp structures look like the following:
|
|
2404
|
|
2405 tumme-file-tag-list:
|
|
2406
|
|
2407 ((\"filename1\" \"tag1\" \"tag2\" \"tag3\" ...)
|
|
2408 (\"filename2\" \"tag1\" \"tag2\" \"tag3\" ...)
|
|
2409 ...)
|
|
2410
|
|
2411 tumme-tag-file-list:
|
|
2412
|
|
2413 ((\"tag1\" \"filename1\" \"filename2\" \"filename3\" ...)
|
|
2414 (\"tag2\" \"filename1\" \"filename2\" \"filename3\" ...)
|
|
2415 ...)"
|
|
2416 ;; Add tag to file list
|
|
2417 (let (curr)
|
|
2418 (if tumme-file-tag-list
|
|
2419 (if (setq curr (assoc file tumme-file-tag-list))
|
|
2420 (setcdr curr (cons tag (cdr curr)))
|
|
2421 (setcdr tumme-file-tag-list
|
|
2422 (cons (list file tag) (cdr tumme-file-tag-list))))
|
|
2423 (setq tumme-file-tag-list (list (list file tag))))
|
|
2424 ;; Add file to tag list
|
|
2425 (if tumme-tag-file-list
|
|
2426 (if (setq curr (assoc tag tumme-tag-file-list))
|
|
2427 (if (not (member file curr))
|
|
2428 (setcdr curr (cons file (cdr curr))))
|
|
2429 (setcdr tumme-tag-file-list
|
|
2430 (cons (list tag file) (cdr tumme-tag-file-list))))
|
|
2431 (setq tumme-tag-file-list (list (list tag file))))))
|
|
2432
|
|
2433 (defun tumme-add-to-file-comment-list (file comment)
|
|
2434 "Helper function used from `tumme-create-gallery-lists'.
|
|
2435
|
|
2436 For FILE, add COMMENT to list.
|
|
2437
|
|
2438 Lisp structure looks like the following:
|
|
2439
|
|
2440 tumme-file-comment-list:
|
|
2441
|
|
2442 ((\"filename1\" . \"comment1\")
|
|
2443 (\"filename2\" . \"comment2\")
|
|
2444 ...)"
|
|
2445 (if tumme-file-comment-list
|
|
2446 (if (not (assoc file tumme-file-comment-list))
|
|
2447 (setcdr tumme-file-comment-list
|
|
2448 (cons (cons file comment)
|
|
2449 (cdr tumme-file-comment-list))))
|
|
2450 (setq tumme-file-comment-list (list (cons file comment)))))
|
|
2451
|
|
2452 (defun tumme-create-gallery-lists ()
|
|
2453 "Create temporary lists used by `tumme-gallery-generate'."
|
|
2454 (let ((buf (find-file tumme-db-file))
|
|
2455 end beg file row-tags)
|
|
2456 (setq tumme-tag-file-list nil)
|
|
2457 (setq tumme-file-tag-list nil)
|
|
2458 (setq tumme-file-comment-list nil)
|
|
2459 (goto-char (point-min))
|
|
2460 (while (search-forward-regexp "^." nil t)
|
|
2461 (end-of-line)
|
|
2462 (setq end (point))
|
|
2463 (beginning-of-line)
|
|
2464 (setq beg (point))
|
|
2465 (if (not (search-forward ";" end nil))
|
|
2466 (error "Something is really wrong, check format of database"))
|
|
2467 (setq row-tags (split-string
|
|
2468 (buffer-substring beg end) ";"))
|
|
2469 (setq file (car row-tags))
|
|
2470 (mapc
|
|
2471 (lambda (x)
|
|
2472 (if (not (string-match "^comment:\\(.*\\)" x))
|
|
2473 (tumme-add-to-tag-file-lists x file)
|
|
2474 (tumme-add-to-file-comment-list file (match-string 1 x))))
|
|
2475 (cdr row-tags)))
|
|
2476 (kill-buffer buf))
|
|
2477 ;; Sort tag-file list
|
|
2478 (setq tumme-tag-file-list
|
|
2479 (sort tumme-tag-file-list
|
|
2480 (lambda (x y)
|
|
2481 (string< (car x) (car y))))))
|
|
2482
|
|
2483 (defun tumme-hidden-p (file)
|
|
2484 "Return t if image FILE has a \"hidden\" tag."
|
|
2485 (let (hidden)
|
|
2486 (mapc
|
|
2487 (lambda (tag)
|
|
2488 (if (member tag tumme-gallery-hidden-tags)
|
|
2489 (setq hidden t)))
|
|
2490 (cdr (assoc file tumme-file-tag-list)))
|
|
2491 hidden))
|
|
2492
|
|
2493 (defun tumme-gallery-generate ()
|
|
2494 "Generate gallery pages.
|
|
2495 First we create a couple of Lisp structures from the database to make
|
|
2496 it easier to generate, then HTML-files are created in
|
|
2497 `tumme-gallery-dir'"
|
|
2498 (interactive)
|
|
2499 (if (eq 'per-directory tumme-thumbnail-storage)
|
|
2500 (error "Currently, gallery generation is not supported \
|
|
2501 when using per-directory thumbnail file storage"))
|
|
2502 (tumme-create-gallery-lists)
|
|
2503 (let ((tags tumme-tag-file-list)
|
|
2504 count curr tag index-buf tag-buf
|
|
2505 comment file-tags tag-link tag-link-list)
|
|
2506 ;; Make sure gallery root exist
|
|
2507 (if (file-exists-p tumme-gallery-dir)
|
|
2508 (if (not (file-directory-p tumme-gallery-dir))
|
|
2509 (error "Tumme-gallery-dir is not a directory"))
|
|
2510 (make-directory tumme-gallery-dir))
|
|
2511 ;; Open index file
|
|
2512 (setq index-buf (find-file
|
|
2513 (format "%s/index.html" tumme-gallery-dir)))
|
|
2514 (erase-buffer)
|
|
2515 (insert "<html>\n")
|
|
2516 (insert " <body>\n")
|
|
2517 (insert " <h2>Tumme Gallery</h2>\n")
|
|
2518 (insert (format "<p>\n Gallery generated %s\n <p>\n"
|
|
2519 (current-time-string)))
|
|
2520 (insert " <h3>Tag index</h3>\n")
|
|
2521 (setq count 1)
|
|
2522 ;; Pre-generate list of all tag links
|
|
2523 (mapc
|
|
2524 (lambda (curr)
|
|
2525 (setq tag (car curr))
|
|
2526 (when (not (member tag tumme-gallery-hidden-tags))
|
|
2527 (setq tag-link (format "<a href=\"%d.html\">%s</a>" count tag))
|
|
2528 (if tag-link-list
|
|
2529 (setq tag-link-list
|
|
2530 (append tag-link-list (list (cons tag tag-link))))
|
|
2531 (setq tag-link-list (list (cons tag tag-link))))
|
|
2532 (setq count (1+ count))))
|
|
2533 tags)
|
|
2534 (setq count 1)
|
|
2535 ;; Main loop where we generated thumbnail pages per tag
|
|
2536 (mapc
|
|
2537 (lambda (curr)
|
|
2538 (setq tag (car curr))
|
|
2539 ;; Don't display hidden tags
|
|
2540 (when (not (member tag tumme-gallery-hidden-tags))
|
|
2541 ;; Insert link to tag page in index
|
|
2542 (insert (format " %s<br>\n" (cdr (assoc tag tag-link-list))))
|
|
2543 ;; Open per-tag file
|
|
2544 (setq tag-buf (find-file
|
|
2545 (format "%s/%s.html" tumme-gallery-dir count)))
|
|
2546 (erase-buffer)
|
|
2547 (insert "<html>\n")
|
|
2548 (insert " <body>\n")
|
|
2549 (insert " <p><a href=\"index.html\">Index</a></p>\n")
|
|
2550 (insert (format " <h2>Images with tag "%s"</h2>" tag))
|
|
2551 ;; Main loop for files per tag page
|
|
2552 (mapc
|
|
2553 (lambda (file)
|
|
2554 (when (not (tumme-hidden-p file))
|
|
2555 ;; Insert thumbnail with link to full image
|
|
2556 (insert
|
|
2557 (format "<a href=\"%s/%s\"><img src=\"%s/%s\"%s></a>\n"
|
|
2558 tumme-gallery-image-root-url file
|
|
2559 tumme-gallery-thumb-image-root-url
|
|
2560 (file-name-nondirectory (tumme-thumb-name file)) file))
|
|
2561 ;; Insert comment, if any
|
|
2562 (if (setq comment (cdr (assoc file tumme-file-comment-list)))
|
|
2563 (insert (format "<br>\n%s<br>\n" comment))
|
|
2564 (insert "<br>\n"))
|
|
2565 ;; Insert links to other tags, if any
|
|
2566 (when (> (length
|
|
2567 (setq file-tags (assoc file tumme-file-tag-list))) 2)
|
|
2568 (insert "[ ")
|
|
2569 (mapc
|
|
2570 (lambda (extra-tag)
|
|
2571 ;; Only insert if not file name or the main tag
|
|
2572 (if (and (not (equal extra-tag tag))
|
|
2573 (not (equal extra-tag file)))
|
|
2574 (insert
|
|
2575 (format "%s " (cdr (assoc extra-tag tag-link-list))))))
|
|
2576 file-tags)
|
|
2577 (insert "]<br>\n"))))
|
|
2578 (cdr curr))
|
|
2579 (insert " <p><a href=\"index.html\">Index</a></p>\n")
|
|
2580 (insert " </body>\n")
|
|
2581 (insert "</html>\n")
|
|
2582 (save-buffer)
|
|
2583 (kill-buffer tag-buf)
|
|
2584 (setq count (1+ count))))
|
|
2585 tags)
|
|
2586 (insert " </body>\n")
|
|
2587 (insert "</html>")
|
|
2588 (save-buffer)
|
|
2589 (kill-buffer index-buf)))
|
|
2590
|
|
2591 (defun tumme-kill-buffer-and-window ()
|
|
2592 "Kill the current buffer and, if possible, also the window."
|
|
2593 (interactive)
|
|
2594 (let ((buffer (current-buffer)))
|
|
2595 (condition-case nil
|
|
2596 (delete-window (selected-window))
|
|
2597 (error nil))
|
|
2598 (kill-buffer buffer)))
|
|
2599
|
|
2600
|
|
2601 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2602 ;;;;;;;;; TEST-SECTION ;;;;;;;;;;;
|
|
2603 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
2604
|
|
2605
|
68404
|
2606 (defvar tumme-dir-max-size 12300000)
|
67302
|
2607
|
|
2608 (defun tumme-test ()
|
|
2609 "Clean `tumme-dir' from old thumbnail files.
|
|
2610 \"Oldness\" measured using last access time. If the total size of all
|
|
2611 thumbnail files in `tumme-dir' is larger than 'tumme-dir-max-size',
|
|
2612 old files are deleted until the max size is reached."
|
|
2613 (let* ((files
|
|
2614 (sort
|
|
2615 (mapcar
|
|
2616 (lambda (f)
|
|
2617 (let ((fattribs (file-attributes f)))
|
|
2618 ;; Get last access time and file size
|
|
2619 `(,(nth 4 fattribs) ,(nth 7 fattribs) ,f)))
|
|
2620 (directory-files tumme-dir t ".+\.thumb\..+$"))
|
|
2621 ;; Sort function. Compare time between two files.
|
|
2622 '(lambda (l1 l2)
|
|
2623 (time-less-p (car l1) (car l2)))))
|
|
2624 (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) files))))
|
|
2625 (while (> dirsize tumme-dir-max-size)
|
|
2626 (y-or-n-p
|
|
2627 (format "Size of thumbnail directory: %d, delete old file %s? "
|
|
2628 dirsize (cadr (cdar files))))
|
|
2629 (delete-file (cadr (cdar files)))
|
|
2630 (setq dirsize (- dirsize (car (cdar files))))
|
|
2631 (setq files (cdr files)))))
|
|
2632
|
|
2633 (provide 'tumme)
|
|
2634
|
67318
|
2635 ;; arch-tag: 9d11411d-331f-4380-8b44-8adfe3a0343e
|
67302
|
2636 ;;; tumme.el ends here
|