diff lisp/image.el @ 66296:941b6508462f

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

--- a/lisp/image.el	Fri Oct 21 23:41:52 2005 +0000
+++ b/lisp/image.el	Fri Oct 21 23:42:21 2005 +0000
@@ -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 @@
 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 @@
   "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 @@
   "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 @@
   (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 @@
 	  (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 @@
 	     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)))))