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)
"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
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]))
(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)
;; 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)
(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
: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
;; 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)
(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
(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.
(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)
: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"
"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
(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
(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
projects / emacs.git / commitdiff