* image.el (image-type-from-file-name, image-type): Simplify.
[bpt/emacs.git] / lisp / image.el
CommitLineData
7840ced1
GM
1;;; image.el --- image API
2
0d30b337 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003,
d7a0267c 4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
634f4a67
PJ
5
6;; Maintainer: FSF
04799cf5 7;; Keywords: multimedia
7840ced1
GM
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
086add15
LK
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
7840ced1
GM
25
26;;; Commentary:
27
28;;; Code:
29
77f6105c
MB
30
31(defgroup image ()
32 "Image support."
33 :group 'multimedia)
34
35
4fde92ef 36(defconst image-type-header-regexps
6642c904
JB
37 '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
38 ("\\`P[1-6][[:space:]]+\\(?:#.*[[:space:]]+\\)*[0-9]+[[:space:]]+[0-9]+" . pbm)
3205431d 39 ("\\`GIF8[79]a" . gif)
6642c904 40 ("\\`\x89PNG\r\n\x1a\n" . png)
2dca7106
RS
41 ("\\`[\t\n\r ]*#define \\([a-z0-9]+\\)_width [0-9]+\n\
42#define \\1_height [0-9]+\n\
43static char \\1_bits" . xbm)
6642c904
JB
44 ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff)
45 ("\\`[\t\n\r ]*%!PS" . postscript)
46 ("\\`\xff\xd8" . (image-jpeg-p . jpeg)))
47 "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
7840ced1 48When the first bytes of an image file match REGEXP, it is assumed to
6642c904
JB
49be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol,
50IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called
51with one argument, a string containing the image data. If PREDICATE returns
52a non-nil value, TYPE is the image's type.")
8a8ef149 53
4fde92ef
KS
54(defconst image-type-file-name-regexps
55 '(("\\.png\\'" . png)
56 ("\\.gif\\'" . gif)
57 ("\\.jpe?g\\'" . jpeg)
58 ("\\.bmp\\'" . bmp)
59 ("\\.xpm\\'" . xpm)
60 ("\\.pbm\\'" . pbm)
61 ("\\.xbm\\'" . xbm)
62 ("\\.ps\\'" . postscript)
63 ("\\.tiff?\\'" . tiff))
64 "Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
65When the name of an image file match REGEXP, it is assumed to
66be of image type IMAGE-TYPE.")
67
a9bb04bb
CY
68;; We rely on `auto-mode-alist' to detect xbm and xpm files, instead
69;; of content autodetection. Their contents are just C code, so it is
70;; easy to generate false matches.
6642c904
JB
71(defvar image-type-auto-detectable
72 '((pbm . t)
a9bb04bb 73 (xbm . nil)
6642c904
JB
74 (bmp . maybe)
75 (gif . maybe)
76 (png . maybe)
a9bb04bb 77 (xpm . nil)
6642c904
JB
78 (jpeg . maybe)
79 (tiff . maybe)
80 (postscript . nil))
81 "Alist of (IMAGE-TYPE . AUTODETECT) pairs used to auto-detect image files.
82\(See `image-type-auto-detected-p').
83
84AUTODETECT can be
85 - t always auto-detect.
86 - nil never auto-detect.
87 - maybe auto-detect only if the image type is available
88 (see `image-type-available-p').")
4fde92ef 89
dada660a 90(defvar image-load-path nil
5fc5ac38 91 "List of locations in which to search for image files.
93a75651
CY
92If an element is a string, it defines a directory to search.
93If an element is a variable symbol whose value is a string, that
94value defines a directory to search.
95If an element is a variable symbol whose value is a list, the
96value is used as a list of directories to search.")
5fc5ac38 97
dada660a
RS
98(eval-at-startup
99 (setq image-load-path
100 (list (file-name-as-directory (expand-file-name "images" data-directory))
101 'data-directory 'load-path)))
102
5248a565 103
20c65d08 104(defun image-load-path-for-library (library image &optional path no-error)
ae77c7ff 105 "Return a suitable search path for images used by LIBRARY.
7c565097 106
40db64d2 107It searches for IMAGE in `image-load-path' (excluding
c0696e1b
BW
108\"`data-directory'/images\") and `load-path', followed by a path
109suitable for LIBRARY, which includes \"../../etc/images\" and
110\"../etc/images\" relative to the library file itself, and then
111in \"`data-directory'/images\".
7c565097 112
5248a565
BW
113Then this function returns a list of directories which contains
114first the directory in which IMAGE was found, followed by the
115value of `load-path'. If PATH is given, it is used instead of
116`load-path'.
20c65d08 117
5248a565
BW
118If NO-ERROR is non-nil and a suitable path can't be found, don't
119signal an error. Instead, return a list of directories as before,
120except that nil appears in place of the image directory.
7c565097
BW
121
122Here is an example that uses a common idiom to provide
123compatibility with versions of Emacs that lack the variable
124`image-load-path':
125
9f036d33
BW
126 ;; Shush compiler.
127 (defvar image-load-path)
5248a565
BW
128
129 (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
9f036d33
BW
130 (image-load-path (cons (car load-path)
131 (when (boundp 'image-load-path)
132 image-load-path))))
5248a565 133 (mh-tool-bar-folder-buttons-init))"
7c565097
BW
134 (unless library (error "No library specified"))
135 (unless image (error "No image specified"))
c0696e1b
BW
136 (let (image-directory image-directory-load-path)
137 ;; Check for images in image-load-path or load-path.
138 (let ((img image)
139 (dir (or
140 ;; Images in image-load-path.
141 (image-search-load-path image)
142 ;; Images in load-path.
143 (locate-library image)))
144 parent)
145 ;; Since the image might be in a nested directory (for
146 ;; example, mail/attach.pbm), adjust `image-directory'
147 ;; accordingly.
148 (when dir
149 (setq dir (file-name-directory dir))
150 (while (setq parent (file-name-directory img))
151 (setq img (directory-file-name parent)
152 dir (expand-file-name "../" dir))))
153 (setq image-directory-load-path dir))
154
155 ;; If `image-directory-load-path' isn't Emacs' image directory,
156 ;; it's probably a user preference, so use it. Then use a
157 ;; relative setting if possible; otherwise, use
158 ;; `image-directory-load-path'.
7c565097 159 (cond
c0696e1b
BW
160 ;; User-modified image-load-path?
161 ((and image-directory-load-path
162 (not (equal image-directory-load-path
163 (file-name-as-directory
164 (expand-file-name "images" data-directory)))))
165 (setq image-directory image-directory-load-path))
7c565097
BW
166 ;; Try relative setting.
167 ((let (library-name d1ei d2ei)
168 ;; First, find library in the load-path.
169 (setq library-name (locate-library library))
170 (if (not library-name)
171 (error "Cannot find library %s in load-path" library))
172 ;; And then set image-directory relative to that.
173 (setq
174 ;; Go down 2 levels.
c0696e1b
BW
175 d2ei (file-name-as-directory
176 (expand-file-name
177 (concat (file-name-directory library-name) "../../etc/images")))
7c565097 178 ;; Go down 1 level.
c0696e1b
BW
179 d1ei (file-name-as-directory
180 (expand-file-name
181 (concat (file-name-directory library-name) "../etc/images"))))
7c565097
BW
182 (setq image-directory
183 ;; Set it to nil if image is not found.
184 (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
185 ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
c0696e1b
BW
186 ;; Use Emacs' image directory.
187 (image-directory-load-path
188 (setq image-directory image-directory-load-path))
20c65d08 189 (no-error
20c65d08 190 (message "Could not find image %s for library %s" image library))
7c565097
BW
191 (t
192 (error "Could not find image %s for library %s" image library)))
193
5248a565
BW
194 ;; Return an augmented `path' or `load-path'.
195 (nconc (list image-directory)
196 (delete image-directory (copy-sequence (or path load-path))))))
197
7c565097 198
8a8ef149 199(defun image-jpeg-p (data)
9b78a6a3
RS
200 "Value is non-nil if DATA, a string, consists of JFIF image data.
201We accept the tag Exif because that is the same format."
8a8ef149
GM
202 (when (string-match "\\`\xff\xd8" data)
203 (catch 'jfif
204 (let ((len (length data)) (i 2))
205 (while (< i len)
206 (when (/= (aref data i) #xff)
207 (throw 'jfif nil))
208 (setq i (1+ i))
209 (when (>= (+ i 2) len)
210 (throw 'jfif nil))
211 (let ((nbytes (+ (lsh (aref data (+ i 1)) 8)
4a9bf8a4
GM
212 (aref data (+ i 2))))
213 (code (aref data i)))
214 (when (and (>= code #xe0) (<= code #xef))
8a8ef149 215 ;; APP0 LEN1 LEN2 "JFIF\0"
71296446 216 (throw 'jfif
32b3c766
JPW
217 (string-match "JFIF\\|Exif"
218 (substring data i (min (+ i nbytes) len)))))
3bdbead3 219 (setq i (+ i 1 nbytes))))))))
7840ced1
GM
220
221
222;;;###autoload
162dec01
GM
223(defun image-type-from-data (data)
224 "Determine the image type from image data DATA.
225Value is a symbol specifying the image type or nil if type cannot
7840ced1 226be determined."
4fde92ef 227 (let ((types image-type-header-regexps)
7840ced1 228 type)
4fde92ef 229 (while types
7840ced1 230 (let ((regexp (car (car types)))
6642c904 231 (image-type (cdr (car types))))
4fde92ef
KS
232 (if (or (and (symbolp image-type)
233 (string-match regexp data))
234 (and (consp image-type)
235 (funcall (car image-type) data)
236 (setq image-type (cdr image-type))))
237 (setq type image-type
238 types nil)
239 (setq types (cdr types)))))
240 type))
241
242
243;;;###autoload
6642c904 244(defun image-type-from-buffer ()
4fde92ef 245 "Determine the image type from data in the current buffer.
6642c904
JB
246Value is a symbol specifying the image type or nil if type cannot
247be determined."
4fde92ef
KS
248 (let ((types image-type-header-regexps)
249 type
250 (opoint (point)))
251 (goto-char (point-min))
252 (while types
253 (let ((regexp (car (car types)))
6642c904 254 (image-type (cdr (car types)))
4fde92ef
KS
255 data)
256 (if (or (and (symbolp image-type)
257 (looking-at regexp))
258 (and (consp image-type)
259 (funcall (car image-type)
260 (or data
261 (setq data
262 (buffer-substring
263 (point-min)
264 (min (point-max)
265 (+ (point-min) 256))))))
266 (setq image-type (cdr image-type))))
6642c904 267 (setq type image-type
4fde92ef
KS
268 types nil)
269 (setq types (cdr types)))))
270 (goto-char opoint)
7840ced1
GM
271 type))
272
273
162dec01
GM
274;;;###autoload
275(defun image-type-from-file-header (file)
276 "Determine the type of image file FILE from its first few bytes.
277Value is a symbol specifying the image type, or nil if type cannot
278be determined."
4fde92ef
KS
279 (unless (or (file-readable-p file)
280 (file-name-absolute-p file))
281 (setq file (image-search-load-path file)))
282 (and file
283 (file-readable-p file)
284 (with-temp-buffer
285 (set-buffer-multibyte nil)
286 (insert-file-contents-literally file nil 0 256)
6642c904 287 (image-type-from-buffer))))
4fde92ef
KS
288
289
290;;;###autoload
291(defun image-type-from-file-name (file)
292 "Determine the type of image file FILE from its name.
293Value is a symbol specifying the image type, or nil if type cannot
294be determined."
295 (let ((types image-type-file-name-regexps)
296 type)
297 (while types
298 (if (string-match (car (car types)) file)
299 (setq type (cdr (car types))
300 types nil)
301 (setq types (cdr types))))
302 type))
162dec01
GM
303
304
7840ced1 305;;;###autoload
e7968373
KS
306(defun image-type (file-or-data &optional type data-p)
307 "Determine and return image type.
162dec01 308FILE-OR-DATA is an image file name or image data.
7840ced1 309Optional TYPE is a symbol describing the image type. If TYPE is omitted
162dec01
GM
310or nil, try to determine the image type from its first few bytes
311of image data. If that doesn't work, and FILE-OR-DATA is a file name,
9ea8de1b 312use its file extension as image type.
e7968373 313Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data."
f64ae86c
GM
314 (when (and (not data-p) (not (stringp file-or-data)))
315 (error "Invalid image file name `%s'" file-or-data))
162dec01
GM
316 (cond ((null data-p)
317 ;; FILE-OR-DATA is a file name.
318 (unless (or type
319 (setq type (image-type-from-file-header file-or-data)))
320 (let ((extension (file-name-extension file-or-data)))
321 (unless extension
322 (error "Cannot determine image type"))
323 (setq type (intern extension)))))
324 (t
325 ;; FILE-OR-DATA contains image data.
326 (unless type
327 (setq type (image-type-from-data file-or-data)))))
328 (unless type
329 (error "Cannot determine image type"))
7840ced1 330 (unless (symbolp type)
162dec01 331 (error "Invalid image type `%s'" type))
e7968373
KS
332 type)
333
6642c904 334
e7968373
KS
335;;;###autoload
336(defun image-type-available-p (type)
337 "Return non-nil if image type TYPE is available.
338Image types are symbols like `xbm' or `jpeg'."
339 (and (fboundp 'init-image-library)
340 (init-image-library type image-library-alist)))
341
342
6642c904
JB
343;;;###autoload
344(defun image-type-auto-detected-p ()
345 "Return t iff the current buffer contains an auto-detectable image.
a9bb04bb
CY
346This function is intended to be used from `magic-mode-alist' (which see).
347
348First, compare the beginning of the buffer with `image-type-header-regexps'.
349If an appropriate image type is found, check if that image type can be
350autodetected using the variable `image-type-auto-detectable'. Finally,
351if `buffer-file-name' is non-nil, check if it matches another major mode
352in `auto-mode-alist' apart from `image-mode'; if there is another match,
353the autodetection is considered to have failed. Return t if all the above
354steps succeed."
6642c904
JB
355 (let* ((type (image-type-from-buffer))
356 (auto (and type (cdr (assq type image-type-auto-detectable)))))
357 (and auto
a9bb04bb
CY
358 (or (eq auto t) (image-type-available-p type))
359 (or (null buffer-file-name)
360 (not (assoc-default
361 buffer-file-name
362 (delq nil (mapcar
363 (lambda (elt)
364 (unless (memq (or (car-safe (cdr elt))
365 (cdr elt))
366 '(image-mode image-mode-maybe))
367 elt))
368 auto-mode-alist))
369 'string-match))))))
6642c904
JB
370
371
e7968373
KS
372;;;###autoload
373(defun create-image (file-or-data &optional type data-p &rest props)
374 "Create an image.
375FILE-OR-DATA is an image file name or image data.
376Optional TYPE is a symbol describing the image type. If TYPE is omitted
377or nil, try to determine the image type from its first few bytes
378of image data. If that doesn't work, and FILE-OR-DATA is a file name,
379use its file extension as image type.
380Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
381Optional PROPS are additional image attributes to assign to the image,
382like, e.g. `:mask MASK'.
383Value is the image created, or nil if images of type TYPE are not supported.
384
385Images should not be larger than specified by `max-image-size'."
386 (setq type (image-type file-or-data type data-p))
7840ced1 387 (when (image-type-available-p type)
162dec01
GM
388 (append (list 'image :type type (if data-p :data :file) file-or-data)
389 props)))
7840ced1
GM
390
391
392;;;###autoload
cedbd8d0 393(defun put-image (image pos &optional string area)
1571b5ff 394 "Put image IMAGE in front of POS in the current buffer.
7840ced1 395IMAGE must be an image created with `create-image' or `defimage'.
46655c94
GM
396IMAGE is displayed by putting an overlay into the current buffer with a
397`before-string' STRING that has a `display' property whose value is the
cedbd8d0 398image. STRING is defaulted if you omit it.
7840ced1 399POS may be an integer or marker.
7840ced1
GM
400AREA is where to display the image. AREA nil or omitted means
401display it in the text area, a value of `left-margin' means
402display it in the left marginal area, a value of `right-margin'
46655c94 403means display it in the right marginal area."
0ad550ba 404 (unless string (setq string "x"))
1571b5ff 405 (let ((buffer (current-buffer)))
cedbd8d0 406 (unless (eq (car-safe image) 'image)
1571b5ff
GM
407 (error "Not an image: %s" image))
408 (unless (or (null area) (memq area '(left-margin right-margin)))
409 (error "Invalid area %s" area))
46655c94 410 (setq string (copy-sequence string))
1571b5ff 411 (let ((overlay (make-overlay pos pos buffer))
46655c94
GM
412 (prop (if (null area) image (list (list 'margin area) image))))
413 (put-text-property 0 (length string) 'display prop string)
1571b5ff
GM
414 (overlay-put overlay 'put-image t)
415 (overlay-put overlay 'before-string string))))
7840ced1
GM
416
417
418;;;###autoload
5af275e0 419(defun insert-image (image &optional string area slice)
7840ced1 420 "Insert IMAGE into current buffer at point.
46655c94 421IMAGE is displayed by inserting STRING into the current buffer
cedbd8d0
DL
422with a `display' property whose value is the image. STRING is
423defaulted if you omit it.
7840ced1
GM
424AREA is where to display the image. AREA nil or omitted means
425display it in the text area, a value of `left-margin' means
426display it in the left marginal area, a value of `right-margin'
5af275e0
KS
427means display it in the right marginal area.
428SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
429means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
430specifying the X and Y positions and WIDTH and HEIGHT of image area
431to insert. A float value 0.0 - 1.0 means relative to the width or
432height of the image; integer values are taken as pixel values."
0ad550ba
DL
433 ;; Use a space as least likely to cause trouble when it's a hidden
434 ;; character in the buffer.
435 (unless string (setq string " "))
cedbd8d0 436 (unless (eq (car-safe image) 'image)
7840ced1
GM
437 (error "Not an image: %s" image))
438 (unless (or (null area) (memq area '(left-margin right-margin)))
439 (error "Invalid area %s" area))
0dc91c57
DL
440 (if area
441 (setq image (list (list 'margin area) image))
442 ;; Cons up a new spec equal but not eq to `image' so that
443 ;; inserting it twice in a row (adjacently) displays two copies of
444 ;; the image. Don't try to avoid this by looking at the display
445 ;; properties on either side so that we DTRT more often with
446 ;; cut-and-paste. (Yanking killed image text next to another copy
447 ;; of it loses anyway.)
448 (setq image (cons 'image (cdr image))))
46655c94
GM
449 (let ((start (point)))
450 (insert string)
451 (add-text-properties start (point)
5af275e0
KS
452 `(display ,(if slice
453 (list (cons 'slice slice) image)
454 image) rear-nonsticky (display)))))
455
456
f22c36d3 457;;;###autoload
5af275e0 458(defun insert-sliced-image (image &optional string area rows cols)
b48bc937
KS
459 "Insert IMAGE into current buffer at point.
460IMAGE is displayed by inserting STRING into the current buffer
461with a `display' property whose value is the image. STRING is
462defaulted if you omit it.
463AREA is where to display the image. AREA nil or omitted means
464display it in the text area, a value of `left-margin' means
465display it in the left marginal area, a value of `right-margin'
466means display it in the right marginal area.
467The image is automatically split into ROW x COLS slices."
5af275e0
KS
468 (unless string (setq string " "))
469 (unless (eq (car-safe image) 'image)
470 (error "Not an image: %s" image))
471 (unless (or (null area) (memq area '(left-margin right-margin)))
472 (error "Invalid area %s" area))
473 (if area
474 (setq image (list (list 'margin area) image))
475 ;; Cons up a new spec equal but not eq to `image' so that
476 ;; inserting it twice in a row (adjacently) displays two copies of
477 ;; the image. Don't try to avoid this by looking at the display
478 ;; properties on either side so that we DTRT more often with
479 ;; cut-and-paste. (Yanking killed image text next to another copy
480 ;; of it loses anyway.)
481 (setq image (cons 'image (cdr image))))
482 (let ((x 0.0) (dx (/ 1.0001 (or cols 1)))
483 (y 0.0) (dy (/ 1.0001 (or rows 1))))
484 (while (< y 1.0)
485 (while (< x 1.0)
486 (let ((start (point)))
487 (insert string)
488 (add-text-properties start (point)
489 `(display ,(list (list 'slice x y dx dy) image)
490 rear-nonsticky (display)))
491 (setq x (+ x dx))))
492 (setq x 0.0
493 y (+ y dy))
82dc617b 494 (insert (propertize "\n" 'line-height t)))))
5af275e0 495
10e2102e 496
7840ced1
GM
497
498;;;###autoload
499(defun remove-images (start end &optional buffer)
500 "Remove images between START and END in BUFFER.
501Remove only images that were put in BUFFER with calls to `put-image'.
502BUFFER nil or omitted means use the current buffer."
503 (unless buffer
504 (setq buffer (current-buffer)))
505 (let ((overlays (overlays-in start end)))
506 (while overlays
507 (let ((overlay (car overlays)))
508 (when (overlay-get overlay 'put-image)
0c898dd9
DL
509 (delete-overlay overlay)))
510 (setq overlays (cdr overlays)))))
7840ced1 511
4fde92ef
KS
512(defun image-search-load-path (file &optional path)
513 (unless path
514 (setq path image-load-path))
515 (let (element found filename)
5fc5ac38 516 (while (and (not found) (consp path))
93a75651 517 (setq element (car path))
5fc5ac38 518 (cond
93a75651 519 ((stringp element)
5fc5ac38
CY
520 (setq found
521 (file-readable-p
4fde92ef 522 (setq filename (expand-file-name file element)))))
93a75651
CY
523 ((and (symbolp element) (boundp element))
524 (setq element (symbol-value element))
525 (cond
526 ((stringp element)
527 (setq found
528 (file-readable-p
4fde92ef 529 (setq filename (expand-file-name file element)))))
93a75651 530 ((consp element)
4fde92ef 531 (if (setq filename (image-search-load-path file element))
93a75651 532 (setq found t))))))
5fc5ac38 533 (setq path (cdr path)))
4fde92ef 534 (if found filename)))
7840ced1
GM
535
536;;;###autoload
349c034d
GM
537(defun find-image (specs)
538 "Find an image, choosing one of a list of image specifications.
7840ced1 539
cedbd8d0 540SPECS is a list of image specifications.
7840ced1
GM
541
542Each image specification in SPECS is a property list. The contents of
543a specification are image type dependent. All specifications must at
bc283707
WP
544least contain the properties `:type TYPE' and either `:file FILE' or
545`:data DATA', where TYPE is a symbol specifying the image type,
546e.g. `xbm', FILE is the file to load the image from, and DATA is a
cedbd8d0
DL
547string containing the actual image data. The specification whose TYPE
548is supported, and FILE exists, is used to construct the image
549specification to be returned. Return nil if no specification is
550satisfied.
551
8646a62e
CY
552The image is looked for in `image-load-path'.
553
554Image files should not be larger than specified by `max-image-size'."
7840ced1
GM
555 (let (image)
556 (while (and specs (null image))
557 (let* ((spec (car specs))
558 (type (plist-get spec :type))
162dec01 559 (data (plist-get spec :data))
7f228379
GM
560 (file (plist-get spec :file))
561 found)
162dec01
GM
562 (when (image-type-available-p type)
563 (cond ((stringp file)
4fde92ef 564 (if (setq found (image-search-load-path file))
5fc5ac38
CY
565 (setq image
566 (cons 'image (plist-put (copy-sequence spec)
567 :file found)))))
f64ae86c 568 ((not (null data))
162dec01
GM
569 (setq image (cons 'image spec)))))
570 (setq specs (cdr specs))))
349c034d
GM
571 image))
572
573
574;;;###autoload
575(defmacro defimage (symbol specs &optional doc)
576 "Define SYMBOL as an image.
577
578SPECS is a list of image specifications. DOC is an optional
579documentation string.
580
581Each image specification in SPECS is a property list. The contents of
582a specification are image type dependent. All specifications must at
583least contain the properties `:type TYPE' and either `:file FILE' or
584`:data DATA', where TYPE is a symbol specifying the image type,
585e.g. `xbm', FILE is the file to load the image from, and DATA is a
586string containing the actual image data. The first image
587specification whose TYPE is supported, and FILE exists, is used to
588define SYMBOL.
589
590Example:
591
592 (defimage test-image ((:type xpm :file \"~/test1.xpm\")
593 (:type xbm :file \"~/test1.xbm\")))"
fd8e7a80 594 (declare (doc-string 3))
349c034d 595 `(defvar ,symbol (find-image ',specs) ,doc))
7840ced1
GM
596
597
598(provide 'image)
599
fd8e7a80 600;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3
e43367a0 601;;; image.el ends here