Mercurial > hg > xemacs-beta

comparison lisp/wid-edit.el @ 267:966663fcf606 r20-5b32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b32
author cvs
date Mon, 13 Aug 2007 10:26:29 +0200
parents 0e522484dd2a
children 6330739388db
comparison
equal deleted inserted replaced
266:18d185df8c54 267:966663fcf606
2195 2195
2196 (defun widget-choice-value-create (widget) 2196 (defun widget-choice-value-create (widget)
2197 ;; Insert the first choice that matches the value. 2197 ;; Insert the first choice that matches the value.
2198 (let ((value (widget-get widget :value)) 2198 (let ((value (widget-get widget :value))
2199 (args (widget-get widget :args)) 2199 (args (widget-get widget :args))
2200 (explicit (widget-get widget :explicit-choice))
2200 current) 2201 current)
2201 (while args 2202 (if explicit
2202 (setq current (car args) 2203 (progn
2203 args (cdr args)) 2204 (widget-put widget :children (list (widget-create-child-value
2204 (when (widget-apply current :match value) 2205 widget explicit value)))
2205 (widget-put widget :children (list (widget-create-child-value 2206 (widget-put widget :choice explicit))
2206 widget current value))) 2207 (while args
2207 (widget-put widget :choice current) 2208 (setq current (car args)
2208 (setq args nil 2209 args (cdr args))
2209 current nil))) 2210 (when (widget-apply current :match value)
2210 (when current 2211 (widget-put widget :children (list (widget-create-child-value
2211 (let ((void (widget-get widget :void))) 2212 widget current value)))
2212 (widget-put widget :children (list (widget-create-child-and-convert 2213 (widget-put widget :choice current)
2213 widget void :value value))) 2214 (setq args nil
2214 (widget-put widget :choice void))))) 2215 current nil)))
2216 (when current
2217 (let ((void (widget-get widget :void)))
2218 (widget-put widget :children (list (widget-create-child-and-convert
2219 widget void :value value)))
2220 (widget-put widget :choice void))))))
2215 2221
2216 (defun widget-choice-value-get (widget) 2222 (defun widget-choice-value-get (widget)
2217 ;; Get value of the child widget. 2223 ;; Get value of the child widget.
2218 (widget-value (car (widget-get widget :children)))) 2224 (widget-value (car (widget-get widget :children))))
2219 2225
2281 args (cdr args)) 2287 args (cdr args))
2282 (setq choices 2288 (setq choices
2283 (cons (cons (widget-apply current :menu-tag-get) 2289 (cons (cons (widget-apply current :menu-tag-get)
2284 current) 2290 current)
2285 choices))) 2291 choices)))
2286 (widget-choose tag (reverse choices) event)))) 2292 (let ((choice
2293 (widget-choose tag (reverse choices) event)))
2294 (widget-put widget :explicit-choice choice)
2295 choice))))
2287 (when current 2296 (when current
2288 (widget-value-set widget 2297 (widget-value-set widget
2289 (widget-apply current :value-to-external 2298 (widget-apply current :value-to-external
2290 (widget-get current :value))) 2299 (widget-get current :value)))
2291 (widget-setup) 2300 (widget-setup)