(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.

2 files changed, 62 insertions, 34 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f38b7da5806..032ede03339 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2000-01-01  Gerd Moellmann  <gerd@gnu.org>
+
+        * image.el (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.
+
 1999-12-31  Richard M. Stallman  <rms@caffeine.ai.mit.edu>
 
         * echistory.el (electric-command-history): Call Command-history-setup
diff --git a/lisp/image.el b/lisp/image.el
index 9b28d4f2eb2..81ca8cfc4a9 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -39,28 +39,36 @@ be of image type IMAGE-TYPE.")
 
 
 ;;;###autoload
-(defun image-type-from-file-header (file)
-  "Determine the type of image file FILE from its first few bytes.
-Value is a symbol specifying the image type, or nil if type cannot
+(defun image-type-from-data (data)
+  "Determine the image type from image data DATA.
+Value is a symbol specifying the image type or nil if type cannot
 be determined."
-  (unless (file-name-directory file)
-    (setq file (concat data-directory file)))
-  (setq file (expand-file-name file))
-  (let ((header (with-temp-buffer
-                  (insert-file-contents-literally file nil 0 256)
-                  (buffer-string)))
-        (types image-type-regexps)
+  (let ((types image-type-regexps)
         type)
     (while (and types (null type))
       (let ((regexp (car (car types)))
             (image-type (cdr (car types))))
-        (when (string-match regexp header)
+        (when (string-match regexp data)
           (setq type image-type))
         (setq types (cdr types))))
     type))
 
 
 ;;;###autoload
+(defun image-type-from-file-header (file)
+  "Determine the type of image file FILE from its first few bytes.
+Value is a symbol specifying the image type, or nil if type cannot
+be determined."
+  (unless (file-name-directory file)
+    (setq file (expand-file-name file data-directory)))
+  (setq file (expand-file-name file))
+  (let ((header (with-temp-buffer
+                  (insert-file-contents-literally file nil 0 256)
+                  (buffer-string))))
+    (image-type-from-data header)))
+
+
+;;;###autoload
 (defun image-type-available-p (type)
   "Value is non-nil if image type TYPE is available.
 Image types are symbols like `xbm' or `jpeg'."
@@ -68,26 +76,38 @@ Image types are symbols like `xbm' or `jpeg'."
 
 
 ;;;###autoload
-(defun create-image (file &optional type &rest props)
-  "Create an image which will be loaded from FILE.
+(defun create-image (file-or-data &optional type data-p &rest props)
+  "Create an image.
+FILE-OR-DATA is an image file name or image data.
 Optional TYPE is a symbol describing the image type.  If TYPE is omitted
-or nil, try to determine the image file type from its first few bytes.
-If that doesn't work, use FILE's extension as image type.
+or nil, try to determine the image type from its first few bytes
+of image data.  If that doesn't work, and FILE-OR-DATA is a file name,
+use its file extension.as image type.
+Optional DATA-P non-nil means FILE-OR-DATA is a string containing image data.
 Optional PROPS are additional image attributes to assign to the image,
 like, e.g. `:heuristic-mask t'.
 Value is the image created, or nil if images of type TYPE are not supported."
-  (unless (stringp file)
-    (error "Invalid image file name %s" file))
-  (unless (or type
-              (setq type (image-type-from-file-header file)))
-    (let ((extension (file-name-extension file)))
-      (unless extension
-        (error "Cannot determine image type"))
-      (setq type (intern extension))))
+  (unless (stringp file-or-data)
+    (error "Invalid image file name or data `%s'" file-or-data))
+  (cond ((null data-p)
+         ;; FILE-OR-DATA is a file name.
+         (unless (or type
+                     (setq type (image-type-from-file-header file-or-data)))
+           (let ((extension (file-name-extension file-or-data)))
+             (unless extension
+               (error "Cannot determine image type"))
+             (setq type (intern extension)))))
+        (t
+         ;; FILE-OR-DATA contains image data.
+         (unless type
+           (setq type (image-type-from-data file-or-data)))))
+  (unless type
+    (error "Cannot determine image type"))
   (unless (symbolp type)
-    (error "Invalid image type %s" type))
+    (error "Invalid image type `%s'" type))
   (when (image-type-available-p type)
-    (append (list 'image :type type :file file) props)))
+    (append (list 'image :type type (if data-p :data :file) file-or-data)
+            props)))
 
 
 ;;;###autoload
@@ -178,17 +198,17 @@ Example:
   (let (image)
     (while (and specs (null image))
       (let* ((spec (car specs))
-             (data (plist-get spec :data))
              (type (plist-get spec :type))
+             (data (plist-get spec :data))
              (file (plist-get spec :file)))
-        (when (and (image-type-available-p type) ; Image type is supported
-                   (or data (stringp file))) ; Data or file was specified
-          (if data
-              (setq image (cons 'image spec))
-            (setq file (expand-file-name file data-directory))
-            (when (file-readable-p file)
-              (setq image (cons 'image (plist-put spec :file file)))))
-          (setq specs (cdr specs)))))
+        (when (image-type-available-p type)
+          (cond ((stringp file)
+                 (setq file (expand-file-name file data-directory))
+                 (when (file-readable-p file)
+                   (setq image (cons 'image (plist-put spec :file file)))))
+                ((stringp data)
+                 (setq image (cons 'image spec)))))
+        (setq specs (cdr specs))))
     `(defvar ,symbol ',image ,doc)))