Mercurial > hg > xemacs-beta
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))