X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fwid-edit.el;h=64a3979bb5ba517ba20a0ceccd865d872b4f1e40;hb=fd3b637227a2cc7bce0abebc2f314ffd2398b18c;hp=d0cd014c643c31bb693dd9dcb20d2d20b32edaf5;hpb=35adcaaeafb1fe93eaf00c39b48619e8f188ff3f;p=chise%2Fxemacs-chise.git-

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index d0cd014..64a3979 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
 ;; Keywords: extensions
 ;; Version: 1.9960-x
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
@@ -49,7 +49,7 @@
   :group 'hypermedia)
 
 (defgroup widget-documentation nil
-  "Options controling the display of documentation strings."
+  "Options controlling the display of documentation strings."
   :group 'widgets)
 
 (defgroup widget-faces nil
@@ -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])))
@@ -1898,9 +1898,6 @@ If END is omitted, it defaults to the length of LIST."
   :group 'widgets
   :type 'boolean)
 
-;; Cache already created GUI objects.
-(defvar widget-push-button-cache nil)
-
 (defcustom widget-push-button-prefix "["
   "String used as prefix for buttons."
   :type 'string
@@ -1925,7 +1922,7 @@ If END is omitted, it defaults to the length of LIST."
 	 (tag-glyph (widget-get widget :tag-glyph))
 	 (text (concat widget-push-button-prefix
 		       tag widget-push-button-suffix))
-	 (gui-glyphs (lax-plist-get widget-push-button-cache tag)))
+	 gui)
     (cond (tag-glyph
 	   (widget-glyph-insert widget text tag-glyph))
 	  ;; We must check for console-on-window-system-p here,
@@ -1933,18 +1930,10 @@ If END is omitted, it defaults to the length of LIST."
 	  ;; components for colors, and they are not known on TTYs).
 	  ((and widget-push-button-gui
 		(console-on-window-system-p))
-	   (unless gui-glyphs
-	     (let* ((gui-button-shadow-thickness 1)
-		    (gui (make-gui-button tag 'widget-gui-action widget)))
-	       (setq
-		gui-glyphs
-		(list
-		 (make-glyph `(,(nth 0 (aref gui 1)) [string :data ,text]))
-		 (make-glyph `(,(nth 1 (aref gui 1)) [string :data ,text]))
-		 (make-glyph `(,(nth 2 (aref gui 1)) [string :data ,text]))))
-	       (laxputf widget-push-button-cache tag gui-glyphs)))
-	   (widget-glyph-insert-glyph
-	    widget (nth 0 gui-glyphs) (nth 1 gui-glyphs) (nth 2 gui-glyphs)))
+	   (let* ((gui-button-shadow-thickness 1))
+	     (setq gui (make-glyph 
+			(make-gui-button tag 'widget-gui-action widget))))
+	   (widget-glyph-insert-glyph widget gui))
 	  (t
 	   (insert text)))))