25003
|
1 ;;; image.el --- image API
|
|
2
|
56106
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
3 ;; Copyright (C) 1998, 99, 2000, 01, 04 Free Software Foundation, Inc.
|
42316
|
4
|
|
5 ;; Maintainer: FSF
|
25309
|
6 ;; Keywords: multimedia
|
25003
|
7
|
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
13 ;; any later version.
|
|
14
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
18 ;; GNU General Public License for more details.
|
|
19
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
24
|
|
25 ;;; Commentary:
|
|
26
|
|
27 ;;; Code:
|
|
28
|
32166
|
29
|
|
30 (defgroup image ()
|
|
31 "Image support."
|
|
32 :group 'multimedia)
|
|
33
|
|
34
|
25003
|
35 (defconst image-type-regexps
|
38746
|
36 '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
|
38709
|
37 ("\\`P[1-6]" . pbm)
|
|
38 ("\\`GIF8" . gif)
|
|
39 ("\\`\211PNG\r\n" . png)
|
38746
|
40 ("\\`[\t\n\r ]*#define" . xbm)
|
38884
|
41 ("\\`\\(MM\0\\*\\|II\\*\0\\)" . tiff)
|
38746
|
42 ("\\`[\t\n\r ]*%!PS" . postscript)
|
38732
|
43 ("\\`\xff\xd8" . (image-jpeg-p . jpeg)))
|
25003
|
44 "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
|
|
45 When the first bytes of an image file match REGEXP, it is assumed to
|
38732
|
46 be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol,
|
|
47 IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called
|
|
48 with one argument, a string containing the image data. If PREDICATE returns
|
49589
|
49 a non-nil value, TYPE is the image's type.")
|
38732
|
50
|
56106
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
51 ;;;###autoload
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
52 (defvar image-library-alist nil
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
53 "Alist of image types vs external libraries needed to display them.
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
54
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
55 Each element is a list (IMAGE-TYPE LIBRARY...), where the car is a symbol
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
56 representing a supported image type, and the rest are strings giving
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
57 alternate filenames for the corresponding external libraries to load.
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
58 They are tried in the order they appear on the list; if none of them can
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
59 be loaded, the running session of Emacs won't display the image type.
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
60 No entries are needed for pbm and xbm images; they're always supported.")
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
61 ;;;###autoload (put 'image-library-alist 'risky-local-variable t)
|
38732
|
62
|
|
63 (defun image-jpeg-p (data)
|
46810
|
64 "Value is non-nil if DATA, a string, consists of JFIF image data.
|
|
65 We accept the tag Exif because that is the same format."
|
38732
|
66 (when (string-match "\\`\xff\xd8" data)
|
|
67 (catch 'jfif
|
|
68 (let ((len (length data)) (i 2))
|
|
69 (while (< i len)
|
|
70 (when (/= (aref data i) #xff)
|
|
71 (throw 'jfif nil))
|
|
72 (setq i (1+ i))
|
|
73 (when (>= (+ i 2) len)
|
|
74 (throw 'jfif nil))
|
|
75 (let ((nbytes (+ (lsh (aref data (+ i 1)) 8)
|
38776
|
76 (aref data (+ i 2))))
|
|
77 (code (aref data i)))
|
|
78 (when (and (>= code #xe0) (<= code #xef))
|
38732
|
79 ;; APP0 LEN1 LEN2 "JFIF\0"
|
49588
|
80 (throw 'jfif
|
52344
|
81 (string-match "JFIF\\|Exif"
|
|
82 (substring data i (min (+ i nbytes) len)))))
|
38746
|
83 (setq i (+ i 1 nbytes))))))))
|
25003
|
84
|
|
85
|
|
86 ;;;###autoload
|
27073
|
87 (defun image-type-from-data (data)
|
|
88 "Determine the image type from image data DATA.
|
|
89 Value is a symbol specifying the image type or nil if type cannot
|
|
90 be determined."
|
|
91 (let ((types image-type-regexps)
|
|
92 type)
|
|
93 (while (and types (null type))
|
|
94 (let ((regexp (car (car types)))
|
|
95 (image-type (cdr (car types))))
|
38732
|
96 (when (or (and (symbolp image-type)
|
|
97 (string-match regexp data))
|
|
98 (and (consp image-type)
|
|
99 (funcall (car image-type) data)
|
|
100 (setq image-type (cdr image-type))))
|
27073
|
101 (setq type image-type))
|
|
102 (setq types (cdr types))))
|
|
103 type))
|
|
104
|
|
105
|
|
106 ;;;###autoload
|
25003
|
107 (defun image-type-from-file-header (file)
|
|
108 "Determine the type of image file FILE from its first few bytes.
|
|
109 Value is a symbol specifying the image type, or nil if type cannot
|
|
110 be determined."
|
|
111 (unless (file-name-directory file)
|
27073
|
112 (setq file (expand-file-name file data-directory)))
|
25003
|
113 (setq file (expand-file-name file))
|
|
114 (let ((header (with-temp-buffer
|
43834
|
115 (set-buffer-multibyte nil)
|
25003
|
116 (insert-file-contents-literally file nil 0 256)
|
27073
|
117 (buffer-string))))
|
|
118 (image-type-from-data header)))
|
25003
|
119
|
|
120
|
|
121 ;;;###autoload
|
|
122 (defun image-type-available-p (type)
|
|
123 "Value is non-nil if image type TYPE is available.
|
|
124 Image types are symbols like `xbm' or `jpeg'."
|
56106
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
125 (and (fboundp 'init-image-library)
|
5b3f0e4cf47f
(image-library-alist): New variable to map image types to external
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
126 (init-image-library type image-library-alist)))
|
25003
|
127
|
|
128 ;;;###autoload
|
27073
|
129 (defun create-image (file-or-data &optional type data-p &rest props)
|
|
130 "Create an image.
|
|
131 FILE-OR-DATA is an image file name or image data.
|
25003
|
132 Optional TYPE is a symbol describing the image type. If TYPE is omitted
|
27073
|
133 or nil, try to determine the image type from its first few bytes
|
|
134 of image data. If that doesn't work, and FILE-OR-DATA is a file name,
|
34378
5ae7af279df7
(create-image): Doc fix; spotted by Per Cederqvist <ceder@lysator.liu.se>.
Eli Zaretskii <eliz@gnu.org>
diff
changeset
|
135 use its file extension as image type.
|
27073
|
136 Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
|
25003
|
137 Optional PROPS are additional image attributes to assign to the image,
|
31635
|
138 like, e.g. `:mask MASK'.
|
25003
|
139 Value is the image created, or nil if images of type TYPE are not supported."
|
27075
|
140 (when (and (not data-p) (not (stringp file-or-data)))
|
|
141 (error "Invalid image file name `%s'" file-or-data))
|
27073
|
142 (cond ((null data-p)
|
|
143 ;; FILE-OR-DATA is a file name.
|
|
144 (unless (or type
|
|
145 (setq type (image-type-from-file-header file-or-data)))
|
|
146 (let ((extension (file-name-extension file-or-data)))
|
|
147 (unless extension
|
|
148 (error "Cannot determine image type"))
|
|
149 (setq type (intern extension)))))
|
|
150 (t
|
|
151 ;; FILE-OR-DATA contains image data.
|
|
152 (unless type
|
|
153 (setq type (image-type-from-data file-or-data)))))
|
|
154 (unless type
|
|
155 (error "Cannot determine image type"))
|
25003
|
156 (unless (symbolp type)
|
27073
|
157 (error "Invalid image type `%s'" type))
|
25003
|
158 (when (image-type-available-p type)
|
27073
|
159 (append (list 'image :type type (if data-p :data :file) file-or-data)
|
|
160 props)))
|
25003
|
161
|
|
162
|
|
163 ;;;###autoload
|
29470
|
164 (defun put-image (image pos &optional string area)
|
25617
|
165 "Put image IMAGE in front of POS in the current buffer.
|
25003
|
166 IMAGE must be an image created with `create-image' or `defimage'.
|
25816
|
167 IMAGE is displayed by putting an overlay into the current buffer with a
|
|
168 `before-string' STRING that has a `display' property whose value is the
|
29470
|
169 image. STRING is defaulted if you omit it.
|
25003
|
170 POS may be an integer or marker.
|
|
171 AREA is where to display the image. AREA nil or omitted means
|
|
172 display it in the text area, a value of `left-margin' means
|
|
173 display it in the left marginal area, a value of `right-margin'
|
25816
|
174 means display it in the right marginal area."
|
29626
|
175 (unless string (setq string "x"))
|
25617
|
176 (let ((buffer (current-buffer)))
|
29470
|
177 (unless (eq (car-safe image) 'image)
|
25617
|
178 (error "Not an image: %s" image))
|
|
179 (unless (or (null area) (memq area '(left-margin right-margin)))
|
|
180 (error "Invalid area %s" area))
|
25816
|
181 (setq string (copy-sequence string))
|
25617
|
182 (let ((overlay (make-overlay pos pos buffer))
|
25816
|
183 (prop (if (null area) image (list (list 'margin area) image))))
|
|
184 (put-text-property 0 (length string) 'display prop string)
|
25617
|
185 (overlay-put overlay 'put-image t)
|
|
186 (overlay-put overlay 'before-string string))))
|
25003
|
187
|
|
188
|
|
189 ;;;###autoload
|
55033
|
190 (defun insert-image (image &optional string area slice)
|
25003
|
191 "Insert IMAGE into current buffer at point.
|
25816
|
192 IMAGE is displayed by inserting STRING into the current buffer
|
29470
|
193 with a `display' property whose value is the image. STRING is
|
|
194 defaulted if you omit it.
|
25003
|
195 AREA is where to display the image. AREA nil or omitted means
|
|
196 display it in the text area, a value of `left-margin' means
|
|
197 display it in the left marginal area, a value of `right-margin'
|
55033
|
198 means display it in the right marginal area.
|
|
199 SLICE specifies slice of IMAGE to insert. SLICE nil or omitted
|
|
200 means insert whole image. SLICE is a list (X Y WIDTH HEIGHT)
|
|
201 specifying the X and Y positions and WIDTH and HEIGHT of image area
|
|
202 to insert. A float value 0.0 - 1.0 means relative to the width or
|
|
203 height of the image; integer values are taken as pixel values."
|
29626
|
204 ;; Use a space as least likely to cause trouble when it's a hidden
|
|
205 ;; character in the buffer.
|
|
206 (unless string (setq string " "))
|
29470
|
207 (unless (eq (car-safe image) 'image)
|
25003
|
208 (error "Not an image: %s" image))
|
|
209 (unless (or (null area) (memq area '(left-margin right-margin)))
|
|
210 (error "Invalid area %s" area))
|
29607
|
211 (if area
|
|
212 (setq image (list (list 'margin area) image))
|
|
213 ;; Cons up a new spec equal but not eq to `image' so that
|
|
214 ;; inserting it twice in a row (adjacently) displays two copies of
|
|
215 ;; the image. Don't try to avoid this by looking at the display
|
|
216 ;; properties on either side so that we DTRT more often with
|
|
217 ;; cut-and-paste. (Yanking killed image text next to another copy
|
|
218 ;; of it loses anyway.)
|
|
219 (setq image (cons 'image (cdr image))))
|
25816
|
220 (let ((start (point)))
|
|
221 (insert string)
|
|
222 (add-text-properties start (point)
|
55033
|
223 `(display ,(if slice
|
|
224 (list (cons 'slice slice) image)
|
|
225 image) rear-nonsticky (display)))))
|
|
226
|
|
227
|
|
228 (defun insert-sliced-image (image &optional string area rows cols)
|
|
229 (unless string (setq string " "))
|
|
230 (unless (eq (car-safe image) 'image)
|
|
231 (error "Not an image: %s" image))
|
|
232 (unless (or (null area) (memq area '(left-margin right-margin)))
|
|
233 (error "Invalid area %s" area))
|
|
234 (if area
|
|
235 (setq image (list (list 'margin area) image))
|
|
236 ;; Cons up a new spec equal but not eq to `image' so that
|
|
237 ;; inserting it twice in a row (adjacently) displays two copies of
|
|
238 ;; the image. Don't try to avoid this by looking at the display
|
|
239 ;; properties on either side so that we DTRT more often with
|
|
240 ;; cut-and-paste. (Yanking killed image text next to another copy
|
|
241 ;; of it loses anyway.)
|
|
242 (setq image (cons 'image (cdr image))))
|
|
243 (let ((x 0.0) (dx (/ 1.0001 (or cols 1)))
|
|
244 (y 0.0) (dy (/ 1.0001 (or rows 1))))
|
|
245 (while (< y 1.0)
|
|
246 (while (< x 1.0)
|
|
247 (let ((start (point)))
|
|
248 (insert string)
|
|
249 (add-text-properties start (point)
|
|
250 `(display ,(list (list 'slice x y dx dy) image)
|
|
251 rear-nonsticky (display)))
|
|
252 (setq x (+ x dx))))
|
|
253 (setq x 0.0
|
|
254 y (+ y dy))
|
55167
|
255 (insert (propertize "\n" 'line-height 0)))))
|
55033
|
256
|
26007
|
257
|
25003
|
258
|
|
259 ;;;###autoload
|
|
260 (defun remove-images (start end &optional buffer)
|
|
261 "Remove images between START and END in BUFFER.
|
|
262 Remove only images that were put in BUFFER with calls to `put-image'.
|
|
263 BUFFER nil or omitted means use the current buffer."
|
|
264 (unless buffer
|
|
265 (setq buffer (current-buffer)))
|
|
266 (let ((overlays (overlays-in start end)))
|
|
267 (while overlays
|
|
268 (let ((overlay (car overlays)))
|
|
269 (when (overlay-get overlay 'put-image)
|
25857
|
270 (delete-overlay overlay)))
|
|
271 (setq overlays (cdr overlays)))))
|
25003
|
272
|
|
273
|
|
274 ;;;###autoload
|
28721
|
275 (defun find-image (specs)
|
|
276 "Find an image, choosing one of a list of image specifications.
|
25003
|
277
|
29470
|
278 SPECS is a list of image specifications.
|
25003
|
279
|
|
280 Each image specification in SPECS is a property list. The contents of
|
|
281 a specification are image type dependent. All specifications must at
|
27059
6bb2a4a0413e
* image.el (defimage): Images with the :data keyword should be considered valid as well.
William M. Perry <wmperry@aventail.com>
diff
changeset
|
282 least contain the properties `:type TYPE' and either `:file FILE' or
|
6bb2a4a0413e
* image.el (defimage): Images with the :data keyword should be considered valid as well.
William M. Perry <wmperry@aventail.com>
diff
changeset
|
283 `:data DATA', where TYPE is a symbol specifying the image type,
|
6bb2a4a0413e
* image.el (defimage): Images with the :data keyword should be considered valid as well.
William M. Perry <wmperry@aventail.com>
diff
changeset
|
284 e.g. `xbm', FILE is the file to load the image from, and DATA is a
|
29470
|
285 string containing the actual image data. The specification whose TYPE
|
|
286 is supported, and FILE exists, is used to construct the image
|
|
287 specification to be returned. Return nil if no specification is
|
|
288 satisfied.
|
|
289
|
|
290 The image is looked for first on `load-path' and then in `data-directory'."
|
25003
|
291 (let (image)
|
|
292 (while (and specs (null image))
|
|
293 (let* ((spec (car specs))
|
27073
|
294 (type (plist-get spec :type))
|
27059
6bb2a4a0413e
* image.el (defimage): Images with the :data keyword should be considered valid as well.
William M. Perry <wmperry@aventail.com>
diff
changeset
|
295 (data (plist-get spec :data))
|
27921
|
296 (file (plist-get spec :file))
|
|
297 found)
|
27073
|
298 (when (image-type-available-p type)
|
|
299 (cond ((stringp file)
|
27921
|
300 (let ((path load-path))
|
|
301 (while (and (not found) path)
|
|
302 (let ((try-file (expand-file-name file (car path))))
|
|
303 (when (file-readable-p try-file)
|
|
304 (setq found try-file)))
|
|
305 (setq path (cdr path)))
|
|
306 (unless found
|
29470
|
307 (let ((try-file (expand-file-name file data-directory)))
|
|
308 (if (file-readable-p try-file)
|
|
309 (setq found try-file))))
|
|
310 (if found
|
|
311 (setq image
|
30952
|
312 (cons 'image (plist-put (copy-sequence spec)
|
|
313 :file found))))))
|
27075
|
314 ((not (null data))
|
27073
|
315 (setq image (cons 'image spec)))))
|
|
316 (setq specs (cdr specs))))
|
28721
|
317 image))
|
|
318
|
|
319
|
|
320 ;;;###autoload
|
|
321 (defmacro defimage (symbol specs &optional doc)
|
|
322 "Define SYMBOL as an image.
|
|
323
|
|
324 SPECS is a list of image specifications. DOC is an optional
|
|
325 documentation string.
|
|
326
|
|
327 Each image specification in SPECS is a property list. The contents of
|
|
328 a specification are image type dependent. All specifications must at
|
|
329 least contain the properties `:type TYPE' and either `:file FILE' or
|
|
330 `:data DATA', where TYPE is a symbol specifying the image type,
|
|
331 e.g. `xbm', FILE is the file to load the image from, and DATA is a
|
|
332 string containing the actual image data. The first image
|
|
333 specification whose TYPE is supported, and FILE exists, is used to
|
|
334 define SYMBOL.
|
|
335
|
|
336 Example:
|
|
337
|
|
338 (defimage test-image ((:type xpm :file \"~/test1.xpm\")
|
|
339 (:type xbm :file \"~/test1.xbm\")))"
|
|
340 `(defvar ,symbol (find-image ',specs) ,doc))
|
25003
|
341
|
|
342
|
|
343 (provide 'image)
|
|
344
|
52401
|
345 ;;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3
|
25872
|
346 ;;; image.el ends here
|