Mercurial > emacs
comparison lisp/wid-edit.el @ 53319:36b31fc002f2
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.
author | Per Abrahamsen <abraham@dina.kvl.dk> |
---|---|
date | Sat, 27 Dec 2003 16:41:13 +0000 |
parents | aadc87ded24c |
children | 15266cc5ed84 |
comparison
equal
deleted
inserted
replaced
53318:d7e333de59f9 | 53319:36b31fc002f2 |
---|---|
1265 (setq child (car children) | 1265 (setq child (car children) |
1266 children (cdr children) | 1266 children (cdr children) |
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))) |
1273 widget) | 1309 widget) |
1274 | 1310 |
1860 :format "%[%t%]: %v" | 1896 :format "%[%t%]: %v" |
1861 :case-fold t | 1897 :case-fold t |
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 |
1871 :error "Make a choice" | 1906 :error "Make a choice" |
1872 :validate 'widget-choice-validate | 1907 :validate 'widget-choice-validate |
1898 (when current | 1933 (when current |
1899 (let ((void (widget-get widget :void))) | 1934 (let ((void (widget-get widget :void))) |
1900 (widget-put widget :children (list (widget-create-child-and-convert | 1935 (widget-put widget :children (list (widget-create-child-and-convert |
1901 widget void :value value))) | 1936 widget void :value value))) |
1902 (widget-put widget :choice void)))))) | 1937 (widget-put widget :choice void)))))) |
1903 | |
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 | 1938 |
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)))) |
1915 | 1942 |
2097 :format "%v" | 2124 :format "%v" |
2098 :offset 4 | 2125 :offset 4 |
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 |
2106 :match-inline 'widget-checklist-match-inline) | 2132 :match-inline 'widget-checklist-match-inline) |
2107 | 2133 |
2274 :copy 'widget-types-copy | 2300 :copy 'widget-types-copy |
2275 :offset 4 | 2301 :offset 4 |
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 |
2283 :error "You must push one of the buttons" | 2308 :error "You must push one of the buttons" |
2284 :validate 'widget-radio-validate | 2309 :validate 'widget-radio-validate |
2464 :offset 12 | 2489 :offset 12 |
2465 :format "%v%i\n" | 2490 :format "%v%i\n" |
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 |
2473 :match-inline 'widget-editable-list-match-inline | 2497 :match-inline 'widget-editable-list-match-inline |
2474 :insert-before 'widget-editable-list-insert-before | 2498 :insert-before 'widget-editable-list-insert-before |
2635 "A widget which groups other widgets inside." | 2659 "A widget which groups other widgets inside." |
2636 :convert-widget 'widget-types-convert-widget | 2660 :convert-widget 'widget-types-convert-widget |
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 |
2644 :match 'widget-group-match | 2667 :match 'widget-group-match |
2645 :match-inline 'widget-group-match-inline) | 2668 :match-inline 'widget-group-match-inline) |
2801 | 2824 |
2802 (define-widget 'documentation-string 'item | 2825 (define-widget 'documentation-string 'item |
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) |
2810 ;; Insert documentation string. | 2832 ;; Insert documentation string. |
2811 (let ((doc (widget-value widget)) | 2833 (let ((doc (widget-value widget)) |
3247 | 3269 |
3248 (defun widget-cons-match (widget value) | 3270 (defun widget-cons-match (widget value) |
3249 (and (consp value) | 3271 (and (consp value) |
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)))) |
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 | |
3252 | 3330 |
3253 ;;; The `plist' Widget. | 3331 ;;; The `plist' Widget. |
3254 ;; | 3332 ;; |
3255 ;; Property lists. | 3333 ;; Property lists. |
3256 | 3334 |