diff options
| author | Richard M. Stallman | 1997-06-21 05:13:41 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1997-06-21 05:13:41 +0000 |
| commit | c6753d66ff2e253664f1a10c606c19d902046974 (patch) | |
| tree | fb3623dc4820893aa147845d82b4f85318c1145b | |
| parent | 451de77a8acf4e9d12e832fe16afe0716e820569 (diff) | |
| download | emacs-c6753d66ff2e253664f1a10c606c19d902046974.tar.gz emacs-c6753d66ff2e253664f1a10c606c19d902046974.zip | |
(boolean): Capitalize "toggle".
(choice): Capitalize "value menu".
(visibility): Capitalize "hide" and "show".
(group-visibility): Likewise.
(widget-documentation-string-value-create): Capitalize "more".
(widget-specify-insert): Bind before-change-functions.
(widget-insert, widget-setup): Likewise.
(widget-editable-list-delete-at, widget-default-delete): Likewise.
(widget-editable-list-insert-before): Likewise.
(widget-setup): Set up before-change-functions.
(widget-after-change): Don't apply :notify here.
(widget-before-change): New function. Apply :notify here.
(group-link): New widget type.
(widget-group-link-action): New function.
(widget-group-link-create): New function.
(group-visibility): New widget type.
| -rw-r--r-- | lisp/wid-edit.el | 79 |
1 files changed, 65 insertions, 14 deletions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index f5ae7eaef0b..44bc0b9bd17 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -362,6 +362,7 @@ size field." | |||
| 362 | (save-restriction | 362 | (save-restriction |
| 363 | (let ((inhibit-read-only t) | 363 | (let ((inhibit-read-only t) |
| 364 | result | 364 | result |
| 365 | before-change-functions | ||
| 365 | after-change-functions) | 366 | after-change-functions) |
| 366 | (insert "<>") | 367 | (insert "<>") |
| 367 | (narrow-to-region (- (point) 2) (point)) | 368 | (narrow-to-region (- (point) 2) (point)) |
| @@ -772,6 +773,7 @@ The optional ARGS are additional keyword arguments." | |||
| 772 | (defun widget-insert (&rest args) | 773 | (defun widget-insert (&rest args) |
| 773 | "Call `insert' with ARGS and make the text read only." | 774 | "Call `insert' with ARGS and make the text read only." |
| 774 | (let ((inhibit-read-only t) | 775 | (let ((inhibit-read-only t) |
| 776 | before-change-functions | ||
| 775 | after-change-functions | 777 | after-change-functions |
| 776 | (from (point))) | 778 | (from (point))) |
| 777 | (apply 'insert args) | 779 | (apply 'insert args) |
| @@ -1120,6 +1122,7 @@ When not inside a field, move to the previous button or field." | |||
| 1120 | "Setup current buffer so editing string widgets works." | 1122 | "Setup current buffer so editing string widgets works." |
| 1121 | (let ((inhibit-read-only t) | 1123 | (let ((inhibit-read-only t) |
| 1122 | (after-change-functions nil) | 1124 | (after-change-functions nil) |
| 1125 | before-change-functions | ||
| 1123 | field) | 1126 | field) |
| 1124 | (while widget-field-new | 1127 | (while widget-field-new |
| 1125 | (setq field (car widget-field-new) | 1128 | (setq field (car widget-field-new) |
| @@ -1134,9 +1137,11 @@ When not inside a field, move to the previous button or field." | |||
| 1134 | (widget-clear-undo) | 1137 | (widget-clear-undo) |
| 1135 | ;; We need to maintain text properties and size of the editing fields. | 1138 | ;; We need to maintain text properties and size of the editing fields. |
| 1136 | (make-local-variable 'after-change-functions) | 1139 | (make-local-variable 'after-change-functions) |
| 1137 | (if widget-field-list | 1140 | (make-local-variable 'before-change-functions) |
| 1138 | (setq after-change-functions '(widget-after-change)) | 1141 | (setq after-change-functions |
| 1139 | (setq after-change-functions nil))) | 1142 | (if widget-field-list '(widget-after-change) nil)) |
| 1143 | (setq before-change-functions | ||
| 1144 | (if widget-field-list '(widget-before-change) nil))) | ||
| 1140 | 1145 | ||
| 1141 | (defvar widget-field-last nil) | 1146 | (defvar widget-field-last nil) |
| 1142 | ;; Last field containing point. | 1147 | ;; Last field containing point. |
| @@ -1180,6 +1185,14 @@ Unlike (get-char-property POS 'field) this, works with empty fields too." | |||
| 1180 | (setq found field)))) | 1185 | (setq found field)))) |
| 1181 | found)) | 1186 | found)) |
| 1182 | 1187 | ||
| 1188 | ;; This is how, for example, a variable changes its state to "set" | ||
| 1189 | ;; when it is being edited. | ||
| 1190 | (defun widget-before-change (from &rest ignore) | ||
| 1191 | (condition-case nil | ||
| 1192 | (let ((field (widget-field-find from))) | ||
| 1193 | (widget-apply field :notify field)) | ||
| 1194 | (error (debug "After Change")))) | ||
| 1195 | |||
| 1183 | (defun widget-after-change (from to old) | 1196 | (defun widget-after-change (from to old) |
| 1184 | ;; Adjust field size and text properties. | 1197 | ;; Adjust field size and text properties. |
| 1185 | (condition-case nil | 1198 | (condition-case nil |
| @@ -1223,8 +1236,7 @@ Unlike (get-char-property POS 'field) this, works with empty fields too." | |||
| 1223 | (unless (eq old secret) | 1236 | (unless (eq old secret) |
| 1224 | (subst-char-in-region begin (1+ begin) old secret) | 1237 | (subst-char-in-region begin (1+ begin) old secret) |
| 1225 | (put-text-property begin (1+ begin) 'secret old)) | 1238 | (put-text-property begin (1+ begin) 'secret old)) |
| 1226 | (setq begin (1+ begin))))))) | 1239 | (setq begin (1+ begin))))))))) |
| 1227 | (widget-apply field :notify field))) | ||
| 1228 | (error (debug "After Change")))) | 1240 | (error (debug "After Change")))) |
| 1229 | 1241 | ||
| 1230 | ;;; Widget Functions | 1242 | ;;; Widget Functions |
| @@ -1435,6 +1447,7 @@ If that does not exists, call the value of `widget-complete-field'." | |||
| 1435 | (to (widget-get widget :to)) | 1447 | (to (widget-get widget :to)) |
| 1436 | (inactive-overlay (widget-get widget :inactive)) | 1448 | (inactive-overlay (widget-get widget :inactive)) |
| 1437 | (button-overlay (widget-get widget :button-overlay)) | 1449 | (button-overlay (widget-get widget :button-overlay)) |
| 1450 | before-change-functions | ||
| 1438 | after-change-functions | 1451 | after-change-functions |
| 1439 | (inhibit-read-only t)) | 1452 | (inhibit-read-only t)) |
| 1440 | (widget-apply widget :value-delete) | 1453 | (widget-apply widget :value-delete) |
| @@ -1636,6 +1649,22 @@ If END is omitted, it defaults to the length of LIST." | |||
| 1636 | "Open the info node specified by WIDGET." | 1649 | "Open the info node specified by WIDGET." |
| 1637 | (Info-goto-node (widget-value widget))) | 1650 | (Info-goto-node (widget-value widget))) |
| 1638 | 1651 | ||
| 1652 | ;;; The `group-link' Widget. | ||
| 1653 | |||
| 1654 | (define-widget 'group-link 'link | ||
| 1655 | "A link to a customization group." | ||
| 1656 | :create 'widget-group-link-create | ||
| 1657 | :action 'widget-group-link-action) | ||
| 1658 | |||
| 1659 | (defun widget-group-link-create (widget) | ||
| 1660 | (let ((state (widget-get (widget-get widget :parent) :custom-state))) | ||
| 1661 | (if (eq state 'hidden) | ||
| 1662 | (widget-default-create widget)))) | ||
| 1663 | |||
| 1664 | (defun widget-group-link-action (widget &optional event) | ||
| 1665 | "Open the info node specified by WIDGET." | ||
| 1666 | (customize-group (widget-value widget))) | ||
| 1667 | |||
| 1639 | ;;; The `url-link' Widget. | 1668 | ;;; The `url-link' Widget. |
| 1640 | 1669 | ||
| 1641 | (define-widget 'url-link 'link | 1670 | (define-widget 'url-link 'link |
| @@ -2422,6 +2451,7 @@ when he invoked the menu." | |||
| 2422 | (save-excursion | 2451 | (save-excursion |
| 2423 | (let ((children (widget-get widget :children)) | 2452 | (let ((children (widget-get widget :children)) |
| 2424 | (inhibit-read-only t) | 2453 | (inhibit-read-only t) |
| 2454 | before-change-functions | ||
| 2425 | after-change-functions) | 2455 | after-change-functions) |
| 2426 | (cond (before | 2456 | (cond (before |
| 2427 | (goto-char (widget-get before :entry-from))) | 2457 | (goto-char (widget-get before :entry-from))) |
| @@ -2448,6 +2478,7 @@ when he invoked the menu." | |||
| 2448 | (let ((buttons (copy-sequence (widget-get widget :buttons))) | 2478 | (let ((buttons (copy-sequence (widget-get widget :buttons))) |
| 2449 | button | 2479 | button |
| 2450 | (inhibit-read-only t) | 2480 | (inhibit-read-only t) |
| 2481 | before-change-functions | ||
| 2451 | after-change-functions) | 2482 | after-change-functions) |
| 2452 | (while buttons | 2483 | (while buttons |
| 2453 | (setq button (car buttons) | 2484 | (setq button (car buttons) |
| @@ -2459,6 +2490,7 @@ when he invoked the menu." | |||
| 2459 | (let ((entry-from (widget-get child :entry-from)) | 2490 | (let ((entry-from (widget-get child :entry-from)) |
| 2460 | (entry-to (widget-get child :entry-to)) | 2491 | (entry-to (widget-get child :entry-to)) |
| 2461 | (inhibit-read-only t) | 2492 | (inhibit-read-only t) |
| 2493 | before-change-functions | ||
| 2462 | after-change-functions) | 2494 | after-change-functions) |
| 2463 | (widget-delete child) | 2495 | (widget-delete child) |
| 2464 | (delete-region entry-from entry-to) | 2496 | (delete-region entry-from entry-to) |
| @@ -2579,8 +2611,8 @@ when he invoked the menu." | |||
| 2579 | :format "%[%v%]" | 2611 | :format "%[%v%]" |
| 2580 | :button-prefix "" | 2612 | :button-prefix "" |
| 2581 | :button-suffix "" | 2613 | :button-suffix "" |
| 2582 | :on "hide" | 2614 | :on "Hide" |
| 2583 | :off "show" | 2615 | :off "Show" |
| 2584 | :value-create 'widget-visibility-value-create | 2616 | :value-create 'widget-visibility-value-create |
| 2585 | :action 'widget-toggle-action | 2617 | :action 'widget-toggle-action |
| 2586 | :match (lambda (widget value) t)) | 2618 | :match (lambda (widget value) t)) |
| @@ -2596,13 +2628,30 @@ when he invoked the menu." | |||
| 2596 | (setq on "")) | 2628 | (setq on "")) |
| 2597 | (if off | 2629 | (if off |
| 2598 | (setq off (concat widget-push-button-prefix | 2630 | (setq off (concat widget-push-button-prefix |
| 2599 | off | 2631 | off |
| 2600 | widget-push-button-suffix)) | 2632 | widget-push-button-suffix)) |
| 2601 | (setq off "")) | 2633 | (setq off "")) |
| 2602 | (if (widget-value widget) | 2634 | (if (widget-value widget) |
| 2603 | (widget-glyph-insert widget on "down" "down-pushed") | 2635 | (widget-glyph-insert widget on "down" "down-pushed") |
| 2604 | (widget-glyph-insert widget off "right" "right-pushed") | 2636 | (widget-glyph-insert widget off "right" "right-pushed")))) |
| 2605 | (insert "...")))) | 2637 | |
| 2638 | (define-widget 'group-visibility 'item | ||
| 2639 | "An indicator and manipulator for hidden group contents." | ||
| 2640 | :format "%[%v%]" | ||
| 2641 | :create 'widget-group-visibility-create | ||
| 2642 | :button-prefix "" | ||
| 2643 | :button-suffix "" | ||
| 2644 | :on "Hide" | ||
| 2645 | :off "Show" | ||
| 2646 | :value-create 'widget-visibility-value-create | ||
| 2647 | :action 'widget-toggle-action | ||
| 2648 | :match (lambda (widget value) t)) | ||
| 2649 | |||
| 2650 | (defun widget-group-visibility-create (widget) | ||
| 2651 | (let ((visible (widget-value widget))) | ||
| 2652 | (if visible | ||
| 2653 | (insert "--------"))) | ||
| 2654 | (widget-default-create widget)) | ||
| 2606 | 2655 | ||
| 2607 | ;;; The `documentation-link' Widget. | 2656 | ;;; The `documentation-link' Widget. |
| 2608 | ;; | 2657 | ;; |
| @@ -2697,7 +2746,7 @@ link for that string." | |||
| 2697 | (push (widget-create-child-and-convert | 2746 | (push (widget-create-child-and-convert |
| 2698 | widget 'visibility | 2747 | widget 'visibility |
| 2699 | :help-echo "Show or hide rest of the documentation." | 2748 | :help-echo "Show or hide rest of the documentation." |
| 2700 | :off nil | 2749 | :off "More" |
| 2701 | :action 'widget-parent-action | 2750 | :action 'widget-parent-action |
| 2702 | shown) | 2751 | shown) |
| 2703 | buttons) | 2752 | buttons) |
| @@ -3047,7 +3096,7 @@ It will read a directory name from the minibuffer when invoked." | |||
| 3047 | (define-widget 'choice 'menu-choice | 3096 | (define-widget 'choice 'menu-choice |
| 3048 | "A union of several sexp types." | 3097 | "A union of several sexp types." |
| 3049 | :tag "Choice" | 3098 | :tag "Choice" |
| 3050 | :format "%{%t%}: %[value menu%] %v" | 3099 | :format "%{%t%}: %[Value Menu%] %v" |
| 3051 | :button-prefix 'widget-push-button-prefix | 3100 | :button-prefix 'widget-push-button-prefix |
| 3052 | :button-suffix 'widget-push-button-suffix | 3101 | :button-suffix 'widget-push-button-suffix |
| 3053 | :prompt-value 'widget-choice-prompt-value) | 3102 | :prompt-value 'widget-choice-prompt-value) |
| @@ -3116,7 +3165,9 @@ It will read a directory name from the minibuffer when invoked." | |||
| 3116 | :prompt-value 'widget-boolean-prompt-value | 3165 | :prompt-value 'widget-boolean-prompt-value |
| 3117 | :button-prefix 'widget-push-button-prefix | 3166 | :button-prefix 'widget-push-button-prefix |
| 3118 | :button-suffix 'widget-push-button-suffix | 3167 | :button-suffix 'widget-push-button-suffix |
| 3119 | :format "%{%t%}: %[toggle%] %v\n") | 3168 | :format "%{%t%}: %[Toggle%] %v\n" |
| 3169 | :on "on (non-nil)" | ||
| 3170 | :off "off (nil)") | ||
| 3120 | 3171 | ||
| 3121 | (defun widget-boolean-prompt-value (widget prompt value unbound) | 3172 | (defun widget-boolean-prompt-value (widget prompt value unbound) |
| 3122 | ;; Toggle a boolean. | 3173 | ;; Toggle a boolean. |