aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/wid-edit.el
diff options
context:
space:
mode:
authorPer Abrahamsen2003-12-27 16:41:13 +0000
committerPer Abrahamsen2003-12-27 16:41:13 +0000
commitcfa921fd39a965d78ee9ebfe8855afee524b1987 (patch)
treeea2e2087ef7a3af5f220ead9f8649a49d4e7985b /lisp/wid-edit.el
parentc91406620cbf11dd9293ac52d6ee55f3dcf2a5fd (diff)
downloademacs-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.el110
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.
1284Store the newly created widget in the :children attribute.
1285
1286The 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
1297The 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
1303The 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
3282The `lazy' widget will, when instantiated, contain a single inferior
3283widget, of the widget type specified by the :type parameter. The
3284value of the `lazy' widget is the same as the value of the inferior
3285widget. When deriving a new widget from the 'lazy' widget, the :type
3286parameter is allowed to refer to the widget currently being defined,
3287thus allowing recursive datastructures to be described.
3288
3289The :type parameter takes the same arguments as the defcustom
3290parameter with the same name.
3291
3292Most composite widgets, i.e. widgets containing other widgets, does
3293not allow recursion. That is, when you define a new widget type, none
3294of the inferior widgets may be of the same type you are currently
3295defining.
3296
3297In Lisp, however, it is custom to define datastructures in terms of
3298themselves. A list, for example, is defined as either nil, or a cons
3299cell whose cdr itself is a list. The obvious way to translate this
3300into 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
3307Here we attempt to define my-list as a choice of either the constant
3308nil, or a cons-cell containing a sexp and my-lisp. This will not work
3309because the `choice' widget does not allow recursion.
3310
3311Using the `lazy' widget you can overcome this problem, as in this
3312example:
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.