From xemacs-m  Fri May 23 18:39:13 1997
Received: from jagor.srce.hr (hniksic@jagor.srce.hr [161.53.2.130])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id SAA18728
	for <xemacs-beta@xemacs.org>; Fri, 23 May 1997 18:39:11 -0500 (CDT)
Received: (from hniksic@localhost)
          by jagor.srce.hr (8.8.5/8.8.4)
	  id BAA18764; Sat, 24 May 1997 01:39:11 +0200 (MET DST)
To: XEmacs Developers <xemacs-beta@xemacs.org>
Subject: Re: M-x customize doesn't work without TTY support
References: <kig206ytxa0.fsf@jagor.srce.hr> <QQcquc13702.199705231434@crystal.WonderWorks.COM> <kigzptmqjbl.fsf@jagor.srce.hr> <rjaflm54fy.fsf@zuse.dina.kvl.dk>
X-Save-Project-Gutenberg: <URL:http://www.promo.net/pg/nl/pgny_nov96.html>
X-Attribution: Hrv
X-Face: Mie8:rOV<\c/~z{s.X4A{!?vY7{drJ([U]0O=W/<W*SMo/Mv:58:*_y~ki>xDi&N7XG
        KV^$k0m3Oe/)'e%3=$PCR&3ITUXH,cK>]bci&<qQ>Ff%x_>1`T(+M2Gg/fgndU%k*ft
        [(7._6e0n-V%|%'[c|q:;}td$#INd+;?!-V=c8Pqf}3J
X-Tom-Swifty: "You light up my life," Tom said brightly.
From: Hrvoje Niksic <hniksic@srce.hr>
Date: 24 May 1997 01:39:11 +0200
In-Reply-To: Per Abrahamsen's message of 23 May 1997 22:17:05 +0200
Message-ID: <kigwwoprc68.fsf@jagor.srce.hr>
Lines: 159
X-Mailer: Gnus v5.4.52/XEmacs 20.2

Per Abrahamsen <abraham@dina.kvl.dk> writes:

> Hrvoje Niksic <hniksic@srce.hr> writes:
> 
> > Wow.  The way I'm going, maybe in a few years I'll even begin to
> > understand specifiers/glyphs/instances/instantiators.
> 
> Cool!  Will you send me a patch for wid-edit.el?

Sure; try this one.

Besides fixing `widget-glyph-insert-glyph' (the TAG now must be a part
of the glyph), it adds new functionality to `widget-glyph-insert' (I
didn't know how to test it thoroughly, but it should work), and fixes
`widget-push-button-value-create'.

I've also added the oh-shit fix for x-overlay.el.

--- wid-edit.el.orig	Fri May 23 10:15:06 1997
+++ wid-edit.el	Sat May 24 01:37:48 1997
@@ -542,7 +542,7 @@
 (defcustom widget-glyph-directory (concat data-directory "custom/")
   "Where widget glyphs are located.
 If this variable is nil, widget will try to locate the directory
-automatically. This does not work yet."
+automatically."
   :group 'widgets
   :type 'directory)
 
@@ -551,10 +551,21 @@
   :group 'widgets
   :type 'boolean)
 
+(defcustom widget-image-conversion
+  '((xpm ".xpm") (gif ".gif") (png ".png") (jpeg ".jpg" ".jpeg")
+    (xbm ".xbm"))
+  "Conversion alist from image formats to file name suffixes."
+  :group 'widgets
+  :type '(repeat (cons :format "%v"
+		       (symbol :tag "Image Format" unknown)
+		       (repeat :tag "Suffixes"
+			       (string :format "%v")))))
+
 (defun widget-glyph-insert (widget tag image)
   "In WIDGET, insert the text TAG or, if supported, IMAGE.
-IMAGE should either be a glyph, or a name sans extension of an xpm or
-xbm file located in `widget-glyph-directory'.
+IMAGE should either be a glyph, an image instantiator, or an image file
+name sans extension (xpm, xbm, gif, jpg, or png) located in
+`widget-glyph-directory'.
 
 WARNING: If you call this with a glyph, and you want the user to be
 able to activate the glyph, make sure it is unique.  If you use the
@@ -563,35 +574,51 @@
   (cond ((not (and (string-match "XEmacs" emacs-version)
 		   widget-glyph-enable
 		   (fboundp 'make-glyph)
+		   (fboundp 'locate-file)
 		   image))
 	 ;; We don't want or can't use glyphs.
 	 (insert tag))
 	((and (fboundp 'glyphp)
 	      (glyphp image))
 	 ;; Already a glyph.  Insert it.
-	 (widget-glyph-insert-glyph widget tag image))
+	 (widget-glyph-insert-glyph widget image))
+	((stringp image)
+	 ;; A string.  Look it up in relevant directories.
+	 (let* ((dirlist (list (or widget-glyph-directory
+				   (concat data-directory
+					   "custom/"))
+			       data-directory))
+		(formats widget-image-conversion)
+		file)
+	   (while (and formats (not file))
+	     (when (valid-image-instantiator-format-p (car (car formats)))
+	       (setq file (locate-file image dirlist
+				       (mapconcat 'identity (cdr (car formats))
+						  ":"))))
+	     (setq formats (cdr formats)))
+	   ;; We create a glyph with the file as the default image
+	   ;; instantiator, and the TAG fallback
+	   (widget-glyph-insert-glyph
+	    widget
+	    (make-glyph (if file
+			    (list (vector (car (car formats)) :file file)
+				  (vector 'string :data tag))
+			  (vector 'string :data tag))))))
+	((valid-instantiator-p image 'image)
+	 ;; A valid image instantiator (e.g. [gif :file "somefile"] etc.)
+	 (widget-glyph-insert-glyph widget
+				    (list image
+					  (vector 'string :data tag))))
 	(t
-	 ;; A string.  Look it up in.
-	 (let ((file (concat widget-glyph-directory 
-			    (if (string-match "/\\'" widget-glyph-directory)
-				""
-			      "/")
-			    image
-			    (if (featurep 'xpm) ".xpm" ".xbm"))))
-	   (if (file-readable-p file)
-	       (widget-glyph-insert-glyph widget tag (make-glyph file))
-	     ;; File not readable, give up.
-	     (insert tag))))))
+	 ;; Oh well.
+	 (insert tag))))
 
-(defun widget-glyph-insert-glyph (widget tag glyph &optional down inactive)
+(defun widget-glyph-insert-glyph (widget glyph &optional down inactive)
   "In WIDGET, with alternative text TAG, insert GLYPH."
-  (set-glyph-image glyph (cons 'tty tag))
   (set-glyph-property glyph 'widget widget)
   (when down
-    (set-glyph-image down (cons 'tty tag))
     (set-glyph-property down 'widget widget))
   (when inactive
-    (set-glyph-image inactive (cons 'tty tag))
     (set-glyph-property inactive 'widget widget))
   (insert "*")
   (add-text-properties (1- (point)) (point) 
@@ -1406,10 +1433,16 @@
 	  (unless gui
 	    (setq gui (make-gui-button tag 'widget-gui-action widget))
 	    (push (cons tag gui) widget-push-button-cache))
-	  (widget-glyph-insert-glyph widget text
-				     (make-glyph (nth 0 (aref gui 1)))
-				     (make-glyph (nth 1 (aref gui 1)))
-				     (make-glyph (nth 2 (aref gui 1)))))
+	  (widget-glyph-insert-glyph widget
+				     (make-glyph
+				      (list (nth 0 (aref gui 1))
+					    (vector 'string :data text)))
+				     (make-glyph
+				      (list (nth 1 (aref gui 1))
+					    (vector 'string :data text)))
+				     (make-glyph
+				      (list (nth 2 (aref gui 1))
+					    (vector 'string :data text)))))
       (insert text))))
 
 (defun widget-gui-action (widget)
--- x-overlay.el.orig	Sat May 24 00:54:50 1997
+++ x-overlay.el	Sat May 24 00:54:55 1997
@@ -177,7 +177,7 @@
 		(setq before (append before (list overlay)))
 	      (setq after (append after (list overlay)))))))
      (extent-list))
-    (list before after)))
+    (cons before after)))
 
 (defun overlay-recenter (pos)
   "Recenter the overlays of the current buffer around position POS."


-- 
Hrvoje Niksic <hniksic@srce.hr> | Student at FER Zagreb, Croatia
--------------------------------+--------------------------------
Oh lord won't you buy me a color TV...

