Mercurial > emacs
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. |