Skip to content
Newer
Older
100644 890 lines (783 sloc) 32.8 KB
9e7fc2f @railwaycat init emacs 23.2.92
authored
1 ;;; image.el --- image API
2
6c29c6a @railwaycat emacs-24.4.90 with emacs-24.4.90-mac-5.4
authored
3 ;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
9e7fc2f @railwaycat init emacs 23.2.92
authored
4
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
5 ;; Maintainer: emacs-devel@gnu.org
9e7fc2f @railwaycat init emacs 23.2.92
authored
6 ;; Keywords: multimedia
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
7 ;; Package: emacs
9e7fc2f @railwaycat init emacs 23.2.92
authored
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 3 of the License, or
14 ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28
29 (defgroup image ()
30 "Image support."
31 :group 'multimedia)
32
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
33 (defalias 'image-refresh 'image-flush)
9e7fc2f @railwaycat init emacs 23.2.92
authored
34
35 (defconst image-type-header-regexps
36 `(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
37 ("\\`P[1-6]\\\(?:\
38 \\(?:\\(?:#[^\r\n]*[\r\n]\\)?[[:space:]]\\)+\
39 \\(?:\\(?:#[^\r\n]*[\r\n]\\)?[0-9]\\)+\
40 \\)\\{2\\}" . pbm)
9e7fc2f @railwaycat init emacs 23.2.92
authored
41 ("\\`GIF8[79]a" . gif)
42 ("\\`\x89PNG\r\n\x1a\n" . png)
43 ("\\`[\t\n\r ]*#define \\([a-z0-9_]+\\)_width [0-9]+\n\
44 #define \\1_height [0-9]+\n\\(\
45 #define \\1_x_hot [0-9]+\n\
46 #define \\1_y_hot [0-9]+\n\\)?\
47 static \\(unsigned \\)?char \\1_bits" . xbm)
48 ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff)
49 ("\\`[\t\n\r ]*%!PS" . postscript)
50 ("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg)
51 (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
52 (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
53 (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<"
54 comment-re "*"
55 "\\(?:!DOCTYPE[ \t\r\n]+[^>]*>[ \t\r\n]*<[ \t\r\n]*" comment-re "*\\)?"
56 "[Ss][Vv][Gg]"))
57 . svg)
58 )
59 "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
60 When the first bytes of an image file match REGEXP, it is assumed to
61 be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol,
62 IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called
63 with one argument, a string containing the image data. If PREDICATE returns
64 a non-nil value, TYPE is the image's type.")
65
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
66 (defvar image-type-file-name-regexps
9e7fc2f @railwaycat init emacs 23.2.92
authored
67 '(("\\.png\\'" . png)
68 ("\\.gif\\'" . gif)
69 ("\\.jpe?g\\'" . jpeg)
70 ("\\.bmp\\'" . bmp)
71 ("\\.xpm\\'" . xpm)
72 ("\\.pbm\\'" . pbm)
73 ("\\.xbm\\'" . xbm)
74 ("\\.ps\\'" . postscript)
75 ("\\.tiff?\\'" . tiff)
76 ("\\.svgz?\\'" . svg)
77 )
78 "Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
79 When the name of an image file match REGEXP, it is assumed to
80 be of image type IMAGE-TYPE.")
81
82 ;; We rely on `auto-mode-alist' to detect xbm and xpm files, instead
83 ;; of content autodetection. Their contents are just C code, so it is
84 ;; easy to generate false matches.
85 (defvar image-type-auto-detectable
86 '((pbm . t)
87 (xbm . nil)
88 (bmp . maybe)
89 (gif . maybe)
90 (png . maybe)
91 (xpm . nil)
92 (jpeg . maybe)
93 (tiff . maybe)
94 (svg . maybe)
95 (postscript . nil))
96 "Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files.
97 \(See `image-type-auto-detected-p').
98
99 AUTODETECT can be
100 - t always auto-detect.
101 - nil never auto-detect.
102 - maybe auto-detect only if the image type is available
103 (see `image-type-available-p').")
104
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
105 (defvar image-format-suffixes
106 '((image/x-icon "ico"))
107 "An alist associating image types with file name suffixes.
108 This is used as a hint by the ImageMagick library when detecting
109 the type of image data (that does not have an associated file name).
110 Each element has the form (MIME-CONTENT-TYPE EXTENSION).
111 If `create-image' is called with a :format attribute whose value
112 equals a content-type found in this list, the ImageMagick library is
113 told that the data would have the associated suffix if saved to a file.")
114
9e7fc2f @railwaycat init emacs 23.2.92
authored
115 (defcustom image-load-path
116 (list (file-name-as-directory (expand-file-name "images" data-directory))
117 'data-directory 'load-path)
118 "List of locations in which to search for image files.
119 If an element is a string, it defines a directory to search.
120 If an element is a variable symbol whose value is a string, that
121 value defines a directory to search.
122 If an element is a variable symbol whose value is a list, the
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
123 value is used as a list of directories to search.
124
125 Subdirectories are not automatically included in the search."
9e7fc2f @railwaycat init emacs 23.2.92
authored
126 :type '(repeat (choice directory variable))
127 :initialize 'custom-initialize-delay)
128
129
130 (defun image-load-path-for-library (library image &optional path no-error)
131 "Return a suitable search path for images used by LIBRARY.
132
133 It searches for IMAGE in `image-load-path' (excluding
134 \"`data-directory'/images\") and `load-path', followed by a path
135 suitable for LIBRARY, which includes \"../../etc/images\" and
136 \"../etc/images\" relative to the library file itself, and then
137 in \"`data-directory'/images\".
138
139 Then this function returns a list of directories which contains
140 first the directory in which IMAGE was found, followed by the
141 value of `load-path'. If PATH is given, it is used instead of
142 `load-path'.
143
144 If NO-ERROR is non-nil and a suitable path can't be found, don't
145 signal an error. Instead, return a list of directories as before,
146 except that nil appears in place of the image directory.
147
148 Here is an example that uses a common idiom to provide
149 compatibility with versions of Emacs that lack the variable
150 `image-load-path':
151
152 ;; Shush compiler.
153 (defvar image-load-path)
154
155 (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
156 (image-load-path (cons (car load-path)
157 (when (boundp 'image-load-path)
158 image-load-path))))
159 (mh-tool-bar-folder-buttons-init))"
160 (unless library (error "No library specified"))
161 (unless image (error "No image specified"))
162 (let (image-directory image-directory-load-path)
163 ;; Check for images in image-load-path or load-path.
164 (let ((img image)
165 (dir (or
166 ;; Images in image-load-path.
167 (image-search-load-path image)
168 ;; Images in load-path.
169 (locate-library image)))
170 parent)
171 ;; Since the image might be in a nested directory (for
172 ;; example, mail/attach.pbm), adjust `image-directory'
173 ;; accordingly.
174 (when dir
175 (setq dir (file-name-directory dir))
176 (while (setq parent (file-name-directory img))
177 (setq img (directory-file-name parent)
178 dir (expand-file-name "../" dir))))
179 (setq image-directory-load-path dir))
180
97f5d43 @railwaycat update to emacs 24.0.95 with mac 2.91
authored
181 ;; If `image-directory-load-path' isn't Emacs's image directory,
9e7fc2f @railwaycat init emacs 23.2.92
authored
182 ;; it's probably a user preference, so use it. Then use a
183 ;; relative setting if possible; otherwise, use
184 ;; `image-directory-load-path'.
185 (cond
186 ;; User-modified image-load-path?
187 ((and image-directory-load-path
188 (not (equal image-directory-load-path
189 (file-name-as-directory
190 (expand-file-name "images" data-directory)))))
191 (setq image-directory image-directory-load-path))
192 ;; Try relative setting.
193 ((let (library-name d1ei d2ei)
194 ;; First, find library in the load-path.
195 (setq library-name (locate-library library))
196 (if (not library-name)
197 (error "Cannot find library %s in load-path" library))
198 ;; And then set image-directory relative to that.
199 (setq
200 ;; Go down 2 levels.
201 d2ei (file-name-as-directory
202 (expand-file-name
203 (concat (file-name-directory library-name) "../../etc/images")))
204 ;; Go down 1 level.
205 d1ei (file-name-as-directory
206 (expand-file-name
207 (concat (file-name-directory library-name) "../etc/images"))))
208 (setq image-directory
209 ;; Set it to nil if image is not found.
210 (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
211 ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
97f5d43 @railwaycat update to emacs 24.0.95 with mac 2.91
authored
212 ;; Use Emacs's image directory.
9e7fc2f @railwaycat init emacs 23.2.92
authored
213 (image-directory-load-path
214 (setq image-directory image-directory-load-path))
215 (no-error
216 (message "Could not find image %s for library %s" image library))
217 (t
218 (error "Could not find image %s for library %s" image library)))
219
220 ;; Return an augmented `path' or `load-path'.
221 (nconc (list image-directory)
222 (delete image-directory (copy-sequence (or path load-path))))))
223
224
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
225 ;; Used to be in image-type-header-regexps, but now not used anywhere
226 ;; (since 2009-08-28).
9e7fc2f @railwaycat init emacs 23.2.92
authored
227 (defun image-jpeg-p (data)
228 "Value is non-nil if DATA, a string, consists of JFIF image data.
229 We accept the tag Exif because that is the same format."
230 (setq data (ignore-errors (string-to-unibyte data)))
231 (when (and data (string-match-p "\\`\xff\xd8" data))
232 (catch 'jfif
233 (let ((len (length data)) (i 2))
234 (while (< i len)
235 (when (/= (aref data i) #xff)
236 (throw 'jfif nil))
237 (setq i (1+ i))
238 (when (>= (+ i 2) len)
239 (throw 'jfif nil))
240 (let ((nbytes (+ (lsh (aref data (+ i 1)) 8)
241 (aref data (+ i 2))))
242 (code (aref data i)))
243 (when (and (>= code #xe0) (<= code #xef))
244 ;; APP0 LEN1 LEN2 "JFIF\0"
245 (throw 'jfif
246 (string-match-p "JFIF\\|Exif"
247 (substring data i (min (+ i nbytes) len)))))
248 (setq i (+ i 1 nbytes))))))))
249
250
251 ;;;###autoload
252 (defun image-type-from-data (data)
253 "Determine the image type from image data DATA.
254 Value is a symbol specifying the image type or nil if type cannot
255 be determined."
256 (let ((types image-type-header-regexps)
257 type)
258 (while types
259 (let ((regexp (car (car types)))
260 (image-type (cdr (car types))))
261 (if (or (and (symbolp image-type)
262 (string-match-p regexp data))
263 (and (consp image-type)
264 (funcall (car image-type) data)
265 (setq image-type (cdr image-type))))
266 (setq type image-type
267 types nil)
268 (setq types (cdr types)))))
269 type))
270
271
272 ;;;###autoload
273 (defun image-type-from-buffer ()
274 "Determine the image type from data in the current buffer.
275 Value is a symbol specifying the image type or nil if type cannot
276 be determined."
277 (let ((types image-type-header-regexps)
278 type
279 (opoint (point)))
280 (goto-char (point-min))
281 (while types
282 (let ((regexp (car (car types)))
283 (image-type (cdr (car types)))
284 data)
285 (if (or (and (symbolp image-type)
286 (looking-at-p regexp))
287 (and (consp image-type)
288 (funcall (car image-type)
289 (or data
290 (setq data
291 (buffer-substring
292 (point-min)
293 (min (point-max)
294 (+ (point-min) 256))))))
295 (setq image-type (cdr image-type))))
296 (setq type image-type
297 types nil)
298 (setq types (cdr types)))))
299 (goto-char opoint)
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
300 (and type
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
301 (boundp 'image-types)
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
302 (memq type image-types)
303 type)))
9e7fc2f @railwaycat init emacs 23.2.92
authored
304
305
306 ;;;###autoload
307 (defun image-type-from-file-header (file)
308 "Determine the type of image file FILE from its first few bytes.
309 Value is a symbol specifying the image type, or nil if type cannot
310 be determined."
311 (unless (or (file-readable-p file)
312 (file-name-absolute-p file))
313 (setq file (image-search-load-path file)))
314 (and file
315 (file-readable-p file)
316 (with-temp-buffer
317 (set-buffer-multibyte nil)
318 (insert-file-contents-literally file nil 0 256)
319 (image-type-from-buffer))))
320
321
322 ;;;###autoload
323 (defun image-type-from-file-name (file)
324 "Determine the type of image file FILE from its name.
325 Value is a symbol specifying the image type, or nil if type cannot
326 be determined."
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
327 (let (type first)
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
328 (catch 'found
329 (dolist (elem image-type-file-name-regexps first)
330 (when (string-match-p (car elem) file)
331 (if (image-type-available-p (setq type (cdr elem)))
332 (throw 'found type)
333 ;; If nothing seems to be supported, return first type that matched.
334 (or first (setq first type))))))))
9e7fc2f @railwaycat init emacs 23.2.92
authored
335
336 ;;;###autoload
337 (defun image-type (source &optional type data-p)
338 "Determine and return image type.
339 SOURCE is an image file name or image data.
340 Optional TYPE is a symbol describing the image type. If TYPE is omitted
341 or nil, try to determine the image type from its first few bytes
342 of image data. If that doesn't work, and SOURCE is a file name,
343 use its file extension as image type.
344 Optional DATA-P non-nil means SOURCE is a string containing image data."
345 (when (and (not data-p) (not (stringp source)))
346 (error "Invalid image file name `%s'" source))
347 (unless type
348 (setq type (if data-p
349 (image-type-from-data source)
350 (or (image-type-from-file-header source)
351 (image-type-from-file-name source))))
352 (or type (error "Cannot determine image type")))
353 (or (memq type (and (boundp 'image-types) image-types))
354 (error "Invalid image type `%s'" type))
355 type)
356
357
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
358 (if (fboundp 'image-metadata) ; eg not --without-x
359 (define-obsolete-function-alias 'image-extension-data
360 'image-metadata' "24.1"))
361
362 (define-obsolete-variable-alias
363 'image-library-alist
364 'dynamic-library-alist "24.1")
9e7fc2f @railwaycat init emacs 23.2.92
authored
365
366 ;;;###autoload
367 (defun image-type-available-p (type)
368 "Return non-nil if image type TYPE is available.
369 Image types are symbols like `xbm' or `jpeg'."
370 (and (fboundp 'init-image-library)
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
371 (init-image-library type)))
9e7fc2f @railwaycat init emacs 23.2.92
authored
372
373
374 ;;;###autoload
375 (defun image-type-auto-detected-p ()
376 "Return t if the current buffer contains an auto-detectable image.
377 This function is intended to be used from `magic-fallback-mode-alist'.
378
379 The buffer is considered to contain an auto-detectable image if
380 its beginning matches an image type in `image-type-header-regexps',
381 and that image type is present in `image-type-auto-detectable' with a
382 non-nil value. If that value is non-nil, but not t, then the image type
383 must be available."
384 (let* ((type (image-type-from-buffer))
385 (auto (and type (cdr (assq type image-type-auto-detectable)))))
386 (and auto
387 (or (eq auto t) (image-type-available-p type)))))
388
389
390 ;;;###autoload
391 (defun create-image (file-or-data &optional type data-p &rest props)
392 "Create an image.
393 FILE-OR-DATA is an image file name or image data.
394 Optional TYPE is a symbol describing the image type. If TYPE is omitted
395 or nil, try to determine the image type from its first few bytes
396 of image data. If that doesn't work, and FILE-OR-DATA is a file name,
397 use its file extension as image type.
398 Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
399 Optional PROPS are additional image attributes to assign to the image,
400 like, e.g. `:mask MASK'.
401 Value is the image created, or nil if images of type TYPE are not supported.
402
403 Images should not be larger than specified by `max-image-size'.
404
405 Image file names that are not absolute are searched for in the
406 \"images\" sub-directory of `data-directory' and
407 `x-bitmap-file-path' (in that order)."
408 ;; It is x_find_image_file in image.c that sets the search path.
409 (setq type (image-type file-or-data type data-p))
410 (when (image-type-available-p type)
411 (append (list 'image :type type (if data-p :data :file) file-or-data)
412 props)))
413
414
415 ;;;###autoload
416 (defun put-image (image pos &optional string area)
417 "Put image IMAGE in front of POS in the current buffer.
418 IMAGE must be an image created with `create-image' or `defimage'.
419 IMAGE is displayed by putting an overlay into the current buffer with a
420 `before-string' STRING that has a `display' property whose value is the
421 image. STRING is defaulted if you omit it.
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
422 The overlay created will have the `put-image' property set to t.
9e7fc2f @railwaycat init emacs 23.2.92
authored
423 POS may be an integer or marker.
424 AREA is where to display the image. AREA nil or omitted means
425 display it in the text area, a value of `left-margin' means
426 display it in the left marginal area, a value of `right-margin'
427 means display it in the right marginal area."
428 (unless string (setq string "x"))
429 (let ((buffer (current-buffer)))
430 (unless (eq (car-safe image) 'image)
431 (error "Not an image: %s" image))
432 (unless (or (null area) (memq area '(left-margin right-margin)))
433 (error "Invalid area %s" area))
434 (setq string (copy-sequence string))
435 (let ((overlay (make-overlay pos pos buffer))
436 (prop (if (null area) image (list (list 'margin area) image))))
437 (put-text-property 0 (length string) 'display prop string)
438 (overlay-put overlay 'put-image t)
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
439 (overlay-put overlay 'before-string string)
440 overlay)))
9e7fc2f @railwaycat init emacs 23.2.92
authored
441
442
443 ;;;###autoload
444 (defun insert-image (image &optional string area slice)
445 "Insert IMAGE into current buffer at point.
446 IMAGE is displayed by inserting STRING into the current buffer
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
447 with a `display' property whose value is the image. STRING
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
448 defaults to a single space if you omit it.
9e7fc2f @railwaycat init emacs 23.2.92
authored
449 AREA is where to display the image. AREA nil or omitted means
450 display it in the text area, a value of `left-margin' means
451 display it in the left marginal area, a value of `right-margin'
452 means display it in the right marginal area.
453 SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
454 means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
455 specifying the X and Y positions and WIDTH and HEIGHT of image area
456 to insert. A float value 0.0 - 1.0 means relative to the width or
457 height of the image; integer values are taken as pixel values."
458 ;; Use a space as least likely to cause trouble when it's a hidden
459 ;; character in the buffer.
460 (unless string (setq string " "))
461 (unless (eq (car-safe image) 'image)
462 (error "Not an image: %s" image))
463 (unless (or (null area) (memq area '(left-margin right-margin)))
464 (error "Invalid area %s" area))
465 (if area
466 (setq image (list (list 'margin area) image))
467 ;; Cons up a new spec equal but not eq to `image' so that
468 ;; inserting it twice in a row (adjacently) displays two copies of
469 ;; the image. Don't try to avoid this by looking at the display
470 ;; properties on either side so that we DTRT more often with
471 ;; cut-and-paste. (Yanking killed image text next to another copy
472 ;; of it loses anyway.)
473 (setq image (cons 'image (cdr image))))
474 (let ((start (point)))
475 (insert string)
476 (add-text-properties start (point)
477 `(display ,(if slice
478 (list (cons 'slice slice) image)
479 image) rear-nonsticky (display)))))
480
481
482 ;;;###autoload
483 (defun insert-sliced-image (image &optional string area rows cols)
484 "Insert IMAGE into current buffer at point.
485 IMAGE is displayed by inserting STRING into the current buffer
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
486 with a `display' property whose value is the image. The default
487 STRING is a single space.
9e7fc2f @railwaycat init emacs 23.2.92
authored
488 AREA is where to display the image. AREA nil or omitted means
489 display it in the text area, a value of `left-margin' means
490 display it in the left marginal area, a value of `right-margin'
491 means display it in the right marginal area.
492 The image is automatically split into ROWS x COLS slices."
493 (unless string (setq string " "))
494 (unless (eq (car-safe image) 'image)
495 (error "Not an image: %s" image))
496 (unless (or (null area) (memq area '(left-margin right-margin)))
497 (error "Invalid area %s" area))
498 (if area
499 (setq image (list (list 'margin area) image))
500 ;; Cons up a new spec equal but not eq to `image' so that
501 ;; inserting it twice in a row (adjacently) displays two copies of
502 ;; the image. Don't try to avoid this by looking at the display
503 ;; properties on either side so that we DTRT more often with
504 ;; cut-and-paste. (Yanking killed image text next to another copy
505 ;; of it loses anyway.)
506 (setq image (cons 'image (cdr image))))
507 (let ((x 0.0) (dx (/ 1.0001 (or cols 1)))
508 (y 0.0) (dy (/ 1.0001 (or rows 1))))
509 (while (< y 1.0)
510 (while (< x 1.0)
511 (let ((start (point)))
512 (insert string)
513 (add-text-properties start (point)
514 `(display ,(list (list 'slice x y dx dy) image)
515 rear-nonsticky (display)))
516 (setq x (+ x dx))))
517 (setq x 0.0
518 y (+ y dy))
519 (insert (propertize "\n" 'line-height t)))))
520
521
522
523 ;;;###autoload
524 (defun remove-images (start end &optional buffer)
525 "Remove images between START and END in BUFFER.
526 Remove only images that were put in BUFFER with calls to `put-image'.
527 BUFFER nil or omitted means use the current buffer."
528 (unless buffer
529 (setq buffer (current-buffer)))
530 (let ((overlays (overlays-in start end)))
531 (while overlays
532 (let ((overlay (car overlays)))
533 (when (overlay-get overlay 'put-image)
534 (delete-overlay overlay)))
535 (setq overlays (cdr overlays)))))
536
537 (defun image-search-load-path (file &optional path)
538 (unless path
539 (setq path image-load-path))
540 (let (element found filename)
541 (while (and (not found) (consp path))
542 (setq element (car path))
543 (cond
544 ((stringp element)
545 (setq found
546 (file-readable-p
547 (setq filename (expand-file-name file element)))))
548 ((and (symbolp element) (boundp element))
549 (setq element (symbol-value element))
550 (cond
551 ((stringp element)
552 (setq found
553 (file-readable-p
554 (setq filename (expand-file-name file element)))))
555 ((consp element)
556 (if (setq filename (image-search-load-path file element))
557 (setq found t))))))
558 (setq path (cdr path)))
559 (if found filename)))
560
561 ;;;###autoload
562 (defun find-image (specs)
563 "Find an image, choosing one of a list of image specifications.
564
565 SPECS is a list of image specifications.
566
567 Each image specification in SPECS is a property list. The contents of
568 a specification are image type dependent. All specifications must at
569 least contain the properties `:type TYPE' and either `:file FILE' or
570 `:data DATA', where TYPE is a symbol specifying the image type,
571 e.g. `xbm', FILE is the file to load the image from, and DATA is a
572 string containing the actual image data. The specification whose TYPE
573 is supported, and FILE exists, is used to construct the image
574 specification to be returned. Return nil if no specification is
575 satisfied.
576
577 The image is looked for in `image-load-path'.
578
579 Image files should not be larger than specified by `max-image-size'."
580 (let (image)
581 (while (and specs (null image))
582 (let* ((spec (car specs))
583 (type (plist-get spec :type))
584 (data (plist-get spec :data))
585 (file (plist-get spec :file))
586 found)
587 (when (image-type-available-p type)
588 (cond ((stringp file)
589 (if (setq found (image-search-load-path file))
590 (setq image
591 (cons 'image (plist-put (copy-sequence spec)
592 :file found)))))
593 ((not (null data))
594 (setq image (cons 'image spec)))))
595 (setq specs (cdr specs))))
596 image))
597
598
599 ;;;###autoload
600 (defmacro defimage (symbol specs &optional doc)
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
601 "Define SYMBOL as an image, and return SYMBOL.
9e7fc2f @railwaycat init emacs 23.2.92
authored
602
603 SPECS is a list of image specifications. DOC is an optional
604 documentation string.
605
606 Each image specification in SPECS is a property list. The contents of
607 a specification are image type dependent. All specifications must at
608 least contain the properties `:type TYPE' and either `:file FILE' or
609 `:data DATA', where TYPE is a symbol specifying the image type,
610 e.g. `xbm', FILE is the file to load the image from, and DATA is a
611 string containing the actual image data. The first image
612 specification whose TYPE is supported, and FILE exists, is used to
613 define SYMBOL.
614
615 Example:
616
617 (defimage test-image ((:type xpm :file \"~/test1.xpm\")
618 (:type xbm :file \"~/test1.xbm\")))"
619 (declare (doc-string 3))
620 `(defvar ,symbol (find-image ',specs) ,doc))
621
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
622
623 ;;; Animated image API
624
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
625 (defvar image-default-frame-delay 0.1
626 "Default interval in seconds between frames of a multi-frame image.
627 Only used if the image does not specify a value.")
628
629 (defun image-multi-frame-p (image)
630 "Return non-nil if IMAGE contains more than one frame.
631 The actual return value is a cons (NIMAGES . DELAY), where NIMAGES is
632 the number of frames (or sub-images) in the image and DELAY is the delay
633 in seconds that the image specifies between each frame. DELAY may be nil,
634 in which case you might want to use `image-default-frame-delay'."
635 (when (fboundp 'image-metadata)
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
636 (let* ((metadata (image-metadata image))
637 (images (plist-get metadata 'count))
638 (delay (plist-get metadata 'delay)))
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
639 (when (and images (> images 1))
640 (and delay (or (not (numberp delay)) (< delay 0))
641 (setq delay image-default-frame-delay))
642 (cons images delay)))))
643
644 (defun image-animated-p (image)
645 "Like `image-multi-frame-p', but returns nil if no delay is specified."
646 (let ((multi (image-multi-frame-p image)))
647 (and (cdr multi) multi)))
648
649 (make-obsolete 'image-animated-p 'image-multi-frame-p "24.4")
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
650
651 ;; "Destructively"?
652 (defun image-animate (image &optional index limit)
653 "Start animating IMAGE.
654 Animation occurs by destructively altering the IMAGE spec list.
655
656 With optional INDEX, begin animating from that animation frame.
657 LIMIT specifies how long to animate the image. If omitted or
658 nil, play the animation until the end. If t, loop forever. If a
659 number, play until that number of seconds has elapsed."
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
660 (let ((animation (image-multi-frame-p image))
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
661 timer)
662 (when animation
663 (if (setq timer (image-animate-timer image))
664 (cancel-timer timer))
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
665 (plist-put (cdr image) :animate-buffer (current-buffer))
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
666 (run-with-timer 0.2 nil 'image-animate-timeout
667 image (or index 0) (car animation)
668 0 limit))))
669
670 (defun image-animate-timer (image)
671 "Return the animation timer for image IMAGE."
672 ;; See cancel-function-timers
673 (let ((tail timer-list) timer)
674 (while tail
675 (setq timer (car tail)
676 tail (cdr tail))
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
677 (if (and (eq (timer--function timer) 'image-animate-timeout)
678 (eq (car-safe (timer--args timer)) image))
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
679 (setq tail nil)
680 (setq timer nil)))
681 timer))
682
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
683 (defconst image-minimum-frame-delay 0.01
684 "Minimum interval in seconds between frames of an animated image.")
685
686 (defun image-current-frame (image)
687 "The current frame number of IMAGE, indexed from 0."
688 (or (plist-get (cdr image) :index) 0))
689
690 (defun image-show-frame (image n &optional nocheck)
691 "Show frame N of IMAGE.
692 Frames are indexed from 0. Optional argument NOCHECK non-nil means
693 do not check N is within the range of frames present in the image."
694 (unless nocheck
695 (if (< n 0) (setq n 0)
696 (setq n (min n (1- (car (image-multi-frame-p image)))))))
697 (plist-put (cdr image) :index n)
698 (force-window-update))
699
700 (defun image-animate-get-speed (image)
701 "Return the speed factor for animating IMAGE."
702 (or (plist-get (cdr image) :speed) 1))
703
704 (defun image-animate-set-speed (image value &optional multiply)
705 "Set the speed factor for animating IMAGE to VALUE.
706 With optional argument MULTIPLY non-nil, treat VALUE as a
707 multiplication factor for the current value."
708 (plist-put (cdr image) :speed
709 (if multiply
710 (* value (image-animate-get-speed image))
711 value)))
712
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
713 ;; FIXME? The delay may not be the same for different sub-images,
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
714 ;; hence we need to call image-multi-frame-p to return it.
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
715 ;; But it also returns count, so why do we bother passing that as an
716 ;; argument?
717 (defun image-animate-timeout (image n count time-elapsed limit)
718 "Display animation frame N of IMAGE.
719 N=0 refers to the initial animation frame.
720 COUNT is the total number of frames in the animation.
721 TIME-ELAPSED is the total time that has elapsed since
722 `image-animate-start' was called.
723 LIMIT determines when to stop. If t, loop forever. If nil, stop
724 after displaying the last animation frame. Otherwise, stop
725 after LIMIT seconds have elapsed.
2e5ff49 @railwaycat emacs-24.4 with emacs-24.4-mac-5.0
authored
726 The minimum delay between successive frames is `image-minimum-frame-delay'.
727
728 If the image has a non-nil :speed property, it acts as a multiplier
729 for the animation speed. A negative value means to animate in reverse."
730 (when (buffer-live-p (plist-get (cdr image) :animate-buffer))
731 (image-show-frame image n t)
732 (let* ((speed (image-animate-get-speed image))
733 (time (float-time))
734 (animation (image-multi-frame-p image))
735 ;; Subtract off the time we took to load the image from the
736 ;; stated delay time.
737 (delay (max (+ (* (or (cdr animation) image-default-frame-delay)
738 (/ 1 (abs speed)))
739 time (- (float-time)))
740 image-minimum-frame-delay))
741 done)
742 (setq n (if (< speed 0)
743 (1- n)
744 (1+ n)))
745 (if limit
746 (cond ((>= n count) (setq n 0))
747 ((< n 0) (setq n (1- count))))
748 (and (or (>= n count) (< n 0)) (setq done t)))
749 (setq time-elapsed (+ delay time-elapsed))
750 (if (numberp limit)
751 (setq done (>= time-elapsed limit)))
752 (unless done
753 (run-with-timer delay nil 'image-animate-timeout
754 image n count time-elapsed limit)))))
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
755
756
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
757 (defvar imagemagick-types-inhibit)
758 (defvar imagemagick-enabled-types)
759
760 (defun imagemagick-filter-types ()
761 "Return a list of the ImageMagick types to be treated as images, or nil.
762 This is the result of `imagemagick-types', including only elements
763 that match `imagemagick-enabled-types' and do not match
764 `imagemagick-types-inhibit'."
765 (when (fboundp 'imagemagick-types)
766 (cond ((null imagemagick-enabled-types) nil)
767 ((eq imagemagick-types-inhibit t) nil)
768 (t
769 (delq nil
770 (mapcar
771 (lambda (type)
772 (unless (memq type imagemagick-types-inhibit)
773 (if (eq imagemagick-enabled-types t) type
774 (catch 'found
775 (dolist (enable imagemagick-enabled-types nil)
776 (if (cond ((symbolp enable) (eq enable type))
777 ((stringp enable)
778 (string-match enable
779 (symbol-name type))))
780 (throw 'found type)))))))
781 (imagemagick-types)))))))
782
783 (defvar imagemagick--file-regexp nil
784 "File extension regexp for ImageMagick files, if any.
785 This is the extension installed into `auto-mode-alist' and
786 `image-type-file-name-regexps' by `imagemagick-register-types'.")
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
787
788 ;;;###autoload
789 (defun imagemagick-register-types ()
790 "Register file types that can be handled by ImageMagick.
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
791 This function is called at startup, after loading the init file.
792 It registers the ImageMagick types returned by `imagemagick-filter-types'.
97f5d43 @railwaycat update to emacs 24.0.95 with mac 2.91
authored
793
794 Registered image types are added to `auto-mode-alist', so that
795 Emacs visits them in Image mode. They are also added to
796 `image-type-file-name-regexps', so that the `image-type' function
797 recognizes these files as having image type `imagemagick'.
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
798
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
799 If Emacs is compiled without ImageMagick support, this does nothing."
479bbfd @railwaycat update to emacs 24.0.94 with mac 2.90
authored
800 (when (fboundp 'imagemagick-types)
70089e3 @railwaycat Emacs 24.2.90 with emacs-24.2.90-mac-3.90
authored
801 (let* ((types (mapcar (lambda (type) (downcase (symbol-name type)))
802 (imagemagick-filter-types)))
803 (re (if types (concat "\\." (regexp-opt types) "\\'")))
804 (ama-elt (car (member (cons imagemagick--file-regexp 'image-mode)
805 auto-mode-alist)))
806 (itfnr-elt (car (member (cons imagemagick--file-regexp 'imagemagick)
807 image-type-file-name-regexps))))
808 (if (not re)
809 (setq auto-mode-alist (delete ama-elt auto-mode-alist)
810 image-type-file-name-regexps
811 (delete itfnr-elt image-type-file-name-regexps))
812 (if ama-elt
813 (setcar ama-elt re)
814 (push (cons re 'image-mode) auto-mode-alist))
815 (if itfnr-elt
816 (setcar itfnr-elt re)
817 ;; Append to `image-type-file-name-regexps', so that we
818 ;; preferentially use specialized image libraries.
819 (add-to-list 'image-type-file-name-regexps
820 (cons re 'imagemagick) t)))
821 (setq imagemagick--file-regexp re))))
822
823 (defcustom imagemagick-types-inhibit
824 '(C HTML HTM INFO M TXT PDF)
825 "List of ImageMagick types that should never be treated as images.
826 This should be a list of symbols, each of which should be one of
827 the ImageMagick types listed by `imagemagick-types'. The listed
828 image types are not registered by `imagemagick-register-types'.
829
830 If the value is t, inhibit the use of ImageMagick for images.
831
832 If you change this without using customize, you must call
833 `imagemagick-register-types' afterwards.
834
835 If Emacs is compiled without ImageMagick support, this variable
836 has no effect."
837 :type '(choice (const :tag "Support all ImageMagick types" nil)
838 (const :tag "Disable all ImageMagick types" t)
839 (repeat symbol))
840 :initialize 'custom-initialize-default
841 :set (lambda (symbol value)
842 (set-default symbol value)
843 (imagemagick-register-types))
844 :version "24.3"
845 :group 'image)
846
847 (defcustom imagemagick-enabled-types
848 '(3FR ART ARW AVS BMP BMP2 BMP3 CAL CALS CMYK CMYKA CR2 CRW
849 CUR CUT DCM DCR DCX DDS DJVU DNG DPX EXR FAX FITS GBR GIF
850 GIF87 GRB HRZ ICB ICO ICON J2C JNG JP2 JPC JPEG JPG JPX K25
851 KDC MIFF MNG MRW MSL MSVG MTV NEF ORF OTB PBM PCD PCDS PCL
852 PCT PCX PDB PEF PGM PICT PIX PJPEG PNG PNG24 PNG32 PNG8 PNM
853 PPM PSD PTIF PWP RAF RAS RBG RGB RGBA RGBO RLA RLE SCR SCT
854 SFW SGI SR2 SRF SUN SVG SVGZ TGA TIFF TIFF64 TILE TIM TTF
855 UYVY VDA VICAR VID VIFF VST WBMP WPG X3F XBM XC XCF XPM XV
856 XWD YCbCr YCbCrA YUV)
857 "List of ImageMagick types to treat as images.
858 Each list element should be a string or symbol, representing one
859 of the image types returned by `imagemagick-types'. If the
860 element is a string, it is handled as a regexp that enables all
861 matching types.
862
863 The value of `imagemagick-enabled-types' may also be t, meaning
864 to enable all types that ImageMagick supports.
865
866 The variable `imagemagick-types-inhibit' overrides this variable.
867
868 If you change this without using customize, you must call
869 `imagemagick-register-types' afterwards.
870
871 If Emacs is compiled without ImageMagick support, this variable
872 has no effect."
873 :type '(choice (const :tag "Support all ImageMagick types" t)
874 (const :tag "Disable all ImageMagick types" nil)
875 (repeat :tag "List of types"
876 (choice (symbol :tag "type")
877 (regexp :tag "regexp"))))
878 :initialize 'custom-initialize-default
879 :set (lambda (symbol value)
880 (set-default symbol value)
881 (imagemagick-register-types))
882 :version "24.3"
883 :group 'image)
884
885 (imagemagick-register-types)
9e7fc2f @railwaycat init emacs 23.2.92
authored
886
887 (provide 'image)
888
889 ;;; image.el ends here
Something went wrong with that request. Please try again.