diff options
| author | Per Abrahamsen | 2003-12-27 16:41:13 +0000 |
|---|---|---|
| committer | Per Abrahamsen | 2003-12-27 16:41:13 +0000 |
| commit | cfa921fd39a965d78ee9ebfe8855afee524b1987 (patch) | |
| tree | ea2e2087ef7a3af5f220ead9f8649a49d4e7985b /lisp/wid-edit.el | |
| parent | c91406620cbf11dd9293ac52d6ee55f3dcf2a5fd (diff) | |
| download | emacs-cfa921fd39a965d78ee9ebfe8855afee524b1987.tar.gz emacs-cfa921fd39a965d78ee9ebfe8855afee524b1987.zip | |
2003-12-12 Jesper Harder <harder@ifa.au.dk>
* cus-edit.el (custom-add-parent-links): Define "many".
2003-12-08 Per Abrahamsen <abraham@dina.kvl.dk>
* wid-edit.el (widget-child-value-get, widget-child-value-inline)
(widget-child-validate, widget-type-value-create)
(widget-type-default-get, widget-type-match): New functions.
(lazy): New widget.
(menu-choice, checklist, radio-button-choice, editable-list)
(group, documentation-string): Removed redundant (per 2003-10-25
change) calls to `widget-children-value-delete'.
(widget-choice-value-get, widget-choice-value-inline): Removed
functions.
(menu-choice): Updated widget.
Diffstat (limited to 'lisp/wid-edit.el')
| -rw-r--r-- | lisp/wid-edit.el | 110 |
1 files changed, 94 insertions, 16 deletions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4c70334e908..63a254d1d67 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -1267,6 +1267,42 @@ Optional EVENT is the event that triggered the action." | |||
| 1267 | found (widget-apply child :validate))) | 1267 | found (widget-apply child :validate))) |
| 1268 | found)) | 1268 | found)) |
| 1269 | 1269 | ||
| 1270 | (defun widget-child-value-get (widget) | ||
| 1271 | "Get the value of the first member of :children in WIDGET." | ||
| 1272 | (widget-value (car (widget-get widget :children)))) | ||
| 1273 | |||
| 1274 | (defun widget-child-value-inline (widget) | ||
| 1275 | "Get the inline value of the first member of :children in WIDGET." | ||
| 1276 | (widget-apply (car (widget-get widget :children)) :value-inline)) | ||
| 1277 | |||
| 1278 | (defun widget-child-validate (widget) | ||
| 1279 | "The result of validating the first member of :children in WIDGET." | ||
| 1280 | (widget-apply (car (widget-get widget :children)) :validate)) | ||
| 1281 | |||
| 1282 | (defun widget-type-value-create (widget) | ||
| 1283 | "Convert and instantiate the value of the :type attribute of WIDGET. | ||
| 1284 | Store the newly created widget in the :children attribute. | ||
| 1285 | |||
| 1286 | The value of the :type attribute should be an unconverted widget type." | ||
| 1287 | (let ((value (widget-get widget :value)) | ||
| 1288 | (type (widget-get widget :type))) | ||
| 1289 | (widget-put widget :children | ||
| 1290 | (list (widget-create-child-value widget | ||
| 1291 | (widget-convert type) | ||
| 1292 | value))))) | ||
| 1293 | |||
| 1294 | (defun widget-type-default-get (widget) | ||
| 1295 | "Get default value from the :type attribute of WIDGET. | ||
| 1296 | |||
| 1297 | The value of the :type attribute should be an unconverted widget type." | ||
| 1298 | (widget-default-get (widget-convert (widget-get widget :type)))) | ||
| 1299 | |||
| 1300 | (defun widget-type-match (widget value) | ||
| 1301 | "Non-nil if the :type value of WIDGET matches VALUE. | ||
| 1302 | |||
| 1303 | The value of the :type attribute should be an unconverted widget type." | ||
| 1304 | (widget-apply (widget-convert (widget-get widget :type)) :match value)) | ||
| 1305 | |||
| 1270 | (defun widget-types-copy (widget) | 1306 | (defun widget-types-copy (widget) |
| 1271 | "Copy :args as widget types in WIDGET." | 1307 | "Copy :args as widget types in WIDGET." |
| 1272 | (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args))) | 1308 | (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args))) |
| @@ -1862,9 +1898,8 @@ the earlier input." | |||
| 1862 | :tag "choice" | 1898 | :tag "choice" |
| 1863 | :void '(item :format "invalid (%t)\n") | 1899 | :void '(item :format "invalid (%t)\n") |
| 1864 | :value-create 'widget-choice-value-create | 1900 | :value-create 'widget-choice-value-create |
| 1865 | :value-delete 'widget-children-value-delete | 1901 | :value-get 'widget-child-value-get |
| 1866 | :value-get 'widget-choice-value-get | 1902 | :value-inline 'widget-child-value-inline |
| 1867 | :value-inline 'widget-choice-value-inline | ||
| 1868 | :default-get 'widget-choice-default-get | 1903 | :default-get 'widget-choice-default-get |
| 1869 | :mouse-down-action 'widget-choice-mouse-down-action | 1904 | :mouse-down-action 'widget-choice-mouse-down-action |
| 1870 | :action 'widget-choice-action | 1905 | :action 'widget-choice-action |
| @@ -1901,14 +1936,6 @@ the earlier input." | |||
| 1901 | widget void :value value))) | 1936 | widget void :value value))) |
| 1902 | (widget-put widget :choice void)))))) | 1937 | (widget-put widget :choice void)))))) |
| 1903 | 1938 | ||
| 1904 | (defun widget-choice-value-get (widget) | ||
| 1905 | ;; Get value of the child widget. | ||
| 1906 | (widget-value (car (widget-get widget :children)))) | ||
| 1907 | |||
| 1908 | (defun widget-choice-value-inline (widget) | ||
| 1909 | ;; Get value of the child widget. | ||
| 1910 | (widget-apply (car (widget-get widget :children)) :value-inline)) | ||
| 1911 | |||
| 1912 | (defun widget-choice-default-get (widget) | 1939 | (defun widget-choice-default-get (widget) |
| 1913 | ;; Get default for the first choice. | 1940 | ;; Get default for the first choice. |
| 1914 | (widget-default-get (car (widget-get widget :args)))) | 1941 | (widget-default-get (car (widget-get widget :args)))) |
| @@ -2099,7 +2126,6 @@ when he invoked the menu." | |||
| 2099 | :entry-format "%b %v" | 2126 | :entry-format "%b %v" |
| 2100 | :greedy nil | 2127 | :greedy nil |
| 2101 | :value-create 'widget-checklist-value-create | 2128 | :value-create 'widget-checklist-value-create |
| 2102 | :value-delete 'widget-children-value-delete | ||
| 2103 | :value-get 'widget-checklist-value-get | 2129 | :value-get 'widget-checklist-value-get |
| 2104 | :validate 'widget-checklist-validate | 2130 | :validate 'widget-checklist-validate |
| 2105 | :match 'widget-checklist-match | 2131 | :match 'widget-checklist-match |
| @@ -2276,7 +2302,6 @@ Return an alist of (TYPE MATCH)." | |||
| 2276 | :format "%v" | 2302 | :format "%v" |
| 2277 | :entry-format "%b %v" | 2303 | :entry-format "%b %v" |
| 2278 | :value-create 'widget-radio-value-create | 2304 | :value-create 'widget-radio-value-create |
| 2279 | :value-delete 'widget-children-value-delete | ||
| 2280 | :value-get 'widget-radio-value-get | 2305 | :value-get 'widget-radio-value-get |
| 2281 | :value-inline 'widget-radio-value-inline | 2306 | :value-inline 'widget-radio-value-inline |
| 2282 | :value-set 'widget-radio-value-set | 2307 | :value-set 'widget-radio-value-set |
| @@ -2466,7 +2491,6 @@ Return an alist of (TYPE MATCH)." | |||
| 2466 | :format-handler 'widget-editable-list-format-handler | 2491 | :format-handler 'widget-editable-list-format-handler |
| 2467 | :entry-format "%i %d %v" | 2492 | :entry-format "%i %d %v" |
| 2468 | :value-create 'widget-editable-list-value-create | 2493 | :value-create 'widget-editable-list-value-create |
| 2469 | :value-delete 'widget-children-value-delete | ||
| 2470 | :value-get 'widget-editable-list-value-get | 2494 | :value-get 'widget-editable-list-value-get |
| 2471 | :validate 'widget-children-validate | 2495 | :validate 'widget-children-validate |
| 2472 | :match 'widget-editable-list-match | 2496 | :match 'widget-editable-list-match |
| @@ -2637,7 +2661,6 @@ Return an alist of (TYPE MATCH)." | |||
| 2637 | :copy 'widget-types-copy | 2661 | :copy 'widget-types-copy |
| 2638 | :format "%v" | 2662 | :format "%v" |
| 2639 | :value-create 'widget-group-value-create | 2663 | :value-create 'widget-group-value-create |
| 2640 | :value-delete 'widget-children-value-delete | ||
| 2641 | :value-get 'widget-editable-list-value-get | 2664 | :value-get 'widget-editable-list-value-get |
| 2642 | :default-get 'widget-group-default-get | 2665 | :default-get 'widget-group-default-get |
| 2643 | :validate 'widget-children-validate | 2666 | :validate 'widget-children-validate |
| @@ -2803,7 +2826,6 @@ link for that string." | |||
| 2803 | "A documentation string." | 2826 | "A documentation string." |
| 2804 | :format "%v" | 2827 | :format "%v" |
| 2805 | :action 'widget-documentation-string-action | 2828 | :action 'widget-documentation-string-action |
| 2806 | :value-delete 'widget-children-value-delete | ||
| 2807 | :value-create 'widget-documentation-string-value-create) | 2829 | :value-create 'widget-documentation-string-value-create) |
| 2808 | 2830 | ||
| 2809 | (defun widget-documentation-string-value-create (widget) | 2831 | (defun widget-documentation-string-value-create (widget) |
| @@ -3250,6 +3272,62 @@ To use this type, you must define :match or :match-alternatives." | |||
| 3250 | (widget-group-match widget | 3272 | (widget-group-match widget |
| 3251 | (widget-apply widget :value-to-internal value)))) | 3273 | (widget-apply widget :value-to-internal value)))) |
| 3252 | 3274 | ||
| 3275 | ;;; The `lazy' Widget. | ||
| 3276 | ;; | ||
| 3277 | ;; Recursive datatypes. | ||
| 3278 | |||
| 3279 | (define-widget 'lazy 'default | ||
| 3280 | "Base widget for recursive datastructures. | ||
| 3281 | |||
| 3282 | The `lazy' widget will, when instantiated, contain a single inferior | ||
| 3283 | widget, of the widget type specified by the :type parameter. The | ||
| 3284 | value of the `lazy' widget is the same as the value of the inferior | ||
| 3285 | widget. When deriving a new widget from the 'lazy' widget, the :type | ||
| 3286 | parameter is allowed to refer to the widget currently being defined, | ||
| 3287 | thus allowing recursive datastructures to be described. | ||
| 3288 | |||
| 3289 | The :type parameter takes the same arguments as the defcustom | ||
| 3290 | parameter with the same name. | ||
| 3291 | |||
| 3292 | Most composite widgets, i.e. widgets containing other widgets, does | ||
| 3293 | not allow recursion. That is, when you define a new widget type, none | ||
| 3294 | of the inferior widgets may be of the same type you are currently | ||
| 3295 | defining. | ||
| 3296 | |||
| 3297 | In Lisp, however, it is custom to define datastructures in terms of | ||
| 3298 | themselves. A list, for example, is defined as either nil, or a cons | ||
| 3299 | cell whose cdr itself is a list. The obvious way to translate this | ||
| 3300 | into a widget type would be | ||
| 3301 | |||
| 3302 | (define-widget 'my-list 'choice | ||
| 3303 | \"A list of sexps.\" | ||
| 3304 | :tag \"Sexp list\" | ||
| 3305 | :args '((const nil) (cons :value (nil) sexp my-list))) | ||
| 3306 | |||
| 3307 | Here we attempt to define my-list as a choice of either the constant | ||
| 3308 | nil, or a cons-cell containing a sexp and my-lisp. This will not work | ||
| 3309 | because the `choice' widget does not allow recursion. | ||
| 3310 | |||
| 3311 | Using the `lazy' widget you can overcome this problem, as in this | ||
| 3312 | example: | ||
| 3313 | |||
| 3314 | (define-widget 'sexp-list 'lazy | ||
| 3315 | \"A list of sexps.\" | ||
| 3316 | :tag \"Sexp list\" | ||
| 3317 | :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))" | ||
| 3318 | :format "%{%t%}: %v" | ||
| 3319 | ;; We don't convert :type because we want to allow recursive | ||
| 3320 | ;; datastructures. This is slow, so we should not create speed | ||
| 3321 | ;; critical widgets by deriving from this. | ||
| 3322 | :convert-widget 'widget-value-convert-widget | ||
| 3323 | :value-create 'widget-type-value-create | ||
| 3324 | :value-get 'widget-child-value-get | ||
| 3325 | :value-inline 'widget-child-value-inline | ||
| 3326 | :default-get 'widget-type-default-get | ||
| 3327 | :match 'widget-type-match | ||
| 3328 | :validate 'widget-child-validate) | ||
| 3329 | |||
| 3330 | |||
| 3253 | ;;; The `plist' Widget. | 3331 | ;;; The `plist' Widget. |
| 3254 | ;; | 3332 | ;; |
| 3255 | ;; Property lists. | 3333 | ;; Property lists. |