Mercurial > emacs

comparison lisp/image.el @ 27073:aad0a025b1e3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(defimage): Handle specifications containing :data instead of :file. (image-type-from-data): New function. (image-type-from-file-header): Use it. (create-image): Add parameter DATA-P.
author Gerd Moellmann <gerd@gnu.org>
date Sat, 01 Jan 2000 16:32:56 +0000
parents 6bb2a4a0413e
children 893ec72bd6b1
comparison
equal deleted inserted replaced
27072:54202e1e6d97 27073:aad0a025b1e3
37 When the first bytes of an image file match REGEXP, it is assumed to 37 When the first bytes of an image file match REGEXP, it is assumed to
38 be of image type IMAGE-TYPE.") 38 be of image type IMAGE-TYPE.")
39 39
40 40
41 ;;;###autoload 41 ;;;###autoload
42 (defun image-type-from-data (data)
43 "Determine the image type from image data DATA.
44 Value is a symbol specifying the image type or nil if type cannot
45 be determined."
46 (let ((types image-type-regexps)
47 type)
48 (while (and types (null type))
49 (let ((regexp (car (car types)))
50 (image-type (cdr (car types))))
51 (when (string-match regexp data)
52 (setq type image-type))
53 (setq types (cdr types))))
54 type))
55
56
57 ;;;###autoload
42 (defun image-type-from-file-header (file) 58 (defun image-type-from-file-header (file)
43 "Determine the type of image file FILE from its first few bytes. 59 "Determine the type of image file FILE from its first few bytes.
44 Value is a symbol specifying the image type, or nil if type cannot 60 Value is a symbol specifying the image type, or nil if type cannot
45 be determined." 61 be determined."
46 (unless (file-name-directory file) 62 (unless (file-name-directory file)
47 (setq file (concat data-directory file))) 63 (setq file (expand-file-name file data-directory)))
48 (setq file (expand-file-name file)) 64 (setq file (expand-file-name file))
49 (let ((header (with-temp-buffer 65 (let ((header (with-temp-buffer
50 (insert-file-contents-literally file nil 0 256) 66 (insert-file-contents-literally file nil 0 256)
51 (buffer-string))) 67 (buffer-string))))
52 (types image-type-regexps) 68 (image-type-from-data header)))
53 type)
54 (while (and types (null type))
55 (let ((regexp (car (car types)))
56 (image-type (cdr (car types))))
57 (when (string-match regexp header)
58 (setq type image-type))
59 (setq types (cdr types))))
60 type))
61 69
62 70
63 ;;;###autoload 71 ;;;###autoload
64 (defun image-type-available-p (type) 72 (defun image-type-available-p (type)
65 "Value is non-nil if image type TYPE is available. 73 "Value is non-nil if image type TYPE is available.
66 Image types are symbols like `xbm' or `jpeg'." 74 Image types are symbols like `xbm' or `jpeg'."
67 (not (null (memq type image-types)))) 75 (not (null (memq type image-types))))
68 76
69 77
70 ;;;###autoload 78 ;;;###autoload
71 (defun create-image (file &optional type &rest props) 79 (defun create-image (file-or-data &optional type data-p &rest props)
72 "Create an image which will be loaded from FILE. 80 "Create an image.
81 FILE-OR-DATA is an image file name or image data.
73 Optional TYPE is a symbol describing the image type. If TYPE is omitted 82 Optional TYPE is a symbol describing the image type. If TYPE is omitted
74 or nil, try to determine the image file type from its first few bytes. 83 or nil, try to determine the image type from its first few bytes
75 If that doesn't work, use FILE's extension as image type. 84 of image data. If that doesn't work, and FILE-OR-DATA is a file name,
85 use its file extension.as image type.
86 Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
76 Optional PROPS are additional image attributes to assign to the image, 87 Optional PROPS are additional image attributes to assign to the image,
77 like, e.g. `:heuristic-mask t'. 88 like, e.g. `:heuristic-mask t'.
78 Value is the image created, or nil if images of type TYPE are not supported." 89 Value is the image created, or nil if images of type TYPE are not supported."
79 (unless (stringp file) 90 (unless (stringp file-or-data)
80 (error "Invalid image file name %s" file)) 91 (error "Invalid image file name or data `%s'" file-or-data))
81 (unless (or type 92 (cond ((null data-p)
82 (setq type (image-type-from-file-header file))) 93 ;; FILE-OR-DATA is a file name.
83 (let ((extension (file-name-extension file))) 94 (unless (or type
84 (unless extension 95 (setq type (image-type-from-file-header file-or-data)))
85 (error "Cannot determine image type")) 96 (let ((extension (file-name-extension file-or-data)))
86 (setq type (intern extension)))) 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"))
87 (unless (symbolp type) 106 (unless (symbolp type)
88 (error "Invalid image type %s" type)) 107 (error "Invalid image type `%s'" type))
89 (when (image-type-available-p type) 108 (when (image-type-available-p type)
90 (append (list 'image :type type :file file) props))) 109 (append (list 'image :type type (if data-p :data :file) file-or-data)
110 props)))
91 111
92 112
93 ;;;###autoload 113 ;;;###autoload
94 (defun put-image (image pos string &optional area) 114 (defun put-image (image pos string &optional area)
95 "Put image IMAGE in front of POS in the current buffer. 115 "Put image IMAGE in front of POS in the current buffer.
176 (defimage test-image ((:type xpm :file \"~/test1.xpm\") 196 (defimage test-image ((:type xpm :file \"~/test1.xpm\")
177 (:type xbm :file \"~/test1.xbm\")))" 197 (:type xbm :file \"~/test1.xbm\")))"
178 (let (image) 198 (let (image)
179 (while (and specs (null image)) 199 (while (and specs (null image))
180 (let* ((spec (car specs)) 200 (let* ((spec (car specs))
201 (type (plist-get spec :type))
181 (data (plist-get spec :data)) 202 (data (plist-get spec :data))
182 (type (plist-get spec :type))
183 (file (plist-get spec :file))) 203 (file (plist-get spec :file)))
184 (when (and (image-type-available-p type) ; Image type is supported 204 (when (image-type-available-p type)
185 (or data (stringp file))) ; Data or file was specified 205 (cond ((stringp file)
186 (if data 206 (setq file (expand-file-name file data-directory))
187 (setq image (cons 'image spec)) 207 (when (file-readable-p file)
188 (setq file (expand-file-name file data-directory)) 208 (setq image (cons 'image (plist-put spec :file file)))))
189 (when (file-readable-p file) 209 ((stringp data)
190 (setq image (cons 'image (plist-put spec :file file))))) 210 (setq image (cons 'image spec)))))
191 (setq specs (cdr specs))))) 211 (setq specs (cdr specs))))
192 `(defvar ,symbol ',image ,doc))) 212 `(defvar ,symbol ',image ,doc)))
193 213
194 214
195 (provide 'image) 215 (provide 'image)
196 216