diff lisp/wid-edit.el @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children 41dbb7a9d5f2
line wrap: on
line diff
--- a/lisp/wid-edit.el	Mon Aug 13 11:19:22 2007 +0200
+++ b/lisp/wid-edit.el	Mon Aug 13 11:20:41 2007 +0200
@@ -1,9 +1,9 @@
 ;;; wid-edit.el --- Functions for creating and using widgets.
 ;;
-;; Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
 ;;
 ;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; Maintainer: Hrvoje Niksic <hniksic@xemacs.org>
+;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
 ;; 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 controlling the display of documentation strings."
+  "Options controling the display of documentation strings."
   :group 'widgets)
 
 (defgroup widget-faces nil
@@ -601,7 +601,7 @@
   ;; In WIDGET, match the start of VALS.
   (cond ((widget-get widget :inline)
 	 (widget-apply widget :match-inline vals))
-	((and (listp vals)
+	((and vals
 	      (widget-apply widget :match (car vals)))
 	 (cons (list (car vals)) (cdr vals)))
 	(t nil)))
@@ -1898,6 +1898,9 @@
   :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
@@ -1922,7 +1925,7 @@
 	 (tag-glyph (widget-get widget :tag-glyph))
 	 (text (concat widget-push-button-prefix
 		       tag widget-push-button-suffix))
-	 gui)
+	 (gui-glyphs (lax-plist-get widget-push-button-cache tag)))
     (cond (tag-glyph
 	   (widget-glyph-insert widget text tag-glyph))
 	  ;; We must check for console-on-window-system-p here,
@@ -1930,10 +1933,18 @@
 	  ;; components for colors, and they are not known on TTYs).
 	  ((and widget-push-button-gui
 		(console-on-window-system-p))
-	   (let* ((gui-button-shadow-thickness 1))
-	     (setq gui (make-glyph 
-			(make-gui-button tag 'widget-gui-action widget))))
-	   (widget-glyph-insert-glyph widget gui))
+	   (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)))
 	  (t
 	   (insert text)))))
 
@@ -2521,7 +2532,7 @@
     found))
 
 (defun widget-checklist-match-up (args vals)
-  ;; Return the first type from ARGS that matches VALS.
+  ;; Rerturn the first type from ARGS that matches VALS.
   (let (current found)
     (while (and args (null found))
       (setq current (car args)
@@ -2543,7 +2554,7 @@
     result))
 
 (defun widget-checklist-validate (widget)
-  ;; Ticked children must be valid.
+  ;; Ticked chilren must be valid.
   (let ((children (widget-get widget :children))
 	child button found)
     (while (and children (not found))