X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fwid-edit.el;h=c01d4573e28254f2faa1a73a337d6e5e37338620;hp=d0cd014c643c31bb693dd9dcb20d2d20b32edaf5;hb=976b002b16336930724ae22476014583ad022e7d;hpb=eb1f7fa6e0f89ff92b86f02c7cbdee048edd8b0d

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index d0cd014..c01d457 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -674,7 +674,7 @@ automatically."
   :group 'widgets
   :type 'boolean)
 
-(defcustom widget-image-conversion
+(defcustom widget-image-file-name-suffixes
   '((xpm ".xpm") (gif ".gif") (png ".png") (jpeg ".jpg" ".jpeg")
     (xbm ".xbm"))
   "Conversion alist from image formats to file name suffixes."
@@ -723,27 +723,27 @@ It can also be a valid image instantiator, in which case it will be
 	     (let* ((dirlist (cons (or widget-glyph-directory
 				       (locate-data-directory "custom"))
 				   data-directory-list))
-		    (formats widget-image-conversion)
-		    file)
-	       (while (and formats (not file))
-		 ;; This dance is necessary, because XEmacs signals an
-		 ;; error when it encounters an unrecognized image
-		 ;; format.
-		 (when (valid-image-instantiator-format-p (caar formats))
-		   (setq file (locate-file image dirlist
-					   (mapconcat #'identity (cdar formats)
-						      ":"))))
-		 (unless file
-		   (pop formats)))
+		    (all-suffixes
+		     (apply #'append
+			    (mapcar
+			     (lambda (el)
+			       (and (valid-image-instantiator-format-p (car el))
+				    (cdr el)))
+			     widget-image-file-name-suffixes)))
+		    (file (locate-file image dirlist all-suffixes)))
 	       (when file
-		 ;; We create a glyph with the file as the default image
-		 ;; instantiator, and the TAG fallback
-		 (let ((glyph (make-glyph `([,(caar formats) :file ,file]
-					    [string :data ,tag]))))
-		   ;; Cache the glyph
-		   (laxputf widget-glyph-cache image glyph)
-		   ;; ...and return it
-		   glyph)))))
+		 (let* ((extension (concat "." (file-name-extension file)))
+			(format (car (rassoc* extension
+					      widget-image-file-name-suffixes
+					      :test #'member))))
+		   ;; We create a glyph with the file as the default image
+		   ;; instantiator, and the TAG fallback
+		   (let ((glyph (make-glyph `([,format :file ,file]
+					      [string :data ,tag]))))
+		     ;; Cache the glyph
+		     (laxputf widget-glyph-cache image glyph)
+		     ;; ...and return it
+		     glyph))))))
 	((valid-instantiator-p image 'image)
 	 ;; A valid image instantiator (e.g. [gif :file "somefile"] etc.)
 	 (make-glyph `(,image [string :data ,tag])))