Mercurial > hg > xemacs-beta
diff lisp/wid-edit.el @ 280:7df0dd720c89 r21-0b38
Import from CVS: tag r21-0b38
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:32:22 +0200 |
parents | 90d73dddcdc4 |
children | c9fe270a4101 |
line wrap: on
line diff
--- a/lisp/wid-edit.el Mon Aug 13 10:31:30 2007 +0200 +++ b/lisp/wid-edit.el Mon Aug 13 10:32:22 2007 +0200 @@ -572,6 +572,11 @@ :value-set (widget-apply widget :value-to-internal value))) +(defun widget-default-get (widget) + "Extract the defaylt value of WIDGET." + (or (widget-get widget :value) + (widget-apply widget :default-get))) + (defun widget-match-inline (widget vals) ;; In WIDGET, match the start of VALS. (cond ((widget-get widget :inline) @@ -1581,6 +1586,7 @@ :delete 'widget-default-delete :value-set 'widget-default-value-set :value-inline 'widget-default-value-inline + :default-get 'widget-default-default-get :menu-tag-get 'widget-default-menu-tag-get :validate (lambda (widget) nil) :active 'widget-default-active @@ -1789,6 +1795,10 @@ (widget-value widget) (list (widget-value widget)))) +(defun widget-default-default-get (widget) + ;; Get `:value'. + (widget-get widget :value)) + (defun widget-default-menu-tag-get (widget) ;; Use tag or value for menus. (or (widget-get widget :menu-tag) @@ -2200,6 +2210,7 @@ :value-delete 'widget-children-value-delete :value-get 'widget-choice-value-get :value-inline 'widget-choice-value-inline + :default-get 'widget-choice-default-get :mouse-down-action 'widget-choice-mouse-down-action :action 'widget-choice-action :error "Make a choice" @@ -2241,6 +2252,10 @@ ;; Get value of the child widget. (widget-apply (car (widget-get widget :children)) :value-inline)) +(defun widget-choice-default-get (widget) + ;; Get default for the first choice. + (widget-default-get (car (widget-get widget :args)))) + (defcustom widget-choice-toggle nil "If non-nil, a binary choice will just toggle between the values. Otherwise, the user will explicitly have to choose between the values @@ -2308,9 +2323,9 @@ (widget-put widget :explicit-choice choice) choice)))) (when current - (widget-value-set widget - (widget-apply current :value-to-external - (widget-get current :value))) + (let ((value (widget-default-get current))) + (widget-value-set widget + (widget-apply current :value-to-external value))) (widget-setup) (widget-apply widget :notify widget event))) (run-hook-with-args 'widget-edit-functions widget)) @@ -2920,7 +2935,8 @@ (if conv (setq child (widget-create-child-value widget type value)) - (setq child (widget-create-child widget type)))) + (setq child (widget-create-child-value + widget type (widget-default-get type))))) (t (signal 'error (list "Unknown escape" escape)))))) (widget-put widget @@ -2946,6 +2962,7 @@ :value-create 'widget-group-value-create :value-delete 'widget-children-value-delete :value-get 'widget-editable-list-value-get + :default-get 'widget-group-default-get :validate 'widget-children-validate :match 'widget-group-match :match-inline 'widget-group-match-inline) @@ -2972,6 +2989,10 @@ children)) (widget-put widget :children (nreverse children)))) +(defun widget-group-default-get (widget) + ;; Get the default of the components. + (mapcar 'widget-default-get (widget-get widget :args))) + (defun widget-group-match (widget values) ;; Match if the components match. (and (listp values)