Mercurial > emacs

changeset 18451:8eb08560287b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Synched with 1.9936.
author Per Abrahamsen <abraham@dina.kvl.dk>
date Wed, 25 Jun 1997 15:30:27 +0000
parents 327eba076416
children 44e598b69b42
files lisp/cus-edit.el lisp/wid-edit.el
diffstat 2 files changed, 222 insertions(+), 131 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/cus-edit.el	Wed Jun 25 07:27:44 1997 +0000
+++ b/lisp/cus-edit.el	Wed Jun 25 15:30:27 1997 +0000
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: help, faces
-;; Version: 1.9929
+;; Version: 1.9936
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -255,13 +255,18 @@
   :group 'customize
   :group 'faces)
 
+(defgroup custom-browse nil
+  "Control customize browser."
+  :prefix "custom-"
+  :group 'customize)
+
 (defgroup custom-buffer nil
-  "Control the customize buffers."
+  "Control customize buffers."
   :prefix "custom-"
   :group 'customize)
 
 (defgroup custom-menu nil
-  "Control how the customize menus."
+  "Control customize menus."
   :prefix "custom-"
   :group 'customize)
 
@@ -549,53 +554,74 @@
 
 ;;; Sorting.
 
+(defcustom custom-browse-sort-alphabetically nil
+  "If non-nil, sort members of each customization group alphabetically."
+  :type 'boolean
+  :group 'custom-browse)
+
+(defcustom custom-browse-order-groups nil
+  "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+  :type '(choice (const first)
+		 (const last)
+		 (const :tag "none" nil))
+  :group 'custom-browse)
+
 (defcustom custom-buffer-sort-alphabetically nil
-  "If non-nil, sort the members of each customization group alphabetically."
+  "If non-nil, sort members of each customization group alphabetically."
   :type 'boolean
   :group 'custom-buffer)
 
-(defcustom custom-buffer-groups-last nil
-  "If non-nil, put subgroups after all ordinary options within a group."
-  :type 'boolean
+(defcustom custom-buffer-order-groups 'last
+  "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+  :type '(choice (const first)
+		 (const last)
+		 (const :tag "none" nil))
   :group 'custom-buffer)
 
 (defcustom custom-menu-sort-alphabetically nil
-  "If non-nil, sort the members of each customization group alphabetically."
-  :type 'boolean
-  :group 'custom-menu)
-
-(defcustom custom-menu-groups-first t
-  "If non-nil, put subgroups before all ordinary options within a group."
+  "If non-nil, sort members of each customization group alphabetically."
   :type 'boolean
   :group 'custom-menu)
 
-(defun custom-buffer-sort-predicate (a b)
-  "Return t iff A should come before B in a customization buffer.
-A and B should be members of a `custom-group' property."
-  (cond ((and (not custom-buffer-groups-last)
-	      (not custom-buffer-sort-alphabetically))
-	 nil)
-	((or (eq (eq (nth 1 a) 'custom-group) (eq (nth 1 b) 'custom-group))
-	     (not custom-buffer-groups-last))
-	 (if custom-buffer-sort-alphabetically
-	     (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b)))
-	   nil))
-	(t
-	 (not (eq (nth 1 a) 'custom-group) ))))
+(defcustom custom-menu-order-groups 'first
+  "If non-nil, order group members within each customization group.
+If `first', order groups before non-groups.
+If `last', order groups after non-groups."
+  :type '(choice (const first)
+		 (const last)
+		 (const :tag "none" nil))
+  :group 'custom-menu)
 
-(defun custom-menu-sort-predicate (a b)
-  "Return t iff A should come before B in a customization menu.
-A and B should be members of a `custom-group' property."
-  (cond ((and (not custom-menu-groups-first)
-	      (not custom-menu-sort-alphabetically))
-	 nil)
-	((or (eq (eq (nth 1 a) 'custom-group) (eq (nth 1 b) 'custom-group))
-	     (not custom-menu-groups-first))
-	 (if custom-menu-sort-alphabetically
-	     (string-lessp (symbol-name (nth 0 a)) (symbol-name (nth 0 b)))
-	   nil))
-	(t
-	 (eq (nth 1 a) 'custom-group) )))
+(defun custom-sort-items (items sort-alphabetically order-groups)
+  "Return a sorted copy of ITEMS.
+ITEMS should be a `custom-group' property.
+If SORT-ALPHABETICALLY non-nil, sort alphabetically.
+If ORDER-GROUPS is `first' order groups before non-groups, if `last' order
+groups after non-groups, if nil do not order groups at all."
+  (sort (copy-sequence items)
+   (lambda (a b)
+     (let ((typea (nth 1 a)) (typeb (nth 1 b))
+	   (namea (symbol-name (nth 0 a))) (nameb (symbol-name (nth 0 b))))
+       (cond ((not order-groups)
+	      ;; Since we don't care about A and B order, maybe sort.
+	      (when sort-alphabetically
+		(string-lessp namea nameb)))
+	     ((eq typea 'custom-group)
+	      ;; If B is also a group, maybe sort.  Otherwise, order A and B.
+	      (if (eq typeb 'custom-group)
+		  (when sort-alphabetically
+		    (string-lessp namea nameb))
+		(eq order-groups 'first)))
+	     ((eq typeb 'custom-group)
+	      ;; Since A cannot be a group, order A and B.
+	      (eq order-groups 'last))
+	     (sort-alphabetically
+	      ;; Since A and B cannot be groups, sort.
+	      (string-lessp namea nameb)))))))
 
 ;;; Custom Mode Commands.
 
@@ -813,17 +839,14 @@
   (interactive (list (completing-read "Customize face: (default all) " 
 				      obarray 'custom-facep)))
   (if (or (null symbol) (and (stringp symbol) (zerop (length symbol))))
-      (let ((found nil))
-	(message "Looking for faces...")
-	(mapcar (lambda (symbol)
-		  (push (list symbol 'custom-face) found))
-		(nreverse (mapcar 'intern
-				  (sort (mapcar 'symbol-name (face-list))
-					'string-lessp))))
-			
-	(custom-buffer-create found "*Customize Faces*"))
-    (if (stringp symbol)
-	(setq symbol (intern symbol)))
+      (custom-buffer-create (custom-sort-items
+			     (mapcar (lambda (symbol)
+				       (list symbol 'custom-face))
+				     (face-list))
+			     t nil)
+			    "*Customize Faces*")
+    (when (stringp symbol)
+      (setq symbol (intern symbol)))
     (unless (symbolp symbol)
       (error "Should be a symbol %S" symbol))
     (custom-buffer-create (list (list symbol 'custom-face))
@@ -857,9 +880,10 @@
 		(and (get symbol 'customized-value)
 		     (boundp symbol)
 		     (push (list symbol 'custom-variable) found))))
-    (if found 
-	(custom-buffer-create found "*Customize Customized*")
-      (error "No customized user options"))))
+    (if (not found)
+	(error "No customized user options")
+      (custom-buffer-create (custom-sort-items found t nil)
+			    "*Customize Customized*"))))
 
 ;;;###autoload
 (defun customize-saved ()
@@ -873,9 +897,10 @@
 		(and (get symbol 'saved-value)
 		     (boundp symbol)
 		     (push (list symbol 'custom-variable) found))))
-    (if found 
-	(custom-buffer-create found "*Customize Saved*")
-      (error "No saved user options"))))
+    (if (not found )
+	(error "No saved user options")
+      (custom-buffer-create (custom-sort-items found t nil)
+			    "*Customize Saved*"))))
 
 ;;;###autoload
 (defun customize-apropos (regexp &optional all)
@@ -905,9 +930,9 @@
 		    (push (list symbol 'custom-variable) found)))))
     (if (not found)
 	(error "No matches")
-      (let ((custom-buffer-sort-alphabetically t))
-	(custom-buffer-create (sort found 'custom-buffer-sort-predicate)
-			      "*Customize Apropos*")))))
+      (custom-buffer-create (custom-sort-items found t
+					       custom-buffer-order-groups)
+			    "*Customize Apropos*"))))
 
 ;;;###autoload
 (defun customize-apropos-options (regexp &optional arg)
@@ -1073,9 +1098,19 @@
 ;;; The Tree Browser.
 
 ;;;###autoload
-(defun customize-browse ()
+(defun customize-browse (group)
   "Create a tree browser for the customize hierarchy."
-  (interactive)
+  (interactive (list (let ((completion-ignore-case t))
+		       (completing-read "Customize group: (default emacs) "
+					obarray 
+					(lambda (symbol)
+					  (get symbol 'custom-group))
+					t))))
+
+  (when (stringp group)
+    (if (string-equal "" group)
+	(setq group 'emacs)
+      (setq group (intern group))))
   (let ((name "*Customize Browser*"))
     (kill-buffer (get-buffer-create name))
     (switch-to-buffer (get-buffer-create name)))
@@ -1088,15 +1123,13 @@
     (widget-create 'custom-group 
 		   :custom-last t
 		   :custom-state 'unknown
-		   :tag (custom-unlispify-tag-name 'emacs)
-		   :value 'emacs))
+		   :tag (custom-unlispify-tag-name group)
+		   :value group))
   (goto-char (point-min)))
 
 (define-widget 'custom-tree-visibility 'item
   "Control visibility of of items in the customize tree browser."
-  :button-prefix "["
-  :button-suffix "]"
-  :format "%[%t%]"
+  :format "%[[%t]%]"
   :action 'custom-tree-visibility-action)
 
 (defun custom-tree-visibility-action (widget &rest ignore)
@@ -1106,6 +1139,7 @@
 (define-widget 'custom-tree-group-tag 'push-button
   "Show parent in other window when activated."
   :tag "Group"
+  :tag-glyph "folder"
   :action 'custom-tree-group-tag-action)
 
 (defun custom-tree-group-tag-action (widget &rest ignore)
@@ -1115,6 +1149,7 @@
 (define-widget 'custom-tree-variable-tag 'push-button
   "Show parent in other window when activated."
   :tag "Option"
+  :tag-glyph "option"
   :action 'custom-tree-variable-tag-action)
 
 (defun custom-tree-variable-tag-action (widget &rest ignore)
@@ -1124,12 +1159,34 @@
 (define-widget 'custom-tree-face-tag 'push-button
   "Show parent in other window when activated."
   :tag "Face"
+  :tag-glyph "face"
   :action 'custom-tree-face-tag-action)
 
 (defun custom-tree-face-tag-action (widget &rest ignore)
   (let ((parent (widget-get widget :parent)))
     (customize-face-other-window (widget-value parent))))
 
+(defconst custom-tree-alist '(("   " "space")
+			      (" | " "vertical")
+			      ("-\\ " "top")
+			      (" |-" "middle")
+			      (" `-" "bottom")))
+
+(defun custom-tree-insert-prefix (prefix)
+  "Insert PREFIX.  On XEmacs convert it to line graphics."
+  (if nil ; (string-match "XEmacs" emacs-version)
+      (progn 
+	(insert "*")
+	(while (not (string-equal prefix ""))
+	  (let ((entry (substring prefix 0 3)))
+	    (setq prefix (substring prefix 3))
+	    (let ((overlay (make-overlay (1- (point)) (point) nil t nil))
+		  (name (nth 1 (assoc entry custom-tree-alist))))
+	      (overlay-put overlay 'end-glyph (widget-glyph-find name entry))
+	      (overlay-put overlay 'start-open t)
+	      (overlay-put overlay 'end-open t)))))
+    (insert prefix)))
+
 ;;; Modification of Basic Widgets.
 ;;
 ;; We add extra properties to the basic widgets needed here.  This is
@@ -1564,16 +1621,15 @@
 	found)
     (insert (or initial-string "Parent groups:"))
     (mapatoms (lambda (symbol)
-		(let ((group (get symbol 'custom-group)))
-		  (when (assq name group)
-		    (when (eq type (nth 1 (assq name group)))
-		      (insert " ")
-		      (push (widget-create-child-and-convert 
-			     widget 'custom-group-link 
-			     :tag (custom-unlispify-tag-name symbol)
-			     symbol)
-			    buttons)
-		      (setq found t))))))
+		(let ((entry (assq name (get symbol 'custom-group))))
+		  (when (eq (nth 1 entry) type)
+		    (insert " ")
+		    (push (widget-create-child-and-convert 
+			   widget 'custom-group-link 
+			   :tag (custom-unlispify-tag-name symbol)
+			   symbol)
+			  buttons)
+		    (setq found t)))))
     (widget-put widget :buttons buttons)
     (if found
 	(insert "\n")
@@ -1659,7 +1715,7 @@
 	(setq form 'lisp)))
     ;; Now we can create the child widget.
     (cond ((eq custom-buffer-style 'tree)
-	   (insert prefix (if last " +--- " " |--- "))
+	   (insert prefix (if last " `--- " " |--- "))
 	   (push (widget-create-child-and-convert
 		  widget 'custom-tree-variable-tag)
 		 buttons)
@@ -2093,7 +2149,7 @@
     (unless tag
       (setq tag (prin1-to-string symbol)))
     (cond ((eq custom-buffer-style 'tree)
-	   (insert prefix (if is-last " +--- " " |--- "))
+	   (insert prefix (if is-last " `--- " " |--- "))
 	   (push (widget-create-child-and-convert
 		  widget 'custom-tree-face-tag)
 		 buttons)
@@ -2449,11 +2505,14 @@
 	(symbol (widget-value widget)))
     (cond ((and (eq custom-buffer-style 'tree)
 		(eq state 'hidden))
-	   (insert prefix)
+	   (custom-tree-insert-prefix prefix)
 	   (push (widget-create-child-and-convert
-		  widget 'custom-tree-visibility :tag "+")
+		  widget 'custom-tree-visibility 
+		  ;; :tag-glyph "plus"
+		  :tag "+")
 		 buttons)
 	   (insert "-- ")
+	   ;; (widget-glyph-insert nil "-- " "horizontal")
 	   (push (widget-create-child-and-convert
 		  widget 'custom-tree-group-tag)
 		 buttons)
@@ -2461,34 +2520,45 @@
 	   (widget-put widget :buttons buttons))
 	  ((and (eq custom-buffer-style 'tree)
 		(zerop (length (get symbol 'custom-group))))
-	   (insert prefix "[ ]-- ")
+	   (custom-tree-insert-prefix prefix)
+	   (insert "[ ]-- ")
+	   ;; (widget-glyph-insert nil "[ ]" "empty")
+	   ;; (widget-glyph-insert nil "-- " "horizontal")
 	   (push (widget-create-child-and-convert 
 		  widget 'custom-tree-group-tag)
 		 buttons)
 	   (insert " " tag "\n")
 	   (widget-put widget :buttons buttons))
 	  ((eq custom-buffer-style 'tree)
-	   (insert prefix)
+	   (custom-tree-insert-prefix prefix)
 	   (custom-load-widget widget)
 	   (if (zerop (length (get symbol 'custom-group)))
 	       (progn 
-		 (insert prefix "[ ]-- ")
+		 (custom-tree-insert-prefix prefix)
+		 (insert "[ ]-- ")
+		 ;; (widget-glyph-insert nil "[ ]" "empty")
+		 ;; (widget-glyph-insert nil "-- " "horizontal")
 		 (push (widget-create-child-and-convert 
 			widget 'custom-tree-group-tag)
 		       buttons)
 		 (insert " " tag "\n")
 		 (widget-put widget :buttons buttons))
 	     (push (widget-create-child-and-convert 
-		    widget 'custom-tree-visibility :tag "-")
+		    widget 'custom-tree-visibility 
+		    ;; :tag-glyph "minus"
+		    :tag "-")
 		   buttons)
-	     (insert "-+ ")
+	     (insert "-\\ ")
+	     ;; (widget-glyph-insert nil "-\\ " "top")
 	     (push (widget-create-child-and-convert 
 		    widget 'custom-tree-group-tag)
 		   buttons)
 	     (insert " " tag "\n")
 	     (widget-put widget :buttons buttons)
 	     (message "Creating group...")
-	     (let* ((members (copy-sequence (get symbol 'custom-group)))
+	     (let* ((members (custom-sort-items (get symbol 'custom-group)
+			      custom-browse-sort-alphabetically
+			      custom-browse-order-groups))
 		    (prefixes (widget-get widget :custom-prefixes))
 		    (custom-prefix-list (custom-prefix-add symbol prefixes))
 		    (length (length members))
@@ -2605,8 +2675,9 @@
 	   ;; Members.
 	   (message "Creating group...")
 	   (custom-load-widget widget)
-	   (let* ((members (sort (copy-sequence (get symbol 'custom-group))
-				 'custom-buffer-sort-predicate))
+	   (let* ((members (custom-sort-items (get symbol 'custom-group)
+					      custom-buffer-sort-alphabetically
+					      custom-buffer-order-groups))
 		  (prefixes (widget-get widget :custom-prefixes))
 		  (custom-prefix-list (custom-prefix-add symbol prefixes))
 		  (length (length members))
@@ -2871,6 +2942,7 @@
   (defconst custom-help-menu
     '("Customize"
       ["Update menu..." Custom-menu-update t]
+      ["Browse..." (customize-browse 'emacs) t]
       ["Group..." customize-group t]
       ["Variable..." customize-variable t]
       ["Face..." customize-face t]
@@ -2960,8 +3032,9 @@
 	     (< (length (get symbol 'custom-group)) widget-menu-max-size))
 	(let ((custom-prefix-list (custom-prefix-add symbol
 						     custom-prefix-list))
-	      (members (sort (copy-sequence (get symbol 'custom-group))
-			     'custom-menu-sort-predicate)))
+	      (members (custom-sort-items (get symbol 'custom-group)
+					  custom-menu-sort-alphabetically
+					  custom-menu-order-groups)))
 	  (custom-load-symbol symbol)
 	  `(,(custom-unlispify-menu-entry symbol t)
 	    ,item
--- a/lisp/wid-edit.el	Wed Jun 25 07:27:44 1997 +0000
+++ b/lisp/wid-edit.el	Wed Jun 25 15:30:27 1997 +0000
@@ -4,7 +4,7 @@
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
 ;; Keywords: extensions
-;; Version: 1.9929
+;; Version: 1.9936
 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
 
 ;; This file is part of GNU Emacs.
@@ -335,6 +335,17 @@
   :type 'boolean
   :group 'widgets)
 
+(defcustom widget-field-use-before-change
+  (or (> emacs-minor-version 34)
+      (> emacs-major-version 20)
+      (string-match "XEmacs" emacs-version))
+  "Non-nil means use `before-change-functions' to track editable fields.
+This enables the use of undo, but doesn'f work on Emacs 19.34 and earlier. 
+Using before hooks also means that the :notify function can't know the
+new value."
+  :type 'boolean
+  :group 'widgets)
+
 (defun widget-specify-field (widget from to)
   "Specify editable button for WIDGET between FROM and TO."
   (put-text-property from to 'read-only nil)
@@ -691,14 +702,15 @@
   "In WIDGET, insert GLYPH.
 If optional arguments DOWN and INACTIVE are given, they should be
 glyphs used when the widget is pushed and inactive, respectively."
-  (set-glyph-property glyph 'widget widget)
-  (when down
-    (set-glyph-property down 'widget widget))
-  (when inactive
-    (set-glyph-property inactive 'widget widget))
+  (when widget
+    (set-glyph-property glyph 'widget widget)
+    (when down
+      (set-glyph-property down 'widget widget))
+    (when inactive
+      (set-glyph-property inactive 'widget widget)))
   (insert "*")
   (let ((ext (make-extent (point) (1- (point))))
-	(help-echo (widget-get widget :help-echo)))
+	(help-echo (and widget (widget-get widget :help-echo))))
     (set-extent-property ext 'invisible t)
     (set-extent-property ext 'start-open t)
     (set-extent-property ext 'end-open t)
@@ -706,9 +718,10 @@
     (when help-echo
       (set-extent-property ext 'balloon-help help-echo)
       (set-extent-property ext 'help-echo help-echo)))
-  (widget-put widget :glyph-up glyph)
-  (when down (widget-put widget :glyph-down down))
-  (when inactive (widget-put widget :glyph-inactive inactive)))
+  (when widget
+    (widget-put widget :glyph-up glyph)
+    (when down (widget-put widget :glyph-down down))
+    (when inactive (widget-put widget :glyph-inactive inactive))))
 
 ;;; Buttons.
 
@@ -979,24 +992,25 @@
 			 (widget-apply-action button event)))
 		   (overlay-put overlay 'face face)
 		   (overlay-put overlay 'mouse-face mouse-face)))
-	     (let (command up)
+	     (let ((up t)
+		   command)
 	       ;; Find the global command to run, and check whether it
 	       ;; is bound to an up event.
 	       (cond ((setq command	;down event
-			    (lookup-key widget-global-map [ button2 ])))
+			    (lookup-key widget-global-map [ button2 ]))
+		      (setq up nil))
 		     ((setq command	;down event
-			    (lookup-key widget-global-map [ down-mouse-2 ])))
-		     ((setq command	;up event
-			    (lookup-key widget-global-map [ button2up ]))
-		      (setq up t))
+			    (lookup-key widget-global-map [ down-mouse-2 ]))
+		      (setq up nil))
 		     ((setq command	;up event
-			    (lookup-key widget-global-map [ mouse-2]))
-		      (setq up t)))
-	       (when command
+			    (lookup-key widget-global-map [ button2up ])))
+		     ((setq command	;up event
+			    (lookup-key widget-global-map [ mouse-2]))))
+	       (when up
 		 ;; Don't execute up events twice.
-		 (when up
-		   (while (not (button-release-event-p event))
-		     (setq event (widget-read-event))))
+		 (while (not (button-release-event-p event))
+		   (setq event (widget-read-event))))
+	       (when command
 		 (call-interactively command))))))
 	(t
 	 (message "You clicked somewhere weird."))))
@@ -1188,11 +1202,12 @@
   (widget-clear-undo)
   ;; We need to maintain text properties and size of the editing fields.
   (make-local-variable 'after-change-functions)
-  (make-local-variable 'before-change-functions)
   (setq after-change-functions
 	(if widget-field-list '(widget-after-change) nil))
-  (setq before-change-functions
-	(if widget-field-list '(widget-before-change) nil)))
+  (when widget-field-use-before-change
+    (make-local-variable 'before-change-functions)
+    (setq before-change-functions
+	  (if widget-field-list '(widget-before-change) nil))))
 
 (defvar widget-field-last nil)
 ;; Last field containing point.
@@ -1665,30 +1680,33 @@
   ;; Insert text representing the `on' and `off' states.
   (let* ((tag (or (widget-get widget :tag)
 		  (widget-get widget :value)))
+	 (tag-glyph (widget-get widget :tag-glyph))
 	 (text (concat widget-push-button-prefix
 		       tag widget-push-button-suffix))
 	 (gui (cdr (assoc tag widget-push-button-cache))))
-    (if (and (fboundp 'make-gui-button)
+    (cond (tag-glyph
+	   (widget-glyph-insert widget text tag-glyph))
+	  ((and (fboundp 'make-gui-button)
 	     (fboundp 'make-glyph)
 	     widget-push-button-gui
 	     (fboundp 'device-on-window-system-p)
 	     (device-on-window-system-p)
 	     (string-match "XEmacs" emacs-version))
-	(progn 
-	  (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
-				     (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))))
+	   (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
+				      (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)))))
+	  (t
+	   (insert text)))))
 
 (defun widget-gui-action (widget)
   "Apply :action for WIDGET."