Mercurial > hg > xemacs-beta
comparison lisp/wid-edit.el @ 1873:c0bb56c2da36
[xemacs-hg @ 2004-01-22 02:50:25 by james]
Remove duplicate sexp widget definitions.
| author | james |
|---|---|
| date | Thu, 22 Jan 2004 02:50:26 +0000 |
| parents | eed841acc858 |
| children | ecf1ebac70d8 |
comparison
equal
deleted
inserted
replaced
| 1872:3a60a1df125c | 1873:c0bb56c2da36 |
|---|---|
| 3614 t))) | 3614 t))) |
| 3615 (widget-value-set widget answer) | 3615 (widget-value-set widget answer) |
| 3616 (widget-apply widget :notify widget event) | 3616 (widget-apply widget :notify widget event) |
| 3617 (widget-setup))) | 3617 (widget-setup))) |
| 3618 | 3618 |
| 3619 (define-widget 'sexp 'editable-field | |
| 3620 "An arbitrary Lisp expression." | |
| 3621 :tag "Lisp expression" | |
| 3622 :format "%{%t%}: %v" | |
| 3623 :value nil | |
| 3624 :validate 'widget-sexp-validate | |
| 3625 :match (lambda (widget value) t) | |
| 3626 :value-to-internal 'widget-sexp-value-to-internal | |
| 3627 :value-to-external (lambda (widget value) (read value)) | |
| 3628 :prompt-history 'widget-sexp-prompt-value-history | |
| 3629 :prompt-value 'widget-sexp-prompt-value) | |
| 3630 | |
| 3631 (defun widget-sexp-value-to-internal (widget value) | |
| 3632 ;; Use cl-prettyprint for printer representation. | |
| 3633 (let ((pp (if (symbolp value) | |
| 3634 (prin1-to-string value) | |
| 3635 (widget-prettyprint-to-string value)))) | |
| 3636 (if (> (length pp) 40) | |
| 3637 (concat "\n" pp) | |
| 3638 pp))) | |
| 3639 | |
| 3640 (defun widget-sexp-validate (widget) | |
| 3641 ;; Valid if we can read the string and there is no junk left after it. | |
| 3642 (save-excursion | |
| 3643 (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*")))) | |
| 3644 (erase-buffer) | |
| 3645 (insert (widget-apply widget :value-get)) | |
| 3646 (goto-char (point-min)) | |
| 3647 (condition-case data | |
| 3648 (let ((value (read buffer))) | |
| 3649 (if (eobp) | |
| 3650 (if (widget-apply widget :match value) | |
| 3651 nil | |
| 3652 (widget-put widget :error (widget-get widget :type-error)) | |
| 3653 widget) | |
| 3654 (widget-put widget | |
| 3655 :error (format "Junk at end of expression: %s" | |
| 3656 (buffer-substring (point) | |
| 3657 (point-max)))) | |
| 3658 widget)) | |
| 3659 (error (widget-put widget :error (error-message-string data)) | |
| 3660 widget))))) | |
| 3661 | |
| 3662 (defvar widget-sexp-prompt-value-history nil | |
| 3663 "History of input to `widget-sexp-prompt-value'.") | |
| 3664 | |
| 3665 (defun widget-sexp-prompt-value (widget prompt value unbound) | |
| 3666 ;; Read an arbitrary sexp. | |
| 3667 (let ((found (read-string prompt | |
| 3668 (if unbound nil (cons (prin1-to-string value) 0)) | |
| 3669 (widget-get widget :prompt-history)))) | |
| 3670 (save-excursion | |
| 3671 (let ((buffer (set-buffer (get-buffer-create " *Widget Scratch*")))) | |
| 3672 (erase-buffer) | |
| 3673 (insert found) | |
| 3674 (goto-char (point-min)) | |
| 3675 (let ((answer (read buffer))) | |
| 3676 (unless (eobp) | |
| 3677 (signal 'error | |
| 3678 (list "Junk at end of expression" | |
| 3679 (buffer-substring (point) (point-max))))) | |
| 3680 answer))))) | |
| 3681 | |
| 3682 (define-widget 'restricted-sexp 'sexp | 3619 (define-widget 'restricted-sexp 'sexp |
| 3683 "A Lisp expression restricted to values that match. | 3620 "A Lisp expression restricted to values that match. |
| 3684 | 3621 |
| 3685 Either the `:match' or the `:match-alternatives' property must be defined." | 3622 Either the `:match' or the `:match-alternatives' property must be defined." |
| 3686 :type-error "The specified value is not valid" | 3623 :type-error "The specified value is not valid" |