(image-type-header-regexps): Rename from image-type-regexps.

Change uses.
(image-type-file-name-regexps): New defconst.
(image-type-from-data): Simplify loop.
(image-type-from-buffer): New defun.
(image-type-from-file-header): Use it instead of image-type-from-data.
Use image-search-load-path instead of only looking in data-directory.
(image-type-from-file-name): New defun.
(image-search-load-path): Make PATH arg optional, default to image-load-path.
Change `pathname' to `filename'.

diff --git a/lisp/image.el b/lisp/image.el
index f833cc7e18f2b56f6b491b6e1740cff3cfaee43b..72e6ee8e633abb1b404319ee65912db2d4e08595 100644 (file)
--- 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)))))