Mercurial > hg > xemacs-beta
comparison lisp/wid-edit.el @ 1833:eed841acc858
[xemacs-hg @ 2003-12-19 14:28:45 by youngs]
2003-12-15 Steve Youngs <sryoungs@bigpond.net.au>
* wid-edit.el (lazy): New.
(widget-child-value-get): New.
(widget-child-value-inline): New.
(widget-child-validate): New.
(widget-type-value-create): New.
(widget-type-default-get): New.
(widget-type-match): New.
This adds a "lazy" widget to allow the definition of recursive
datatypes for customize. The composite widgets expand their
subtypes immediately, which cause obvious problems for recursive
datatypes. The "lazy" will only expand them when needed, hense
the name.
From Per Abrahamsen <abraham@dina.kvl.dk>
2003-12-15 Steve Youngs <sryoungs@bigpond.net.au>
* lispref/customize.texi (Defining New Types): New node.
From Per Abrahamsen <abraham@dina.kvl.dk>
| author | youngs |
|---|---|
| date | Fri, 19 Dec 2003 14:29:07 +0000 |
| parents | 92dd8587c485 |
| children | c0bb56c2da36 |
comparison
equal
deleted
inserted
replaced
| 1832:5d8dcaecc32b | 1833:eed841acc858 |
|---|---|
| 4024 (if (functionp help-echo) | 4024 (if (functionp help-echo) |
| 4025 (setq help-echo (funcall help-echo widget))) | 4025 (setq help-echo (funcall help-echo widget))) |
| 4026 (if (stringp help-echo) | 4026 (if (stringp help-echo) |
| 4027 (display-message 'help-echo help-echo)))) | 4027 (display-message 'help-echo help-echo)))) |
| 4028 | 4028 |
| 4029 (define-widget 'lazy 'default | |
| 4030 "Base widget for recursive datastructures. | |
| 4031 | |
| 4032 The `lazy' widget will, when instantiated, contain a single inferior | |
| 4033 widget, of the widget type specified by the :type parameter. The | |
| 4034 value of the `lazy' widget is the same as the value of the inferior | |
| 4035 widget. When deriving a new widget from the 'lazy' widget, the :type | |
| 4036 parameter is allowed to refer to the widget currently being defined, | |
| 4037 thus allowing recursive datastructures to be described. | |
| 4038 | |
| 4039 The:type parameter takes the same arguments as the defcustom | |
| 4040 parameter with the same name. | |
| 4041 | |
| 4042 Most composite widgets, i.e. widgets containing other widgets, does | |
| 4043 not allow recursion. That is, when you define a new widget type, none | |
| 4044 of the inferior widgets may be of the same type you are currently | |
| 4045 defining. | |
| 4046 | |
| 4047 In Lisp, however, it is custom to define datastructures in terms of | |
| 4048 themselves. A list, for example, is defined as either nil, or a cons | |
| 4049 cell whose cdr itself is a list. The obvious way to translate this | |
| 4050 into a widget type would be | |
| 4051 | |
| 4052 (define-widget 'my-list 'choice | |
| 4053 \"A list of sexps.\" | |
| 4054 :tag \"Sexp list\" | |
| 4055 :args '((const nil) (cons :value (nil) sexp my-list))) | |
| 4056 | |
| 4057 Here we attempt to define my-list as a choice of either the constant | |
| 4058 nil, or a cons-cell containing a sexp and my-lisp. This will not work | |
| 4059 because the `choice' widget does not allow recursion. | |
| 4060 | |
| 4061 Using the `lazy' widget you can overcome this problem, as in this | |
| 4062 example: | |
| 4063 | |
| 4064 (define-widget 'sexp-list 'lazy | |
| 4065 \"A list of sexps.\" | |
| 4066 :tag \"Sexp list\" | |
| 4067 :type '(choice (const nil) (cons :value (nil) sexp sexp-list)))" | |
| 4068 :format "%{%t%}: %v" | |
| 4069 ;; We don't convert :type because we want to allow recursive | |
| 4070 ;; datastructures. This is slow, so we should not create speed | |
| 4071 ;; critical widgets by deriving from this. | |
| 4072 :convert-widget 'widget-value-convert-widget | |
| 4073 :value-create 'widget-type-value-create | |
| 4074 :value-delete 'widget-children-value-delete | |
| 4075 :value-get 'widget-child-value-get | |
| 4076 :value-inline 'widget-child-value-inline | |
| 4077 :default-get 'widget-type-default-get | |
| 4078 :match 'widget-type-match | |
| 4079 :validate 'widget-child-validate) | |
| 4080 | |
| 4081 (defun widget-child-value-get (widget) | |
| 4082 "Get the value of the first member of :children in WIDGET." | |
| 4083 (widget-value (car (widget-get widget :children)))) | |
| 4084 | |
| 4085 (defun widget-child-value-inline (widget) | |
| 4086 "Get the inline value of the first member of :children in WIDGET." | |
| 4087 (widget-apply (car (widget-get widget :children)) :value-inline)) | |
| 4088 | |
| 4089 (defun widget-child-validate (widget) | |
| 4090 "The result of validating the first member of :children in WIDGET." | |
| 4091 (widget-apply (car (widget-get widget :children)) :validate)) | |
| 4092 | |
| 4093 (defun widget-type-value-create (widget) | |
| 4094 "Convert and instantiate the value of the :type attribute of WIDGET. | |
| 4095 Store the newly created widget in the :children attribute. | |
| 4096 | |
| 4097 The value of the :type attribute should be an unconverted widget type." | |
| 4098 (let ((value (widget-get widget :value)) | |
| 4099 (type (widget-get widget :type))) | |
| 4100 (widget-put widget :children | |
| 4101 (list (widget-create-child-value widget | |
| 4102 (widget-convert type) | |
| 4103 value))))) | |
| 4104 | |
| 4105 (defun widget-type-default-get (widget) | |
| 4106 "Get default value from the :type attribute of WIDGET. | |
| 4107 | |
| 4108 The value of the :type attribute should be an unconverted widget type." | |
| 4109 (widget-default-get (widget-convert (widget-get widget :type)))) | |
| 4110 | |
| 4111 (defun widget-type-match (widget value) | |
| 4112 "Non-nil if the :type value of WIDGET matches VALUE. | |
| 4113 | |
| 4114 The value of the :type attribute should be an unconverted widget type." | |
| 4115 (widget-apply (widget-convert (widget-get widget :type)) :match value)) | |
| 4116 | |
| 4029 ;;; The End: | 4117 ;;; The End: |
| 4030 | 4118 |
| 4031 (provide 'wid-edit) | 4119 (provide 'wid-edit) |
| 4032 | 4120 |
| 4033 ;;; wid-edit.el ends here | 4121 ;;; wid-edit.el ends here |