Mercurial > hg > xemacs-beta

comparison lisp/wid-edit.el @ 227:0e522484dd2a r20-5b12

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b12
author cvs
date Mon, 13 Aug 2007 10:12:37 +0200
parents 6c0ae1f9357f
children 966663fcf606
comparison
equal deleted inserted replaced
226:eea38c7ad7b4 227:0e522484dd2a
584 (unless (listp widget) 584 (unless (listp widget)
585 (setq widget (list widget))) 585 (setq widget (list widget)))
586 (setq prompt (format "[%s] %s" (widget-type widget) prompt)) 586 (setq prompt (format "[%s] %s" (widget-type widget) prompt))
587 (setq widget (widget-convert widget)) 587 (setq widget (widget-convert widget))
588 (let ((answer (widget-apply widget :prompt-value prompt value unbound))) 588 (let ((answer (widget-apply widget :prompt-value prompt value unbound)))
589 (unless (widget-apply widget :match answer) 589 (while (not (widget-apply widget :match answer))
590 (error "Value does not match %S type." (car widget))) 590 (setq answer (signal 'error (list "Answer does not match type"
591 answer (widget-type widget)))))
591 answer)) 592 answer))
592 593
593 (defun widget-get-sibling (widget) 594 (defun widget-get-sibling (widget)
594 "Get the item WIDGET is assumed to toggle. 595 "Get the item WIDGET is assumed to toggle.
595 This is only meaningful for radio buttons or checkboxes in a list." 596 This is only meaningful for radio buttons or checkboxes in a list."
1702 nil) 1703 nil)
1703 (t 0)) 1704 (t 0))
1704 doc-text) 1705 doc-text)
1705 buttons)))) 1706 buttons))))
1706 (t 1707 (t
1707 (error "Unknown escape `%c'" escape))) 1708 (signal 'error (list "Unknown escape" escape))))
1708 (widget-put widget :buttons buttons))) 1709 (widget-put widget :buttons buttons)))
1709 1710
1710 (defun widget-default-button-face-get (widget) 1711 (defun widget-default-button-face-get (widget)
1711 ;; Use :button-face or widget-button-face 1712 ;; Use :button-face or widget-button-face
1712 (or (widget-get widget :button-face) 1713 (or (widget-get widget :button-face)
2432 widget type (cdr chosen))) 2433 widget type (cdr chosen)))
2433 (t 2434 (t
2434 (widget-create-child-value 2435 (widget-create-child-value
2435 widget type (car (cdr chosen))))))) 2436 widget type (car (cdr chosen)))))))
2436 (t 2437 (t
2437 (error "Unknown escape `%c'" escape))))) 2438 (signal 'error (list "Unknown escape" escape))))))
2438 ;; Update properties. 2439 ;; Update properties.
2439 (and button child (widget-put child :button button)) 2440 (and button child (widget-put child :button button))
2440 (and button (widget-put widget :buttons (cons button buttons))) 2441 (and button (widget-put widget :buttons (cons button buttons)))
2441 (and child (widget-put widget :children (cons child children)))))) 2442 (and child (widget-put widget :children (cons child children))))))
2442 2443
2612 widget type value) 2613 widget type value)
2613 (widget-create-child widget type))) 2614 (widget-create-child widget type)))
2614 (unless chosen 2615 (unless chosen
2615 (widget-apply child :deactivate))) 2616 (widget-apply child :deactivate)))
2616 (t 2617 (t
2617 (error "Unknown escape `%c'" escape))))) 2618 (signal 'error (list "Unknown escape" escape))))))
2618 ;; Update properties. 2619 ;; Update properties.
2619 (when chosen 2620 (when chosen
2620 (widget-put widget :choice type)) 2621 (widget-put widget :choice type))
2621 (when button 2622 (when button
2622 (widget-put child :button button) 2623 (widget-put child :button button)
2896 (if conv 2897 (if conv
2897 (setq child (widget-create-child-value 2898 (setq child (widget-create-child-value
2898 widget type value)) 2899 widget type value))
2899 (setq child (widget-create-child widget type)))) 2900 (setq child (widget-create-child widget type))))
2900 (t 2901 (t
2901 (error "Unknown escape `%c'" escape))))) 2902 (signal 'error (list "Unknown escape" escape))))))
2902 (widget-put widget 2903 (widget-put widget
2903 :buttons (cons delete 2904 :buttons (cons delete
2904 (cons insert 2905 (cons insert
2905 (widget-get widget :buttons)))) 2906 (widget-get widget :buttons))))
2906 (let ((entry-from (copy-marker (point-min))) 2907 (let ((entry-from (copy-marker (point-min)))
3400 (erase-buffer) 3401 (erase-buffer)
3401 (insert found) 3402 (insert found)
3402 (goto-char (point-min)) 3403 (goto-char (point-min))
3403 (let ((answer (read buffer))) 3404 (let ((answer (read buffer)))
3404 (unless (eobp) 3405 (unless (eobp)
3405 (error "Junk at end of expression: %s" 3406 (signal 'error
3406 (buffer-substring (point) (point-max)))) 3407 (list "Junk at end of expression"
3408 (buffer-substring (point) (point-max)))))
3407 answer))))) 3409 answer)))))
3408 3410
3409 (define-widget 'restricted-sexp 'sexp 3411 (define-widget 'restricted-sexp 'sexp
3410 "A Lisp expression restricted to values that match. 3412 "A Lisp expression restricted to values that match.
3411 To use this type, you must define :match or :match-alternatives." 3413 To use this type, you must define :match or :match-alternatives."