1 files changed, 91 insertions, 26 deletions

diff --git a/lisp/image.el b/lisp/image.el
index f833cc7e18f..72e6ee8e633 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -33,7 +33,7 @@
   :group 'multimedia)
 
 
-(defconst image-type-regexps
+(defconst image-type-header-regexps
   '(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
     ("\\`P[1-6]" . pbm)
     ("\\`GIF8" . gif)
@@ -49,6 +49,21 @@ IMAGE-TYPE must be a pair (PREDICATE . TYPE).  PREDICATE is called
 with one argument, a string containing the image data.  If PREDICATE returns
 a non-nil value, TYPE is the image's type.")
 
+(defconst image-type-file-name-regexps
+  '(("\\.png\\'" . png)
+    ("\\.gif\\'" . gif)
+    ("\\.jpe?g\\'" . jpeg)
+    ("\\.bmp\\'" . bmp)
+    ("\\.xpm\\'" . xpm)
+    ("\\.pbm\\'" . pbm)
+    ("\\.xbm\\'" . xbm)
+    ("\\.ps\\'" . postscript)
+    ("\\.tiff?\\'" . tiff))
+  "Alist of (REGEXP . IMAGE-TYPE) pairs used to identify image files.
+When the name of an image file match REGEXP, it is assumed to
+be of image type IMAGE-TYPE.")
+
+
 (defvar image-load-path
   (list (file-name-as-directory (expand-file-name "images" data-directory))
         'data-directory 'load-path)
@@ -87,18 +102,50 @@ We accept the tag Exif because that is the same format."
   "Determine the image type from image data DATA.
 Value is a symbol specifying the image type or nil if type cannot
 be determined."
-  (let ((types image-type-regexps)
+  (let ((types image-type-header-regexps)
         type)
-    (while (and types (null type))
+    (while types
       (let ((regexp (car (car types)))
             (image-type (cdr (car types))))
-        (when (or (and (symbolp image-type)
-                       (string-match regexp data))
-                  (and (consp image-type)
-                       (funcall (car image-type) data)
-                       (setq image-type (cdr image-type))))
-          (setq type image-type))
-        (setq types (cdr types))))
+        (if (or (and (symbolp image-type)
+                     (string-match regexp data))
+                (and (consp image-type)
+                     (funcall (car image-type) data)
+                     (setq image-type (cdr image-type))))
+            (setq type image-type
+                  types nil)
+          (setq types (cdr types)))))
+    type))
+
+
+;;;###autoload
+(defun image-type-from-buffer ()
+  "Determine the image type from data in the current buffer.
+Value is a symbol specifying the image type or nil if type cannot
+be determined."
+  (let ((types image-type-header-regexps)
+        type
+        (opoint (point)))
+    (goto-char (point-min))
+    (while types
+      (let ((regexp (car (car types)))
+            (image-type (cdr (car types)))
+            data)
+        (if (or (and (symbolp image-type)
+                     (looking-at regexp))
+                (and (consp image-type)
+                     (funcall (car image-type)
+                              (or data
+                                  (setq data
+                                        (buffer-substring
+                                         (point-min)
+                                         (min (point-max)
+                                              (+ (point-min) 256))))))
+                     (setq image-type (cdr image-type))))
+            (setq type image-type
+                  types nil)
+          (setq types (cdr types)))))
+    (goto-char opoint)
     type))
 
 
@@ -107,14 +154,30 @@ be determined."
   "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
-                  (set-buffer-multibyte nil)
-                  (insert-file-contents-literally file nil 0 256)
-                  (buffer-string))))
-    (image-type-from-data header)))
+  (unless (or (file-readable-p file)
+              (file-name-absolute-p file))
+    (setq file (image-search-load-path file)))
+  (and file
+       (file-readable-p file)
+       (with-temp-buffer
+         (set-buffer-multibyte nil)
+         (insert-file-contents-literally file nil 0 256)
+         (image-type-from-buffer))))
+
+
+;;;###autoload
+(defun image-type-from-file-name (file)
+  "Determine the type of image file FILE from its name.
+Value is a symbol specifying the image type, or nil if type cannot
+be determined."
+  (let ((types image-type-file-name-regexps)
+        type)
+    (while types
+      (if (string-match (car (car types)) file)
+          (setq type (cdr (car types))
+                types nil)
+        (setq types (cdr types))))
+    type))
 
 
 ;;;###autoload
@@ -124,6 +187,7 @@ Image types are symbols like `xbm' or `jpeg'."
   (and (fboundp 'init-image-library)
        (init-image-library type image-library-alist)))
 
+
 ;;;###autoload
 (defun create-image (file-or-data &optional type data-p &rest props)
   "Create an image.
@@ -281,27 +345,29 @@ BUFFER nil or omitted means use the current buffer."
           (delete-overlay overlay)))
       (setq overlays (cdr overlays)))))
 
-(defun image-search-load-path (file path)
-  (let (element found pathname)
+(defun image-search-load-path (file &optional path)
+  (unless path
+    (setq path image-load-path))
+  (let (element found filename)
     (while (and (not found) (consp path))
       (setq element (car path))
       (cond
        ((stringp element)
         (setq found
               (file-readable-p
-               (setq pathname (expand-file-name file element)))))
+               (setq filename (expand-file-name file element)))))
        ((and (symbolp element) (boundp element))
         (setq element (symbol-value element))
         (cond
          ((stringp element)
           (setq found
                 (file-readable-p
-                 (setq pathname (expand-file-name file element)))))
+                 (setq filename (expand-file-name file element)))))
          ((consp element)
-          (if (setq pathname (image-search-load-path file element))
+          (if (setq filename (image-search-load-path file element))
               (setq found t))))))
       (setq path (cdr path)))
-    (if found pathname)))
+    (if found filename)))
 
 ;;;###autoload
 (defun find-image (specs)
@@ -331,8 +397,7 @@ Image files should not be larger than specified by `max-image-size'."
              found)
         (when (image-type-available-p type)
           (cond ((stringp file)
-                 (if (setq found (image-search-load-path
-                                  file image-load-path))
+                 (if (setq found (image-search-load-path file))
                      (setq image
                            (cons 'image (plist-put (copy-sequence spec)
                                                    :file found)))))