*** empty log message ***
[bpt/emacs.git] / lisp / image.el
CommitLineData
7840ced1
GM
1;;; image.el --- image API
2
7f228379 3;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
04799cf5 4;; Keywords: multimedia
7840ced1
GM
5
6;; This file is part of GNU Emacs.
7
8;; GNU Emacs is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2, or (at your option)
11;; any later version.
12
13;; GNU Emacs is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with GNU Emacs; see the file COPYING. If not, write to the
20;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21;; Boston, MA 02111-1307, USA.
22
23;;; Commentary:
24
25;;; Code:
26
27(defconst image-type-regexps
28 '(("^/\\*.*XPM.\\*/" . xpm)
29 ("^P[1-6]" . pbm)
30 ("^GIF8" . gif)
31 ("JFIF" . jpeg)
32 ("^\211PNG\r\n" . png)
33 ("^#define" . xbm)
34 ("^\\(MM\0\\*\\)\\|\\(II\\*\0\\)" . tiff)
35 ("^%!PS" . ghostscript))
36 "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
37When the first bytes of an image file match REGEXP, it is assumed to
38be of image type IMAGE-TYPE.")
39
40
41;;;###autoload
162dec01
GM
42(defun image-type-from-data (data)
43 "Determine the image type from image data DATA.
44Value is a symbol specifying the image type or nil if type cannot
7840ced1 45be determined."
162dec01 46 (let ((types image-type-regexps)
7840ced1
GM
47 type)
48 (while (and types (null type))
49 (let ((regexp (car (car types)))
50 (image-type (cdr (car types))))
162dec01 51 (when (string-match regexp data)
7840ced1
GM
52 (setq type image-type))
53 (setq types (cdr types))))
54 type))
55
56
162dec01
GM
57;;;###autoload
58(defun image-type-from-file-header (file)
59 "Determine the type of image file FILE from its first few bytes.
60Value is a symbol specifying the image type, or nil if type cannot
61be determined."
62 (unless (file-name-directory file)
63 (setq file (expand-file-name file data-directory)))
64 (setq file (expand-file-name file))
65 (let ((header (with-temp-buffer
66 (insert-file-contents-literally file nil 0 256)
67 (buffer-string))))
68 (image-type-from-data header)))
69
70
7840ced1
GM
71;;;###autoload
72(defun image-type-available-p (type)
73 "Value is non-nil if image type TYPE is available.
74Image types are symbols like `xbm' or `jpeg'."
24978190 75 (and (boundp 'image-types) (not (null (memq type image-types)))))
7840ced1
GM
76
77
78;;;###autoload
162dec01
GM
79(defun create-image (file-or-data &optional type data-p &rest props)
80 "Create an image.
81FILE-OR-DATA is an image file name or image data.
7840ced1 82Optional TYPE is a symbol describing the image type. If TYPE is omitted
162dec01
GM
83or nil, try to determine the image type from its first few bytes
84of image data. If that doesn't work, and FILE-OR-DATA is a file name,
85use its file extension.as image type.
86Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
7840ced1
GM
87Optional PROPS are additional image attributes to assign to the image,
88like, e.g. `:heuristic-mask t'.
89Value is the image created, or nil if images of type TYPE are not supported."
f64ae86c
GM
90 (when (and (not data-p) (not (stringp file-or-data)))
91 (error "Invalid image file name `%s'" file-or-data))
162dec01
GM
92 (cond ((null data-p)
93 ;; FILE-OR-DATA is a file name.
94 (unless (or type
95 (setq type (image-type-from-file-header file-or-data)))
96 (let ((extension (file-name-extension file-or-data)))
97 (unless extension
98 (error "Cannot determine image type"))
99 (setq type (intern extension)))))
100 (t
101 ;; FILE-OR-DATA contains image data.
102 (unless type
103 (setq type (image-type-from-data file-or-data)))))
104 (unless type
105 (error "Cannot determine image type"))
7840ced1 106 (unless (symbolp type)
162dec01 107 (error "Invalid image type `%s'" type))
7840ced1 108 (when (image-type-available-p type)
162dec01
GM
109 (append (list 'image :type type (if data-p :data :file) file-or-data)
110 props)))
7840ced1
GM
111
112
113;;;###autoload
cedbd8d0 114(defun put-image (image pos &optional string area)
1571b5ff 115 "Put image IMAGE in front of POS in the current buffer.
7840ced1 116IMAGE must be an image created with `create-image' or `defimage'.
46655c94
GM
117IMAGE is displayed by putting an overlay into the current buffer with a
118`before-string' STRING that has a `display' property whose value is the
cedbd8d0 119image. STRING is defaulted if you omit it.
7840ced1 120POS may be an integer or marker.
7840ced1
GM
121AREA is where to display the image. AREA nil or omitted means
122display it in the text area, a value of `left-margin' means
123display it in the left marginal area, a value of `right-margin'
46655c94 124means display it in the right marginal area."
cedbd8d0 125 (unless string (setq string "x"))
1571b5ff 126 (let ((buffer (current-buffer)))
cedbd8d0 127 (unless (eq (car-safe image) 'image)
1571b5ff
GM
128 (error "Not an image: %s" image))
129 (unless (or (null area) (memq area '(left-margin right-margin)))
130 (error "Invalid area %s" area))
46655c94 131 (setq string (copy-sequence string))
1571b5ff 132 (let ((overlay (make-overlay pos pos buffer))
46655c94
GM
133 (prop (if (null area) image (list (list 'margin area) image))))
134 (put-text-property 0 (length string) 'display prop string)
1571b5ff
GM
135 (overlay-put overlay 'put-image t)
136 (overlay-put overlay 'before-string string))))
7840ced1
GM
137
138
139;;;###autoload
cedbd8d0 140(defun insert-image (image &optional string area)
7840ced1 141 "Insert IMAGE into current buffer at point.
46655c94 142IMAGE is displayed by inserting STRING into the current buffer
cedbd8d0
DL
143with a `display' property whose value is the image. STRING is
144defaulted if you omit it.
7840ced1
GM
145AREA is where to display the image. AREA nil or omitted means
146display it in the text area, a value of `left-margin' means
147display it in the left marginal area, a value of `right-margin'
46655c94 148means display it in the right marginal area."
cedbd8d0
DL
149 (unless string (setq string "x"))
150 (unless (eq (car-safe image) 'image)
7840ced1
GM
151 (error "Not an image: %s" image))
152 (unless (or (null area) (memq area '(left-margin right-margin)))
153 (error "Invalid area %s" area))
46655c94
GM
154 (when area
155 (setq image (list (list 'margin area) image)))
156 (let ((start (point)))
157 (insert string)
10e2102e
DL
158 ;; Copy `image' so that inserting it twice in a row (adjacently)
159 ;; displays two copies of the image.
46655c94 160 (add-text-properties start (point)
10e2102e
DL
161 (list 'display (copy-sequence image)
162 'intangible (list t) ; something unique
46655c94 163 'rear-nonsticky (list 'display)))))
10e2102e 164
7840ced1
GM
165
166;;;###autoload
167(defun remove-images (start end &optional buffer)
168 "Remove images between START and END in BUFFER.
169Remove only images that were put in BUFFER with calls to `put-image'.
170BUFFER nil or omitted means use the current buffer."
171 (unless buffer
172 (setq buffer (current-buffer)))
173 (let ((overlays (overlays-in start end)))
174 (while overlays
175 (let ((overlay (car overlays)))
176 (when (overlay-get overlay 'put-image)
0c898dd9
DL
177 (delete-overlay overlay)))
178 (setq overlays (cdr overlays)))))
7840ced1
GM
179
180
181;;;###autoload
349c034d
GM
182(defun find-image (specs)
183 "Find an image, choosing one of a list of image specifications.
7840ced1 184
cedbd8d0 185SPECS is a list of image specifications.
7840ced1
GM
186
187Each image specification in SPECS is a property list. The contents of
188a specification are image type dependent. All specifications must at
bc283707
WP
189least contain the properties `:type TYPE' and either `:file FILE' or
190`:data DATA', where TYPE is a symbol specifying the image type,
191e.g. `xbm', FILE is the file to load the image from, and DATA is a
cedbd8d0
DL
192string containing the actual image data. The specification whose TYPE
193is supported, and FILE exists, is used to construct the image
194specification to be returned. Return nil if no specification is
195satisfied.
196
197The image is looked for first on `load-path' and then in `data-directory'."
7840ced1
GM
198 (let (image)
199 (while (and specs (null image))
200 (let* ((spec (car specs))
201 (type (plist-get spec :type))
162dec01 202 (data (plist-get spec :data))
7f228379
GM
203 (file (plist-get spec :file))
204 found)
162dec01
GM
205 (when (image-type-available-p type)
206 (cond ((stringp file)
7f228379
GM
207 (let ((path load-path))
208 (while (and (not found) path)
209 (let ((try-file (expand-file-name file (car path))))
210 (when (file-readable-p try-file)
211 (setq found try-file)))
212 (setq path (cdr path)))
213 (unless found
cedbd8d0
DL
214 (let ((try-file (expand-file-name file data-directory)))
215 (if (file-readable-p try-file)
216 (setq found try-file))))
217 (if found
218 (setq image
219 (cons 'image (plist-put spec :file found))))))
f64ae86c 220 ((not (null data))
162dec01
GM
221 (setq image (cons 'image spec)))))
222 (setq specs (cdr specs))))
349c034d
GM
223 image))
224
225
226;;;###autoload
227(defmacro defimage (symbol specs &optional doc)
228 "Define SYMBOL as an image.
229
230SPECS is a list of image specifications. DOC is an optional
231documentation string.
232
233Each image specification in SPECS is a property list. The contents of
234a specification are image type dependent. All specifications must at
235least contain the properties `:type TYPE' and either `:file FILE' or
236`:data DATA', where TYPE is a symbol specifying the image type,
237e.g. `xbm', FILE is the file to load the image from, and DATA is a
238string containing the actual image data. The first image
239specification whose TYPE is supported, and FILE exists, is used to
240define SYMBOL.
241
242Example:
243
244 (defimage test-image ((:type xpm :file \"~/test1.xpm\")
245 (:type xbm :file \"~/test1.xbm\")))"
246 `(defvar ,symbol (find-image ',specs) ,doc))
7840ced1
GM
247
248
249(provide 'image)
250
e43367a0 251;;; image.el ends here