comparison lisp/image.el @ 74916:03827985fb39

(image-type-header-regexps): Change element format to include third item NOT-ALWAYS. (image-type-from-data): Handle new format. (image-type-from-buffer): Handle new format. New arg INCLUDE-MAYBES. (image-type-from-file-header): Pass t for INCLUDE-MAYBES.
author Richard M. Stallman <rms@gnu.org>
date Tue, 26 Dec 2006 18:01:40 +0000
parents 3fb128bfa8b4
children 94afc7cac404
comparison
equal deleted inserted replaced
74915:77a25925b486 74916:03827985fb39
32 "Image support." 32 "Image support."
33 :group 'multimedia) 33 :group 'multimedia)
34 34
35 35
36 (defconst image-type-header-regexps 36 (defconst image-type-header-regexps
37 '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm) 37 '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" xpm)
38 ("\\`P[1-6][[:space:]]+\\(?:#.*[[:space:]]+\\)*[0-9]+[[:space:]]+[0-9]+" . pbm) 38 ("\\`P[1-6][[:space:]]+\\(?:#.*[[:space:]]+\\)*[0-9]+[[:space:]]+[0-9]+" pbm)
39 ("\\`GIF8" . gif) 39 ("\\`GIF8" gif)
40 ("\\`\x89PNG\r\n\x1a\n" . png) 40 ("\\`\x89PNG\r\n\x1a\n" png)
41 ("\\`[\t\n\r ]*#define" . xbm) 41 ("\\`[\t\n\r ]*#define" xbm)
42 ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff) 42 ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" tiff)
43 ("\\`[\t\n\r ]*%!PS" . postscript) 43 ("\\`[\t\n\r ]*%!PS" postscript t)
44 ("\\`\xff\xd8" . (image-jpeg-p . jpeg))) 44 ("\\`\xff\xd8" (image-jpeg-p . jpeg)))
45 "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types. 45 "Alist of (REGEXP IMAGE-TYPE) pairs used to auto-detect image types.
46 When the first bytes of an image file match REGEXP, it is assumed to 46 When the first bytes of an image file match REGEXP, it is assumed to
47 be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol. If not a symbol, 47 be of image type IMAGE-TYPE if IMAGE-TYPE is a symbol.
48 IMAGE-TYPE must be a pair (PREDICATE . TYPE). PREDICATE is called 48
49 with one argument, a string containing the image data. If PREDICATE returns 49 An element can also be (REGEXP IMAGE-TYPE NOT-ALWAYS). If
50 a non-nil value, TYPE is the image's type.") 50 NOT-ALWAYS is non-nil, that means that REGEXP identifies a
51 file that _can_ be treated as an image of type IMAGE-TYPE,
52 but such files should not be spontaneously treated as images.
53
54 IMAGE-TYPE can be a pair (PREDICATE . TYPE) instead of a
55 symbol. Then PREDICATE is called with one argument, a
56 string containing the image data. If PREDICATE returns a
57 non-nil value, TYPE is the image's type.")
51 58
52 (defconst image-type-file-name-regexps 59 (defconst image-type-file-name-regexps
53 '(("\\.png\\'" . png) 60 '(("\\.png\\'" . png)
54 ("\\.gif\\'" . gif) 61 ("\\.gif\\'" . gif)
55 ("\\.jpe?g\\'" . jpeg) 62 ("\\.jpe?g\\'" . jpeg)
203 be determined." 210 be determined."
204 (let ((types image-type-header-regexps) 211 (let ((types image-type-header-regexps)
205 type) 212 type)
206 (while types 213 (while types
207 (let ((regexp (car (car types))) 214 (let ((regexp (car (car types)))
208 (image-type (cdr (car types)))) 215 (image-type (nth 1 (car types))))
209 (if (or (and (symbolp image-type) 216 (if (or (and (symbolp image-type)
210 (string-match regexp data)) 217 (string-match regexp data))
211 (and (consp image-type) 218 (and (consp image-type)
212 (funcall (car image-type) data) 219 (funcall (car image-type) data)
213 (setq image-type (cdr image-type)))) 220 (setq image-type (cdr image-type))))
216 (setq types (cdr types))))) 223 (setq types (cdr types)))))
217 type)) 224 type))
218 225
219 226
220 ;;;###autoload 227 ;;;###autoload
221 (defun image-type-from-buffer () 228 (defun image-type-from-buffer (&optional include-maybes)
222 "Determine the image type from data in the current buffer. 229 "Determine the image type from data in the current buffer.
223 Value is a symbol specifying the image type or nil if type cannot 230 Value is a symbol specifying the image type, or nil if none
224 be determined." 231 corresponds to the buffer contents.
232
233 If INCLUDE-MAYBES is nil (the default), we return nil for
234 file types that should not always be treated as images
235 even though they can be so treated."
225 (let ((types image-type-header-regexps) 236 (let ((types image-type-header-regexps)
226 type 237 type
227 (opoint (point))) 238 (opoint (point)))
228 (goto-char (point-min)) 239 (goto-char (point-min))
229 (while types 240 (while types
230 (let ((regexp (car (car types))) 241 (let ((regexp (car (car types)))
231 (image-type (cdr (car types))) 242 (image-type (nth 1 (car types)))
243 (not-always (nth 2 (car types)))
232 data) 244 data)
233 (if (or (and (symbolp image-type) 245 (if (or (and (symbolp image-type)
234 (looking-at regexp)) 246 (looking-at regexp))
235 (and (consp image-type) 247 (and (consp image-type)
236 (funcall (car image-type) 248 (funcall (car image-type)
239 (buffer-substring 251 (buffer-substring
240 (point-min) 252 (point-min)
241 (min (point-max) 253 (min (point-max)
242 (+ (point-min) 256)))))) 254 (+ (point-min) 256))))))
243 (setq image-type (cdr image-type)))) 255 (setq image-type (cdr image-type))))
244 (setq type image-type 256 ;; If this entry says "not always",
257 ;; treat it as nil, unless INCLUDE-MAYBES is t.
258 (setq type (if (or include-maybes (not not-always))
259 image-type)
245 types nil) 260 types nil)
246 (setq types (cdr types))))) 261 (setq types (cdr types)))))
247 (goto-char opoint) 262 (goto-char opoint)
248 type)) 263 type))
249 264
259 (and file 274 (and file
260 (file-readable-p file) 275 (file-readable-p file)
261 (with-temp-buffer 276 (with-temp-buffer
262 (set-buffer-multibyte nil) 277 (set-buffer-multibyte nil)
263 (insert-file-contents-literally file nil 0 256) 278 (insert-file-contents-literally file nil 0 256)
264 (image-type-from-buffer)))) 279 (image-type-from-buffer t))))
265 280
266 281
267 ;;;###autoload 282 ;;;###autoload
268 (defun image-type-from-file-name (file) 283 (defun image-type-from-file-name (file)
269 "Determine the type of image file FILE from its name. 284 "Determine the type of image file FILE from its name.