X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fwid-edit.el;h=b8eb8565883ab884d00d1e41911a5619bf3ff0e8;hb=afa9772e3fcbb4e80e3e4cfd1a40b4fccc6d08b8;hp=e7a5d964edf45e243d9e36925263778b05f6201a;hpb=fc475e6669a613cd6d98eb5511c749a23b63c7ac;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index e7a5d96..b8eb856 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
@@ -302,6 +302,7 @@ new value."
     (and (functionp help-echo)
 	 (setq help-echo (funcall help-echo widget)))
     (when (stringp help-echo)
+      (setq help-echo-owns-message t)
       (display-message 'help-echo help-echo))))
 
 (defsubst widget-handle-help-echo (extent help-echo)
@@ -533,7 +534,7 @@ Suitable for use with `map-extents'."
 	  widget-shadow-subrs)
   (defun widget-put (widget property value)
     "In WIDGET set PROPERTY to VALUE.
-The value can later be retrived with `widget-get'."
+The value can later be retrieved with `widget-get'."
     (setcdr widget (plist-put (cdr widget) property value))))
 
 ;; Recoded in C, for efficiency:
@@ -673,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."
@@ -722,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])))
@@ -1129,7 +1130,7 @@ Recommended as a parent keymap for modes using widgets.")
       (error "This widget is inactive"))
     (let ((current-glyph 'down))
       ;; We always know what glyph is drawn currently, to avoid
-      ;; unnecessary extent changes.  Is this any noticable gain?
+      ;; unnecessary extent changes.  Is this any noticeable gain?
       (unwind-protect
 	  (progn
 	    ;; Press the glyph.
@@ -1934,16 +1935,11 @@ If END is omitted, it defaults to the length of LIST."
 		(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]))))
+		    (gui (make-glyph 
+			  (make-gui-button tag 'widget-gui-action widget))))
+	       (setq gui-glyphs gui)
 	       (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)))
+	   (widget-glyph-insert-glyph widget gui-glyphs))
 	  (t
 	   (insert text)))))