From c6753d66ff2e253664f1a10c606c19d902046974 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Sat, 21 Jun 1997 05:13:41 +0000 Subject: [PATCH] (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. --- lisp/wid-edit.el | 79 +++++++++++++++++++++++++++++++++++++++--------- 1 file 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." (save-restriction (let ((inhibit-read-only t) result + before-change-functions after-change-functions) (insert "<>") (narrow-to-region (- (point) 2) (point)) @@ -772,6 +773,7 @@ The optional ARGS are additional keyword arguments." (defun widget-insert (&rest args) "Call `insert' with ARGS and make the text read only." (let ((inhibit-read-only t) + before-change-functions after-change-functions (from (point))) (apply 'insert args) @@ -1120,6 +1122,7 @@ When not inside a field, move to the previous button or field." "Setup current buffer so editing string widgets works." (let ((inhibit-read-only t) (after-change-functions nil) + before-change-functions field) (while widget-field-new (setq field (car widget-field-new) @@ -1134,9 +1137,11 @@ When not inside a field, move to the previous button or field." (widget-clear-undo) ;; We need to maintain text properties and size of the editing fields. (make-local-variable 'after-change-functions) - (if widget-field-list - (setq after-change-functions '(widget-after-change)) - (setq after-change-functions nil))) + (make-local-variable 'before-change-functions) + (setq after-change-functions + (if widget-field-list '(widget-after-change) nil)) + (setq before-change-functions + (if widget-field-list '(widget-before-change) nil))) (defvar widget-field-last nil) ;; Last field containing point. @@ -1180,6 +1185,14 @@ Unlike (get-char-property POS 'field) this, works with empty fields too." (setq found field)))) found)) +;; This is how, for example, a variable changes its state to "set" +;; when it is being edited. +(defun widget-before-change (from &rest ignore) + (condition-case nil + (let ((field (widget-field-find from))) + (widget-apply field :notify field)) + (error (debug "After Change")))) + (defun widget-after-change (from to old) ;; Adjust field size and text properties. (condition-case nil @@ -1223,8 +1236,7 @@ Unlike (get-char-property POS 'field) this, works with empty fields too." (unless (eq old secret) (subst-char-in-region begin (1+ begin) old secret) (put-text-property begin (1+ begin) 'secret old)) - (setq begin (1+ begin))))))) - (widget-apply field :notify field))) + (setq begin (1+ begin))))))))) (error (debug "After Change")))) ;;; Widget Functions @@ -1435,6 +1447,7 @@ If that does not exists, call the value of `widget-complete-field'." (to (widget-get widget :to)) (inactive-overlay (widget-get widget :inactive)) (button-overlay (widget-get widget :button-overlay)) + before-change-functions after-change-functions (inhibit-read-only t)) (widget-apply widget :value-delete) @@ -1636,6 +1649,22 @@ If END is omitted, it defaults to the length of LIST." "Open the info node specified by WIDGET." (Info-goto-node (widget-value widget))) +;;; The `group-link' Widget. + +(define-widget 'group-link 'link + "A link to a customization group." + :create 'widget-group-link-create + :action 'widget-group-link-action) + +(defun widget-group-link-create (widget) + (let ((state (widget-get (widget-get widget :parent) :custom-state))) + (if (eq state 'hidden) + (widget-default-create widget)))) + +(defun widget-group-link-action (widget &optional event) + "Open the info node specified by WIDGET." + (customize-group (widget-value widget))) + ;;; The `url-link' Widget. (define-widget 'url-link 'link @@ -2422,6 +2451,7 @@ when he invoked the menu." (save-excursion (let ((children (widget-get widget :children)) (inhibit-read-only t) + before-change-functions after-change-functions) (cond (before (goto-char (widget-get before :entry-from))) @@ -2448,6 +2478,7 @@ when he invoked the menu." (let ((buttons (copy-sequence (widget-get widget :buttons))) button (inhibit-read-only t) + before-change-functions after-change-functions) (while buttons (setq button (car buttons) @@ -2459,6 +2490,7 @@ when he invoked the menu." (let ((entry-from (widget-get child :entry-from)) (entry-to (widget-get child :entry-to)) (inhibit-read-only t) + before-change-functions after-change-functions) (widget-delete child) (delete-region entry-from entry-to) @@ -2579,8 +2611,8 @@ when he invoked the menu." :format "%[%v%]" :button-prefix "" :button-suffix "" - :on "hide" - :off "show" + :on "Hide" + :off "Show" :value-create 'widget-visibility-value-create :action 'widget-toggle-action :match (lambda (widget value) t)) @@ -2596,13 +2628,30 @@ when he invoked the menu." (setq on "")) (if off (setq off (concat widget-push-button-prefix - off - widget-push-button-suffix)) + off + widget-push-button-suffix)) (setq off "")) (if (widget-value widget) (widget-glyph-insert widget on "down" "down-pushed") - (widget-glyph-insert widget off "right" "right-pushed") - (insert "...")))) + (widget-glyph-insert widget off "right" "right-pushed")))) + +(define-widget 'group-visibility 'item + "An indicator and manipulator for hidden group contents." + :format "%[%v%]" + :create 'widget-group-visibility-create + :button-prefix "" + :button-suffix "" + :on "Hide" + :off "Show" + :value-create 'widget-visibility-value-create + :action 'widget-toggle-action + :match (lambda (widget value) t)) + +(defun widget-group-visibility-create (widget) + (let ((visible (widget-value widget))) + (if visible + (insert "--------"))) + (widget-default-create widget)) ;;; The `documentation-link' Widget. ;; @@ -2697,7 +2746,7 @@ link for that string." (push (widget-create-child-and-convert widget 'visibility :help-echo "Show or hide rest of the documentation." - :off nil + :off "More" :action 'widget-parent-action shown) buttons) @@ -3047,7 +3096,7 @@ It will read a directory name from the minibuffer when invoked." (define-widget 'choice 'menu-choice "A union of several sexp types." :tag "Choice" - :format "%{%t%}: %[value menu%] %v" + :format "%{%t%}: %[Value Menu%] %v" :button-prefix 'widget-push-button-prefix :button-suffix 'widget-push-button-suffix :prompt-value 'widget-choice-prompt-value) @@ -3116,7 +3165,9 @@ It will read a directory name from the minibuffer when invoked." :prompt-value 'widget-boolean-prompt-value :button-prefix 'widget-push-button-prefix :button-suffix 'widget-push-button-suffix - :format "%{%t%}: %[toggle%] %v\n") + :format "%{%t%}: %[Toggle%] %v\n" + :on "on (non-nil)" + :off "off (nil)") (defun widget-boolean-prompt-value (widget prompt value unbound) ;; Toggle a boolean. -- 2.39.2