From cb385d3821a59f3039bbf96d7daa1ff29de1c3a4 Mon Sep 17 00:00:00 2001 From: Dave Love Date: Tue, 20 Feb 2001 10:59:03 +0000 Subject: [PATCH] (widget-convert-text): Respect personality for Emacspeak. (insert/delete-button): New widget type. (widget-insert/delete-button-action, widget-list-item-insert) (widget-list-item-delete): New functions. (insert-button): Change :tag, :help-echo. (delete-button, widget-delete-button-action): Deleted. (editable-list): Change :entry-format. (widget-editable-list-entry-create): Use ins/del. Process %-, not %i, %d. --- lisp/wid-edit.el | 152 +++++++++++++++++++++++++++++++---------------- 1 file changed, 100 insertions(+), 52 deletions(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 91476df3278..6228092cb6f 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -757,13 +757,17 @@ button end points. Optional ARGS are extra keyword arguments for TYPE." (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args)) (from (copy-marker from)) - (to (copy-marker to))) + (to (copy-marker to)) + (personality (get-text-property from 'personality))) (set-marker-insertion-type from t) (set-marker-insertion-type to nil) (widget-put widget :from from) (widget-put widget :to to) (when button-from (widget-specify-button widget button-from button-to)) + ;; W3 provides advice for this for Emacspeak's benefit. + (if personality + (put-text-property from to 'personality personality)) widget)) (defun widget-convert-button (type from to &rest args) @@ -851,16 +855,23 @@ Recommended as a parent keymap for modes using widgets.") "Invoke the button that the mouse is pointing at." (interactive "@e") (if (widget-event-point event) - (progn - (mouse-set-point event) - (let* ((pos (widget-event-point event)) - (button (get-char-property pos 'button))) - (if button + (let* ((pos (widget-event-point event)) + (button (get-char-property pos 'button))) + (if button + ;; Mouse click on a widget button. Do the following + ;; in a save-excursion so that the click on the button + ;; doesn't change point. + (save-selected-window (save-excursion + (mouse-set-point event) (let* ((overlay (widget-get button :button-overlay)) (face (overlay-get overlay 'face)) (mouse-face (overlay-get overlay 'mouse-face))) (unwind-protect + ;; Read events, including mouse-movement events + ;; until we receive a release event. Highlight/ + ;; unhighlight the button the mouse was initially + ;; on when we move over it. (let ((track-mouse t)) (save-excursion (when face ; avoid changing around image @@ -884,18 +895,25 @@ Recommended as a parent keymap for modes using widgets.") widget-button-pressed-face)) (overlay-put overlay 'face face) (overlay-put overlay 'mouse-face mouse-face)))) + + ;; When mouse is released over the button, run + ;; its action function. (when (and pos (eq (get-char-property pos 'button) button)) (widget-apply-action button event)))) (overlay-put overlay 'face face) (overlay-put overlay 'mouse-face mouse-face)))) - ;; Not on a button. Find the global command to run, and - ;; check whether it is bound to an up event. Avoid a - ;; `save-excursion' here, since a global command may - ;; to change point, e.g. like `mouse-drag-drag' does. - (let ((up t) - command) + (unless (pos-visible-in-window-p (widget-event-point event)) + (mouse-set-point event) + (beginning-of-line) + (recenter))) + + (let ((up t) command) + ;; Mouse click not on a widget button. Find the global + ;; command to run, and check whether it is bound to an + ;; up event. + (mouse-set-point event) (if (memq (event-basic-type event) '(mouse-1 down-mouse-1)) (cond ((setq command ;down event (lookup-key widget-global-map [down-mouse-1])) @@ -913,10 +931,6 @@ Recommended as a parent keymap for modes using widgets.") (setq event (read-event)))) (when command (call-interactively command))))) - (unless (pos-visible-in-window-p (widget-event-point event)) - (mouse-set-point event) - (beginning-of-line) - (recenter))) (message "You clicked somewhere weird."))) (defun widget-button-press (pos &optional event) @@ -2363,12 +2377,51 @@ Return an alist of (TYPE MATCH)." ;; Pass notification to parent. (widget-apply widget :notify child event)) +;;; The `insert/delete-button' Widget. + +(define-widget 'insert/delete-button 'push-button + "An insert/delete item button for the `editable-list' widget." + :create (lambda (widget) + (let* ((map (make-sparse-keymap)) + (parent (widget-get widget :keymap))) + (if parent + (set-keymap-parent map parent)) + (define-key map [?\C-k] #'widget-list-item-delete) + (define-key map [?\C-o] #'widget-list-item-insert) + (widget-put widget :keymap map)) + (widget-default-create widget)) + :tag "+/-" + :help-echo "Insert or delete a new item into the list here" + :action 'widget-insert/delete-button-action) + +(defun widget-insert/delete-button-action (widget &optional event) + "Ask the parent to insert or delete a new item." + (if (y-or-n-p "Delete this item? (otherwise insert a new one)") + (widget-apply (widget-get widget :parent) + :delete-at (widget-get widget :widget)) + (widget-apply (widget-get widget :parent) + :insert-before (widget-get widget :widget)))) + +(defun widget-list-item-insert () + "Delete the list item widget which is the parent of the widget at point." + (interactive) + (let ((widget (widget-at (point)))) + (widget-apply (widget-get widget :parent) + :insert-before (widget-get widget :widget)))) + +(defun widget-list-item-delete () + "Add a new list item widget after the parent of the widget at point." + (interactive) + (let ((widget (widget-at (point)))) + (widget-apply (widget-get widget :parent) + :delete-at (widget-get widget :widget)))) + ;;; The `insert-button' Widget. (define-widget 'insert-button 'push-button - "An insert button for the `editable-list' widget." - :tag "INS" - :help-echo "Insert a new item into the list at this position." + "An append item button for the `editable-list' widget." + :tag "+" + :help-echo "Append a new item to the list" :action 'widget-insert-button-action) (defun widget-insert-button-action (widget &optional event) @@ -2376,19 +2429,6 @@ Return an alist of (TYPE MATCH)." (widget-apply (widget-get widget :parent) :insert-before (widget-get widget :widget))) -;;; The `delete-button' Widget. - -(define-widget 'delete-button 'push-button - "A delete button for the `editable-list' widget." - :tag "DEL" - :help-echo "Delete this item from the list." - :action 'widget-delete-button-action) - -(defun widget-delete-button-action (widget &optional event) - ;; Ask the parent to insert a new item. - (widget-apply (widget-get widget :parent) - :delete-at (widget-get widget :widget))) - ;;; The `editable-list' Widget. ;; (defcustom widget-editable-list-gui nil @@ -2402,7 +2442,7 @@ Return an alist of (TYPE MATCH)." :offset 12 :format "%v%i\n" :format-handler 'widget-editable-list-format-handler - :entry-format "%i %d %v" + :entry-format "%- %v" :menu-tag "editable-list" :value-create 'widget-editable-list-value-create :value-delete 'widget-children-value-delete @@ -2526,7 +2566,7 @@ Return an alist of (TYPE MATCH)." ;; Create a new entry to the list. (let ((type (nth 0 (widget-get widget :args))) ;;; (widget-push-button-gui widget-editable-list-gui) - child delete insert) + child ins/del buttons) (widget-specify-insert (save-excursion (and (widget-get widget :indent) @@ -2538,14 +2578,11 @@ Return an alist of (TYPE MATCH)." (delete-backward-char 2) (cond ((eq escape ?%) (insert ?%)) - ((eq escape ?i) - (setq insert (apply 'widget-create-child-and-convert - widget 'insert-button - (widget-get widget :insert-button-args)))) - ((eq escape ?d) - (setq delete (apply 'widget-create-child-and-convert - widget 'delete-button - (widget-get widget :delete-button-args)))) + ((eq escape ?-) + (setq ins/del (apply 'widget-create-child-and-convert + widget 'insert/delete-button + (widget-get widget + :insert/delete-button-args)))) ((eq escape ?v) (if conv (setq child (widget-create-child-value @@ -2556,18 +2593,17 @@ Return an alist of (TYPE MATCH)." (widget-default-get type)))))) (t (error "Unknown escape `%c'" escape))))) - (widget-put widget - :buttons (cons delete - (cons insert - (widget-get widget :buttons)))) + (setq buttons (widget-get widget :buttons)) + (if ins/del + (push ins/del buttons)) + (widget-put widget :buttons buttons) (let ((entry-from (point-min-marker)) (entry-to (point-max-marker))) (set-marker-insertion-type entry-from t) (set-marker-insertion-type entry-to nil) (widget-put child :entry-from entry-from) (widget-put child :entry-to entry-to))) - (widget-put insert :widget child) - (widget-put delete :widget child) + (if ins/del (widget-put ins/del :widget child)) child)) ;;; The `group' Widget. @@ -2955,7 +2991,7 @@ It will read a directory name from the minibuffer when invoked." (defvar widget-function-prompt-value-history nil "History of input to `widget-function-prompt-value'.") -(define-widget 'function 'sexp +(define-widget 'function 'restricted-sexp "A Lisp function." :complete-function (lambda () (interactive) @@ -2965,7 +3001,16 @@ It will read a directory name from the minibuffer when invoked." :prompt-match 'fboundp :prompt-history 'widget-function-prompt-value-history :action 'widget-field-action - :match-alternatives '(functionp) + :match-alternatives (list 'functionp + ;; Allow symbols that might be fbound + ;; later, e.g. for hook custom widgets. + ;; Disallow t, nil and keywords. + (lambda (s) + (and (symbolp s) + (if (boundp s) + (not (eq s (symbol-value s))) + t)))) + :type-error "This value should contain a function" :validate (lambda (widget) (unless (functionp (widget-value widget)) (widget-put widget :error (format "Invalid function: %S" @@ -2978,6 +3023,7 @@ It will read a directory name from the minibuffer when invoked." "History of input to `widget-variable-prompt-value'.") (define-widget 'variable 'symbol + ;; Should complete on variables. "A Lisp variable." :prompt-match 'boundp :prompt-history 'widget-variable-prompt-value-history @@ -3198,10 +3244,11 @@ To use this type, you must define :match or :match-alternatives." (defun widget-plist-convert-widget (widget) ;; Handle `:options'. (let* ((options (widget-get widget :options)) + (widget-plist-value-type (widget-get widget :value-type)) (other `(editable-list :inline t (group :inline t ,(widget-get widget :key-type) - ,(widget-get widget :value-type)))) + ,widget-plist-value-type))) (args (if options (list `(checklist :inline t :greedy t @@ -3242,10 +3289,11 @@ To use this type, you must define :match or :match-alternatives." (defun widget-alist-convert-widget (widget) ;; Handle `:options'. (let* ((options (widget-get widget :options)) + (widget-alist-value-type (widget-get widget :value-type)) (other `(editable-list :inline t (cons :format "%v" ,(widget-get widget :key-type) - ,(widget-get widget :value-type)))) + ,widget-alist-value-type))) (args (if options (list `(checklist :inline t :greedy t -- 2.39.5