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 | |
| 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.
| -rw-r--r-- | lisp/ChangeLog | 17 | ||||
| -rw-r--r-- | lisp/cus-edit.el | 3 | ||||
| -rw-r--r-- | lisp/wid-edit.el | 110 | ||||
| -rw-r--r-- | lispref/customize.texi | 73 |
4 files changed, 185 insertions, 18 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index da52c2aa190..a2e7f95747c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -76,6 +76,23 @@ | |||
| 76 | * info.el (Info-unescape-quotes, Info-split-parameter-string) | 76 | * info.el (Info-unescape-quotes, Info-split-parameter-string) |
| 77 | (Info-goto-emacs-command-node): Doc fixes. | 77 | (Info-goto-emacs-command-node): Doc fixes. |
| 78 | 78 | ||
| 79 | 2003-12-12 Jesper Harder <harder@ifa.au.dk> | ||
| 80 | |||
| 81 | * cus-edit.el (custom-add-parent-links): Define "many". | ||
| 82 | |||
| 83 | 2003-12-08 Per Abrahamsen <abraham@dina.kvl.dk> | ||
| 84 | |||
| 85 | * wid-edit.el (widget-child-value-get, widget-child-value-inline) | ||
| 86 | (widget-child-validate, widget-type-value-create) | ||
| 87 | (widget-type-default-get, widget-type-match): New functions. | ||
| 88 | (lazy): New widget. | ||
| 89 | (menu-choice, checklist, radio-button-choice, editable-list) | ||
| 90 | (group, documentation-string): Removed redundant (per 2003-10-25 | ||
| 91 | change) calls to `widget-children-value-delete'. | ||
| 92 | (widget-choice-value-get, widget-choice-value-inline): Removed | ||
| 93 | functions. | ||
| 94 | (menu-choice): Updated widget. | ||
| 95 | |||
| 79 | 2003-12-03 Kenichi Handa <handa@m17n.org> | 96 | 2003-12-03 Kenichi Handa <handa@m17n.org> |
| 80 | 97 | ||
| 81 | * language/cyrillic.el: Register "microsoft-cp1251" in | 98 | * language/cyrillic.el: Register "microsoft-cp1251" in |
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index bf92e8df9cf..fc5e7ecb8af 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -1970,7 +1970,8 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." | |||
| 1970 | (setq parents (cons symbol parents)))))) | 1970 | (setq parents (cons symbol parents)))))) |
| 1971 | (and (null (get symbol 'custom-links)) ;No links of its own. | 1971 | (and (null (get symbol 'custom-links)) ;No links of its own. |
| 1972 | (= (length parents) 1) ;A single parent. | 1972 | (= (length parents) 1) ;A single parent. |
| 1973 | (let ((links (get (car parents) 'custom-links))) | 1973 | (let* ((links (get (car parents) 'custom-links)) |
| 1974 | (many (> (length links) 2))) | ||
| 1974 | (when links | 1975 | (when links |
| 1975 | (insert "\nParent documentation: ") | 1976 | (insert "\nParent documentation: ") |
| 1976 | (while links | 1977 | (while links |
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. |
diff --git a/lispref/customize.texi b/lispref/customize.texi index 8621cb65662..90600f410b7 100644 --- a/lispref/customize.texi +++ b/lispref/customize.texi | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | @c -*-texinfo-*- | 1 | @c -*-texinfo-*- |
| 2 | @c This is part of the GNU Emacs Lisp Reference Manual. | 2 | @c This is part of the GNU Emacs Lisp Reference Manual. |
| 3 | @c Copyright (C) 1997, 1998, 1999, 2000, 2002 Free Software Foundation, Inc. | 3 | @c Copyright (C) 1997, 1998, 1999, 2000, 2002, 2003 Free Software Foundation, Inc. |
| 4 | @c See the file elisp.texi for copying conditions. | 4 | @c See the file elisp.texi for copying conditions. |
| 5 | @setfilename ../info/customize | 5 | @setfilename ../info/customize |
| 6 | @node Customization, Loading, Macros, Top | 6 | @node Customization, Loading, Macros, Top |
| @@ -373,6 +373,7 @@ equivalent to @code{(string)}. | |||
| 373 | * Composite Types:: | 373 | * Composite Types:: |
| 374 | * Splicing into Lists:: | 374 | * Splicing into Lists:: |
| 375 | * Type Keywords:: | 375 | * Type Keywords:: |
| 376 | * Defining New Types:: | ||
| 376 | @end menu | 377 | @end menu |
| 377 | 378 | ||
| 378 | All customization types are implemented as widgets; see @ref{Top, , | 379 | All customization types are implemented as widgets; see @ref{Top, , |
| @@ -1056,6 +1057,76 @@ arguments, which will be used when creating the @code{radio-button} or | |||
| 1056 | @end ignore | 1057 | @end ignore |
| 1057 | @end table | 1058 | @end table |
| 1058 | 1059 | ||
| 1060 | @node Defining New Types | ||
| 1061 | @subsection Defining New Types | ||
| 1062 | |||
| 1063 | In the previous sections we have described how to construct elaborate | ||
| 1064 | type specifications for @code{defcustom}. In some cases you may want to | ||
| 1065 | give such a type specification a name. The obvious case is when you are | ||
| 1066 | using the same type for many user options, rather than repeat the | ||
| 1067 | specification for each option, you can give the type specification a | ||
| 1068 | name once, and use that name each @code{defcustom}. The other case is | ||
| 1069 | when a user option accept a recursive datastructure. To make it | ||
| 1070 | possible for a datatype to refer to itself, it needs to have a name. | ||
| 1071 | |||
| 1072 | Since custom types are implemented as widgets, the way to define a new | ||
| 1073 | customize type is to define a new widget. We are not going to describe | ||
| 1074 | the widget interface here in details, see @ref{Top, , Introduction, | ||
| 1075 | widget, The Emacs Widget Library}, for that. Instead we are going to | ||
| 1076 | demonstrate the minimal functionality needed for defining new customize | ||
| 1077 | types by a simple example. | ||
| 1078 | |||
| 1079 | @example | ||
| 1080 | (define-widget 'binary-tree-of-string 'lazy | ||
| 1081 | "A binary tree made of cons-cells and strings." | ||
| 1082 | :offset 4 | ||
| 1083 | :tag "Node" | ||
| 1084 | :type '(choice (string :tag "Leaf" :value "") | ||
| 1085 | (cons :tag "Interior" | ||
| 1086 | :value ("" . "") | ||
| 1087 | binary-tree-of-string | ||
| 1088 | binary-tree-of-string))) | ||
| 1089 | |||
| 1090 | (defcustom foo-bar "" | ||
| 1091 | "Sample variable holding a binary tree of strings." | ||
| 1092 | :type 'binary-tree-of-string) | ||
| 1093 | @end example | ||
| 1094 | |||
| 1095 | The function to define a new widget is name @code{define-widget}. The | ||
| 1096 | first argument is the symbol we want to make a new widget type. The | ||
| 1097 | second argument is a symbol representing an existing widget, the new | ||
| 1098 | widget is going to be defined in terms of difference from the existing | ||
| 1099 | widget. For the purpose of defining new customization types, the | ||
| 1100 | @code{lazy} widget is perfect, because it accept a @code{:type} keyword | ||
| 1101 | argument with the same syntax as the keyword argument to | ||
| 1102 | @code{defcustom} with the same name. The third argument is a | ||
| 1103 | documentation string for the new widget. You will be able to see that | ||
| 1104 | string with the @kbd{M-x widget-browse @key{ret} binary-tree-of-string | ||
| 1105 | @key{ret}} command. | ||
| 1106 | |||
| 1107 | After these mandatory arguments follows the keyword arguments. The most | ||
| 1108 | important is @code{:type}, which describes the datatype we want to match | ||
| 1109 | with this widget. Here a @code{binary-tree-of-string} is described as | ||
| 1110 | being either a string, or a cons-cell whose car and cdr are themselves | ||
| 1111 | both @code{binary-tree-of-string}. Note the reference to the widget | ||
| 1112 | type we are currently in the process of defining. The @code{:tag} | ||
| 1113 | attribute is a string to name the widget in the user interface, and the | ||
| 1114 | @code{:offset} argument are there to ensure that child nodes are | ||
| 1115 | indented four spaces relatively to the parent node, making the tree | ||
| 1116 | structure apparent in the customization buffer. | ||
| 1117 | |||
| 1118 | The @code{defcustom} shows how the new widget can be used as an ordinary | ||
| 1119 | customization type. | ||
| 1120 | |||
| 1121 | If you wonder about the name @code{lazy}, know that the other composite | ||
| 1122 | widgets convert their inferior widgets to internal form when the widget | ||
| 1123 | is instantiated in a buffer. This conversion is recursive, so the | ||
| 1124 | inferior widgets will convert @emph{their} inferior widgets. If the | ||
| 1125 | datastructure is itself recursive, this conversion will go on forever, | ||
| 1126 | or at least until Emacs run out of stack space. The @code{lazy} widget | ||
| 1127 | stop this recursion, it will only convert its @code{:type} argument when | ||
| 1128 | needed. | ||
| 1129 | |||
| 1059 | @ignore | 1130 | @ignore |
| 1060 | arch-tag: d1b8fad3-f48c-4ce4-a402-f73b5ef19bd2 | 1131 | arch-tag: d1b8fad3-f48c-4ce4-a402-f73b5ef19bd2 |
| 1061 | @end ignore | 1132 | @end ignore |