wid-edit.el: Cosmetic changes
* lisp/wid-edit.el: Use #' to quote function names. (widget--simplify-menu, widget-echo-help): Explicitly specify the lexenv to `eval`. (widget-choose, widget-get-sibling, widget-setup, widget-field-find) (widget-choice-action, widget-checklist-value-get) (widget-radio-value-create, widget-radio-value-set) (widget-radio-action, widget-editable-list-delete-at) (widget-group-value-create, widget-choice-prompt-value): Use `dolist`. (widget-convert): Hoist `(setq current` out of the ifs. (widget-convert): Hoist `(setq keys` out of the if. (widget-after-change): Hoist `(setq begin` out of the if. (widget-default-completions): Use `cond`. (widget-default-value-set): Hoist `goto-char` out of the if. (widget-choice-action): Hoist `nth` out of the if. (widget-checkbox-action): Hoist `widget-apply` out of the if. (widget-editable-list-value-create): Hoist `car` out of the if. (widget-editable-list-entry-create): Hoist `(setq child ...` out of the if. (widget-documentation-link-action): Fold `if` into `cond`. (widget-key-sequence-value-to-external): Use `key-parse`. (widget-plist-convert-option, widget-alist-convert-option): Hoist `(setq key-type` out of the if.
This commit is contained in:
Stefan Monnier
parent
3a902db97a
commit
129bc91a2c
1 changed files with 159 additions and 204 deletions
363
lisp/wid-edit.el
363
lisp/wid-edit.el
|
|
@ -1,4 +1,4 @@
|
|||
;;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*-
|
||||
;; wid-edit.el --- Functions for creating and using widgets -*- lexical-binding:t -*-
|
||||
;;
|
||||
;; Copyright (C) 1996-1997, 1999-2024 Free Software Foundation, Inc.
|
||||
;;
|
||||
|
|
@ -247,10 +247,10 @@ to evaluate to nil for the menu item to be meaningful."
|
|||
(eq (car value) :radio))
|
||||
(setq selected (cdr value))))
|
||||
(setq plist (cddr plist)))
|
||||
(when (and (eval visible)
|
||||
(eval enable)
|
||||
(when (and (eval visible t)
|
||||
(eval enable t)
|
||||
(or (not selected)
|
||||
(not (eval selected))))
|
||||
(not (eval selected t))))
|
||||
(push (cons (nth 1 def) ev) simplified)))))
|
||||
extended)
|
||||
(reverse simplified)))
|
||||
|
|
@ -317,7 +317,7 @@ in the key vector, as in the argument of `define-key'."
|
|||
(when (keymapp items)
|
||||
(setq items (widget--simplify-menu items)))
|
||||
;; Read the choice of name from the minibuffer.
|
||||
(setq items (cl-remove-if 'stringp items))
|
||||
(setq items (cl-remove-if #'stringp items))
|
||||
(let ((val (completing-read (concat title ": ") items nil t)))
|
||||
(if (stringp val)
|
||||
(let ((try (try-completion val items)))
|
||||
|
|
@ -330,12 +330,11 @@ in the key vector, as in the argument of `define-key'."
|
|||
;; Construct a menu of the choices
|
||||
;; and then use it for prompting for a single character.
|
||||
(let ((next-digit ?0)
|
||||
alist choice some-choice-enabled value)
|
||||
alist some-choice-enabled value)
|
||||
(with-current-buffer (get-buffer-create " widget-choose")
|
||||
(erase-buffer)
|
||||
(insert "Available choices:\n\n")
|
||||
(while items
|
||||
(setq choice (pop items))
|
||||
(dolist (choice items)
|
||||
(when (consp choice)
|
||||
(insert (format "%c = %s\n" next-digit (car choice)))
|
||||
(push (cons next-digit (cdr choice)) alist)
|
||||
|
|
@ -665,12 +664,9 @@ The current value is assumed to be VALUE, unless UNBOUND is non-nil."
|
|||
(defun widget-get-sibling (widget)
|
||||
"Get the item WIDGET is assumed to toggle.
|
||||
This is only meaningful for radio buttons or checkboxes in a list."
|
||||
(let* ((children (widget-get (widget-get widget :parent) :children))
|
||||
child)
|
||||
(let* ((children (widget-get (widget-get widget :parent) :children)))
|
||||
(catch 'child
|
||||
(while children
|
||||
(setq child (car children)
|
||||
children (cdr children))
|
||||
(dolist (child children)
|
||||
(when (eq (widget-get child :button) widget)
|
||||
(throw 'child child)))
|
||||
nil)))
|
||||
|
|
@ -850,14 +846,14 @@ button is pressed or inactive, respectively. These are currently ignored."
|
|||
(defun widget-create (type &rest args)
|
||||
"Create widget of TYPE.
|
||||
The optional ARGS are additional keyword arguments."
|
||||
(let ((widget (apply 'widget-convert type args)))
|
||||
(let ((widget (apply #'widget-convert type args)))
|
||||
(widget-apply widget :create)
|
||||
widget))
|
||||
|
||||
(defun widget-create-child-and-convert (parent type &rest args)
|
||||
"As part of the widget PARENT, create a child widget TYPE.
|
||||
The child is converted, using the keyword arguments ARGS."
|
||||
(let ((widget (apply 'widget-convert type args)))
|
||||
(let ((widget (apply #'widget-convert type args)))
|
||||
(widget-put widget :parent parent)
|
||||
(unless (widget-get widget :indent)
|
||||
(widget-put widget :indent (+ (or (widget-get parent :indent) 0)
|
||||
|
|
@ -911,18 +907,19 @@ The optional ARGS are additional keyword arguments."
|
|||
(keys args))
|
||||
;; First set the :args keyword.
|
||||
(while (cdr current) ;Look in the type.
|
||||
(if (and (keywordp (cadr current))
|
||||
;; If the last element is a keyword,
|
||||
;; it is still the :args element,
|
||||
;; even though it is a keyword.
|
||||
(cddr current))
|
||||
(if (eq (cadr current) :args)
|
||||
;; If :args is explicitly specified, obey it.
|
||||
(setq current nil)
|
||||
;; Some other irrelevant keyword.
|
||||
(setq current (cdr (cdr current))))
|
||||
(setcdr current (list :args (cdr current)))
|
||||
(setq current nil)))
|
||||
(setq current
|
||||
(if (and (keywordp (cadr current))
|
||||
;; If the last element is a keyword,
|
||||
;; it is still the :args element,
|
||||
;; even though it is a keyword.
|
||||
(cddr current))
|
||||
(if (eq (cadr current) :args)
|
||||
;; If :args is explicitly specified, obey it.
|
||||
nil
|
||||
;; Some other irrelevant keyword.
|
||||
(cdr (cdr current)))
|
||||
(setcdr current (list :args (cdr current)))
|
||||
nil)))
|
||||
(while (and args (not done)) ;Look in ARGS.
|
||||
(cond ((eq (car args) :args)
|
||||
;; Handle explicit specification of :args.
|
||||
|
|
@ -943,11 +940,9 @@ The optional ARGS are additional keyword arguments."
|
|||
;; Finally set the keyword args.
|
||||
(while keys
|
||||
(let ((next (nth 0 keys)))
|
||||
(if (keywordp next)
|
||||
(progn
|
||||
(widget-put widget next (nth 1 keys))
|
||||
(setq keys (nthcdr 2 keys)))
|
||||
(setq keys nil))))
|
||||
(setq keys (when (keywordp next)
|
||||
(widget-put widget next (nth 1 keys))
|
||||
(nthcdr 2 keys)))))
|
||||
;; Convert the :value to internal format.
|
||||
(if (widget-member widget :value)
|
||||
(widget-put widget
|
||||
|
|
@ -972,7 +967,7 @@ and TO will be used as the widgets end points. If optional arguments
|
|||
BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
|
||||
button end points.
|
||||
Optional ARGS are extra keyword arguments for TYPE."
|
||||
(let ((widget (apply 'widget-convert type :delete 'widget-leave-text args))
|
||||
(let ((widget (apply #'widget-convert type :delete 'widget-leave-text args))
|
||||
(from (copy-marker from))
|
||||
(to (copy-marker to)))
|
||||
(set-marker-insertion-type from t)
|
||||
|
|
@ -989,7 +984,7 @@ Optional ARGS are extra keyword arguments for TYPE.
|
|||
No text will be inserted to the buffer, instead the text between FROM
|
||||
and TO will be used as the widgets end points, as well as the widgets
|
||||
button end points."
|
||||
(apply 'widget-convert-text type from to from to args))
|
||||
(apply #'widget-convert-text type from to from to args))
|
||||
|
||||
(defun widget-leave-text (widget)
|
||||
"Remove markers and overlays from WIDGET and its children."
|
||||
|
|
@ -1007,7 +1002,7 @@ button end points."
|
|||
(delete-overlay doc))
|
||||
(when field
|
||||
(delete-overlay field))
|
||||
(mapc 'widget-leave-text (widget-get widget :children))))
|
||||
(mapc #'widget-leave-text (widget-get widget :children))))
|
||||
|
||||
(defun widget-text (widget)
|
||||
"Get the text representation of the widget."
|
||||
|
|
@ -1022,7 +1017,7 @@ button end points."
|
|||
;; Custom-mode) which key-binding of widget-keymap one wants to refer to.
|
||||
;; https://lists.gnu.org/r/emacs-devel/2008-11/msg00480.html
|
||||
(define-obsolete-function-alias 'advertised-widget-backward
|
||||
'widget-backward "23.2")
|
||||
#'widget-backward "23.2")
|
||||
|
||||
;;;###autoload
|
||||
(defvar widget-keymap
|
||||
|
|
@ -1048,13 +1043,13 @@ Note that such modes will need to require wid-edit.")
|
|||
|
||||
(defvar widget-field-keymap
|
||||
(let ((map (copy-keymap widget-keymap)))
|
||||
(define-key map "\C-k" 'widget-kill-line)
|
||||
(define-key map "\M-\t" 'widget-complete)
|
||||
(define-key map "\C-m" 'widget-field-activate)
|
||||
(define-key map "\C-k" #'widget-kill-line)
|
||||
(define-key map "\M-\t" #'widget-complete)
|
||||
(define-key map "\C-m" #'widget-field-activate)
|
||||
;; Since the widget code uses a `field' property to identify fields,
|
||||
;; ordinary beginning-of-line does the right thing.
|
||||
;; (define-key map "\C-a" 'widget-beginning-of-line)
|
||||
(define-key map "\C-e" 'widget-end-of-line)
|
||||
;; (define-key map "\C-a" #'widget-beginning-of-line)
|
||||
(define-key map "\C-e" #'widget-end-of-line)
|
||||
map)
|
||||
"Keymap used inside an editable field.")
|
||||
|
||||
|
|
@ -1062,8 +1057,8 @@ Note that such modes will need to require wid-edit.")
|
|||
(let ((map (copy-keymap widget-keymap)))
|
||||
;; Since the widget code uses a `field' property to identify fields,
|
||||
;; ordinary beginning-of-line does the right thing.
|
||||
;; (define-key map "\C-a" 'widget-beginning-of-line)
|
||||
(define-key map "\C-e" 'widget-end-of-line)
|
||||
;; (define-key map "\C-a" #'widget-beginning-of-line)
|
||||
(define-key map "\C-e" #'widget-end-of-line)
|
||||
map)
|
||||
"Keymap used inside a text field.")
|
||||
|
||||
|
|
@ -1304,7 +1299,7 @@ With optional ARG, move across that many fields."
|
|||
|
||||
;; Since the widget code uses a `field' property to identify fields,
|
||||
;; ordinary beginning-of-line does the right thing.
|
||||
(defalias 'widget-beginning-of-line 'beginning-of-line)
|
||||
(defalias 'widget-beginning-of-line #'beginning-of-line)
|
||||
|
||||
(defun widget-end-of-line ()
|
||||
"Go to end of field or end of line, whichever is first.
|
||||
|
|
@ -1382,17 +1377,14 @@ When not inside a field, signal an error."
|
|||
(defun widget-setup ()
|
||||
"Setup current buffer so editing string widgets works."
|
||||
(widget--allow-insertion
|
||||
(let (field)
|
||||
(while widget-field-new
|
||||
(setq field (car widget-field-new)
|
||||
widget-field-new (cdr widget-field-new)
|
||||
widget-field-list (cons field widget-field-list))
|
||||
(let ((from (car (widget-get field :field-overlay)))
|
||||
(to (cdr (widget-get field :field-overlay))))
|
||||
(widget-specify-field field
|
||||
(marker-position from) (marker-position to))
|
||||
(set-marker from nil)
|
||||
(set-marker to nil)))))
|
||||
(dolist (field widget-field-new)
|
||||
(push field widget-field-list)
|
||||
(let ((from (car (widget-get field :field-overlay)))
|
||||
(to (cdr (widget-get field :field-overlay))))
|
||||
(widget-specify-field field
|
||||
(marker-position from) (marker-position to))
|
||||
(set-marker from nil)
|
||||
(set-marker to nil))))
|
||||
(widget-clear-undo)
|
||||
(widget-add-change))
|
||||
|
||||
|
|
@ -1467,11 +1459,8 @@ When not inside a field, signal an error."
|
|||
(defun widget-field-find (pos)
|
||||
"Return the field at POS.
|
||||
Unlike (get-char-property POS \\='field), this works with empty fields too."
|
||||
(let ((fields widget-field-list)
|
||||
field found)
|
||||
(while fields
|
||||
(setq field (car fields)
|
||||
fields (cdr fields))
|
||||
(let (found)
|
||||
(dolist (field widget-field-list)
|
||||
(when (and (<= (widget-field-start field) pos)
|
||||
(<= pos (widget-field-end field)))
|
||||
(when found
|
||||
|
|
@ -1486,11 +1475,11 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
|
|||
(let ((from-field (widget-field-find from))
|
||||
(to-field (widget-field-find to)))
|
||||
(cond ((not (eq from-field to-field))
|
||||
(add-hook 'post-command-hook 'widget-add-change nil t)
|
||||
(add-hook 'post-command-hook #'widget-add-change nil t)
|
||||
(signal 'text-read-only
|
||||
'("Change should be restricted to a single field")))
|
||||
((null from-field)
|
||||
(add-hook 'post-command-hook 'widget-add-change nil t)
|
||||
(add-hook 'post-command-hook #'widget-add-change nil t)
|
||||
(signal 'text-read-only
|
||||
'("Attempt to change text outside editable field")))
|
||||
(widget-field-use-before-change
|
||||
|
|
@ -1498,9 +1487,9 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
|
|||
from-field (list 'before-change from to)))))))
|
||||
|
||||
(defun widget-add-change ()
|
||||
(remove-hook 'post-command-hook 'widget-add-change t)
|
||||
(add-hook 'before-change-functions 'widget-before-change nil t)
|
||||
(add-hook 'after-change-functions 'widget-after-change nil t))
|
||||
(remove-hook 'post-command-hook #'widget-add-change t)
|
||||
(add-hook 'before-change-functions #'widget-before-change nil t)
|
||||
(add-hook 'after-change-functions #'widget-after-change nil t))
|
||||
|
||||
(defun widget-after-change (from to _old)
|
||||
"Adjust field size and text properties."
|
||||
|
|
@ -1520,12 +1509,12 @@ Unlike (get-char-property POS \\='field), this works with empty fields too."
|
|||
(insert-char ?\s (- (+ begin size) end))))
|
||||
((> (- end begin) size)
|
||||
;; Field too large and
|
||||
(if (or (< (point) (+ begin size))
|
||||
(> (point) end))
|
||||
;; Point is outside extra space.
|
||||
(setq begin (+ begin size))
|
||||
;; Point is within the extra space.
|
||||
(setq begin (point)))
|
||||
(setq begin (if (or (< (point) (+ begin size))
|
||||
(> (point) end))
|
||||
;; Point is outside extra space.
|
||||
(+ begin size)
|
||||
;; Point is within the extra space.
|
||||
(point)))
|
||||
(save-excursion
|
||||
(goto-char end)
|
||||
(while (and (eq (preceding-char) ?\s)
|
||||
|
|
@ -1545,9 +1534,9 @@ Optional EVENT is the event that triggered the action."
|
|||
|
||||
(defun widget-children-value-delete (widget)
|
||||
"Delete all :children and :buttons in WIDGET."
|
||||
(mapc 'widget-delete (widget-get widget :children))
|
||||
(mapc #'widget-delete (widget-get widget :children))
|
||||
(widget-put widget :children nil)
|
||||
(mapc 'widget-delete (widget-get widget :buttons))
|
||||
(mapc #'widget-delete (widget-get widget :buttons))
|
||||
(widget-put widget :buttons nil))
|
||||
|
||||
(defun widget-children-validate (widget)
|
||||
|
|
@ -1598,13 +1587,13 @@ The value of the :type attribute should be an unconverted widget type."
|
|||
|
||||
(defun widget-types-copy (widget)
|
||||
"Copy :args as widget types in WIDGET."
|
||||
(widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
|
||||
(widget-put widget :args (mapcar #'widget-copy (widget-get widget :args)))
|
||||
widget)
|
||||
|
||||
;; Made defsubst to speed up face editor creation.
|
||||
(defsubst widget-types-convert-widget (widget)
|
||||
"Convert :args as widget types in WIDGET."
|
||||
(widget-put widget :args (mapcar 'widget-convert (widget-get widget :args)))
|
||||
(widget-put widget :args (mapcar #'widget-convert (widget-get widget :args)))
|
||||
widget)
|
||||
|
||||
(defun widget-value-convert-widget (widget)
|
||||
|
|
@ -1659,17 +1648,18 @@ The value of the :type attribute should be an unconverted widget type."
|
|||
(defun widget-default-completions (widget)
|
||||
"Return completion data, like `completion-at-point-functions' would."
|
||||
(let ((completions (widget-get widget :completions)))
|
||||
(if completions
|
||||
(list (widget-field-start widget)
|
||||
(max (point) (widget-field-text-end widget))
|
||||
completions)
|
||||
(if (widget-get widget :complete)
|
||||
(lambda () (widget-apply widget :complete))
|
||||
(if (widget-get widget :complete-function)
|
||||
(lambda ()
|
||||
(let ((widget--completing-widget widget))
|
||||
(call-interactively
|
||||
(widget-get widget :complete-function)))))))))
|
||||
(cond
|
||||
(completions
|
||||
(list (widget-field-start widget)
|
||||
(max (point) (widget-field-text-end widget))
|
||||
completions))
|
||||
((widget-get widget :complete)
|
||||
(lambda () (widget-apply widget :complete)))
|
||||
((widget-get widget :complete-function)
|
||||
(lambda ()
|
||||
(let ((widget--completing-widget widget))
|
||||
(call-interactively
|
||||
(widget-get widget :complete-function))))))))
|
||||
|
||||
(defun widget-default-create (widget)
|
||||
"Create WIDGET at point in the current buffer."
|
||||
|
|
@ -1814,9 +1804,9 @@ The value of the :type attribute should be an unconverted widget type."
|
|||
(widget-put widget :value value)
|
||||
(widget-apply widget :create))
|
||||
(if offset
|
||||
(if (< offset 0)
|
||||
(goto-char (+ (widget-get widget :to) offset 1))
|
||||
(goto-char (min (+ from offset) (1- (widget-get widget :to))))))))
|
||||
(goto-char (if (< offset 0)
|
||||
(+ (widget-get widget :to) offset 1)
|
||||
(min (+ from offset) (1- (widget-get widget :to))))))))
|
||||
|
||||
(defun widget-default-value-inline (widget)
|
||||
"Wrap value in a list unless it is inline."
|
||||
|
|
@ -1979,8 +1969,8 @@ as the argument to `documentation-property'."
|
|||
;; Only bind mouse-2, since mouse-1 will be translated accordingly to
|
||||
;; the customization of `mouse-1-click-follows-link'.
|
||||
(define-key map [down-mouse-1] (lookup-key widget-global-map [down-mouse-1]))
|
||||
(define-key map [down-mouse-2] 'widget-button-click)
|
||||
(define-key map [mouse-2] 'widget-button-click)
|
||||
(define-key map [down-mouse-2] #'widget-button-click)
|
||||
(define-key map [mouse-2] #'widget-button-click)
|
||||
map)
|
||||
"Keymap used inside a link widget.")
|
||||
|
||||
|
|
@ -2328,13 +2318,10 @@ when he invoked the menu."
|
|||
((and widget-choice-toggle
|
||||
(= (length args) 2)
|
||||
(memq old args))
|
||||
(if (eq old (nth 0 args))
|
||||
(nth 1 args)
|
||||
(nth 0 args)))
|
||||
(nth (if (eq old (nth 0 args)) 1 0)
|
||||
args))
|
||||
(t
|
||||
(while args
|
||||
(setq current (car args)
|
||||
args (cdr args))
|
||||
(dolist (current args)
|
||||
(setq choices
|
||||
(cons (cons (widget-apply current :menu-tag-get)
|
||||
current)
|
||||
|
|
@ -2427,9 +2414,8 @@ when he invoked the menu."
|
|||
(widget-toggle-action widget event)
|
||||
(let ((sibling (widget-get-sibling widget)))
|
||||
(when sibling
|
||||
(if (widget-value widget)
|
||||
(widget-apply sibling :activate)
|
||||
(widget-apply sibling :deactivate))
|
||||
(widget-apply sibling
|
||||
(if (widget-value widget) :activate :deactivate))
|
||||
(widget-clear-undo))))
|
||||
|
||||
;;; The `checklist' Widget.
|
||||
|
|
@ -2478,7 +2464,7 @@ If the item is checked, CHOSEN is a cons whose cdr is the value."
|
|||
(cond ((eq escape ?%)
|
||||
(insert ?%))
|
||||
((eq escape ?b)
|
||||
(setq button (apply 'widget-create-child-and-convert
|
||||
(setq button (apply #'widget-create-child-and-convert
|
||||
widget 'checkbox
|
||||
:value (not (null chosen))
|
||||
button-args)))
|
||||
|
|
@ -2558,11 +2544,8 @@ Return an alist of (TYPE MATCH)."
|
|||
|
||||
(defun widget-checklist-value-get (widget)
|
||||
;; The values of all selected items.
|
||||
(let ((children (widget-get widget :children))
|
||||
child result)
|
||||
(while children
|
||||
(setq child (car children)
|
||||
children (cdr children))
|
||||
(let (result)
|
||||
(dolist (child (widget-get widget :children))
|
||||
(if (widget-value (widget-get child :button))
|
||||
(setq result (append result (widget-apply child :value-inline)))))
|
||||
result))
|
||||
|
|
@ -2630,12 +2613,8 @@ Return an alist of (TYPE MATCH)."
|
|||
|
||||
(defun widget-radio-value-create (widget)
|
||||
;; Insert all values
|
||||
(let ((args (widget-get widget :args))
|
||||
arg)
|
||||
(while args
|
||||
(setq arg (car args)
|
||||
args (cdr args))
|
||||
(widget-radio-add-item widget arg))))
|
||||
(dolist (arg (widget-get widget :args))
|
||||
(widget-radio-add-item widget arg)))
|
||||
|
||||
(defun widget-radio-add-item (widget type)
|
||||
"Add to radio widget WIDGET a new radio button item of type TYPE."
|
||||
|
|
@ -2662,7 +2641,7 @@ Return an alist of (TYPE MATCH)."
|
|||
(cond ((eq escape ?%)
|
||||
(insert ?%))
|
||||
((eq escape ?b)
|
||||
(setq button (apply 'widget-create-child-and-convert
|
||||
(setq button (apply #'widget-create-child-and-convert
|
||||
widget 'radio-button
|
||||
:value (not (null chosen))
|
||||
button-args)))
|
||||
|
|
@ -2718,11 +2697,8 @@ Return an alist of (TYPE MATCH)."
|
|||
;; We can't just delete and recreate a radio widget, since children
|
||||
;; can be added after the original creation and won't be recreated
|
||||
;; by `:create'.
|
||||
(let ((children (widget-get widget :children))
|
||||
current found)
|
||||
(while children
|
||||
(setq current (car children)
|
||||
children (cdr children))
|
||||
(let (found)
|
||||
(dolist (current (widget-get widget :children))
|
||||
(let* ((button (widget-get current :button))
|
||||
(match (and (not found)
|
||||
(widget-apply current :match value))))
|
||||
|
|
@ -2749,13 +2725,9 @@ Return an alist of (TYPE MATCH)."
|
|||
|
||||
(defun widget-radio-action (widget child event)
|
||||
;; Check if a radio button was pressed.
|
||||
(let ((children (widget-get widget :children))
|
||||
(buttons (widget-get widget :buttons))
|
||||
current)
|
||||
(let ((buttons (widget-get widget :buttons)))
|
||||
(when (memq child buttons)
|
||||
(while children
|
||||
(setq current (car children)
|
||||
children (cdr children))
|
||||
(dolist (current (widget-get widget :children))
|
||||
(let* ((button (widget-get current :button)))
|
||||
(cond ((eq child button)
|
||||
(widget-value-set button t)
|
||||
|
|
@ -2825,7 +2797,7 @@ Return an alist of (TYPE MATCH)."
|
|||
(and (widget--should-indent-p)
|
||||
(widget-get widget :indent)
|
||||
(insert-char ?\s (widget-get widget :indent)))
|
||||
(apply 'widget-create-child-and-convert
|
||||
(apply #'widget-create-child-and-convert
|
||||
widget 'insert-button
|
||||
(widget-get widget :append-button-args)))
|
||||
(t
|
||||
|
|
@ -2845,9 +2817,9 @@ Return an alist of (TYPE MATCH)."
|
|||
(if answer
|
||||
(setq children (cons (widget-editable-list-entry-create
|
||||
widget
|
||||
(if (widget-inline-p type t)
|
||||
(car answer)
|
||||
(car (car answer)))
|
||||
(car (if (widget-inline-p type t)
|
||||
answer
|
||||
(car answer)))
|
||||
t)
|
||||
children)
|
||||
value (cdr answer))
|
||||
|
|
@ -2856,8 +2828,8 @@ Return an alist of (TYPE MATCH)."
|
|||
|
||||
(defun widget-editable-list-value-get (widget)
|
||||
;; Get value of the child widget.
|
||||
(apply 'append (mapcar (lambda (child) (widget-apply child :value-inline))
|
||||
(widget-get widget :children))))
|
||||
(apply #'append (mapcar (lambda (child) (widget-apply child :value-inline))
|
||||
(widget-get widget :children))))
|
||||
|
||||
(defun widget-editable-list-match (widget value)
|
||||
;; Value must be a list and all the members must match the type.
|
||||
|
|
@ -2923,16 +2895,12 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
|
|||
(widget-put widget :last-deleted lst))
|
||||
;; Delete child from list of children.
|
||||
(save-excursion
|
||||
(let ((buttons (copy-sequence (widget-get widget :buttons)))
|
||||
button)
|
||||
(widget--allow-insertion
|
||||
(while buttons
|
||||
(setq button (car buttons)
|
||||
buttons (cdr buttons))
|
||||
(when (eq (widget-get button :widget) child)
|
||||
(widget-put widget
|
||||
:buttons (delq button (widget-get widget :buttons)))
|
||||
(widget-delete button)))))
|
||||
(widget--allow-insertion
|
||||
(dolist (button (copy-sequence (widget-get widget :buttons)))
|
||||
(when (eq (widget-get button :widget) child)
|
||||
(widget-put widget
|
||||
:buttons (delq button (widget-get widget :buttons)))
|
||||
(widget-delete button))))
|
||||
(let ((entry-from (widget-get child :entry-from))
|
||||
(entry-to (widget-get child :entry-to)))
|
||||
(widget--allow-insertion
|
||||
|
|
@ -2962,19 +2930,17 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
|
|||
(cond ((eq escape ?%)
|
||||
(insert ?%))
|
||||
((eq escape ?i)
|
||||
(setq insert (apply 'widget-create-child-and-convert
|
||||
(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
|
||||
(setq delete (apply #'widget-create-child-and-convert
|
||||
widget 'delete-button
|
||||
(widget-get widget :delete-button-args))))
|
||||
((eq escape ?v)
|
||||
(if conv
|
||||
(setq child (widget-create-child-value
|
||||
widget type value))
|
||||
(setq child (widget-create-child-value
|
||||
widget type (widget-default-get type)))))
|
||||
(setq child (widget-create-child-value
|
||||
widget type
|
||||
(if conv value (widget-default-get type)))))
|
||||
(t
|
||||
(error "Unknown escape `%c'" escape)))))
|
||||
(let ((buttons (widget-get widget :buttons)))
|
||||
|
|
@ -3014,13 +2980,10 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
|
|||
|
||||
(defun widget-group-value-create (widget)
|
||||
;; Create each component.
|
||||
(let ((args (widget-get widget :args))
|
||||
(value (widget-get widget :value))
|
||||
arg answer children)
|
||||
(while args
|
||||
(setq arg (car args)
|
||||
args (cdr args)
|
||||
answer (widget-match-inline arg value)
|
||||
(let ((value (widget-get widget :value))
|
||||
answer children)
|
||||
(dolist (arg (widget-get widget :args))
|
||||
(setq answer (widget-match-inline arg value)
|
||||
value (cdr answer))
|
||||
(and (widget--should-indent-p)
|
||||
(widget-get widget :indent)
|
||||
|
|
@ -3036,7 +2999,7 @@ Save CHILD into the :last-deleted list, so it can be inserted later."
|
|||
|
||||
(defun widget-group-default-get (widget)
|
||||
;; Get the default of the components.
|
||||
(mapcar 'widget-default-get (widget-get widget :args)))
|
||||
(mapcar #'widget-default-get (widget-get widget :args)))
|
||||
|
||||
(defun widget-group-match (widget vals)
|
||||
;; Match if the components match.
|
||||
|
|
@ -3094,20 +3057,20 @@ The following properties have special meanings for this widget:
|
|||
"Display documentation for WIDGET's value. Ignore optional argument EVENT."
|
||||
(let* ((string (widget-get widget :value))
|
||||
(symbol (intern string)))
|
||||
(if (and (fboundp symbol) (boundp symbol))
|
||||
;; If there are two doc strings, give the user a way to pick one.
|
||||
(apropos (concat "\\`" (regexp-quote string) "\\'"))
|
||||
(cond
|
||||
((fboundp symbol)
|
||||
(describe-function symbol))
|
||||
((facep symbol)
|
||||
(describe-face symbol))
|
||||
((featurep symbol)
|
||||
(describe-package symbol))
|
||||
((or (boundp symbol) (get symbol 'variable-documentation))
|
||||
(describe-variable symbol))
|
||||
(t
|
||||
(message "No documentation available for %s" symbol))))))
|
||||
(cond
|
||||
((and (fboundp symbol) (boundp symbol))
|
||||
;; If there are two doc strings, give the user a way to pick one.
|
||||
(apropos (concat "\\`" (regexp-quote string) "\\'")))
|
||||
((fboundp symbol)
|
||||
(describe-function symbol))
|
||||
((facep symbol)
|
||||
(describe-face symbol))
|
||||
((featurep symbol)
|
||||
(describe-package symbol))
|
||||
((or (boundp symbol) (get symbol 'variable-documentation))
|
||||
(describe-variable symbol))
|
||||
(t
|
||||
(message "No documentation available for %s" symbol)))))
|
||||
|
||||
(defcustom widget-documentation-links t
|
||||
"Add hyperlinks to documentation strings when non-nil."
|
||||
|
|
@ -3240,7 +3203,7 @@ Optional ARGS specifies additional keyword arguments for the
|
|||
(unless (or (numberp doc-indent) (null doc-indent))
|
||||
(setq doc-indent 0))
|
||||
(widget-put widget :buttons
|
||||
(cons (apply 'widget-create-child-and-convert
|
||||
(cons (apply #'widget-create-child-and-convert
|
||||
widget 'documentation-string
|
||||
:indent doc-indent
|
||||
(nconc args (list doc)))
|
||||
|
|
@ -3352,18 +3315,18 @@ It reads a file name from an editable text field."
|
|||
(must-match (widget-get widget :must-match)))
|
||||
(read-file-name (format-prompt prompt value) dir nil must-match file)))))
|
||||
|
||||
;;;(defun widget-file-action (widget &optional event)
|
||||
;;; ;; Read a file name from the minibuffer.
|
||||
;;; (let* ((value (widget-value widget))
|
||||
;;; (dir (file-name-directory value))
|
||||
;;; (file (file-name-nondirectory value))
|
||||
;;; (menu-tag (widget-apply widget :menu-tag-get))
|
||||
;;; (must-match (widget-get widget :must-match))
|
||||
;;; (answer (read-file-name (format-prompt menu-tag value)
|
||||
;;; dir nil must-match file)))
|
||||
;;; (widget-value-set widget (abbreviate-file-name answer))
|
||||
;;; (widget-setup)
|
||||
;;; (widget-apply widget :notify widget event)))
|
||||
;;(defun widget-file-action (widget &optional event)
|
||||
;; ;; Read a file name from the minibuffer.
|
||||
;; (let* ((value (widget-value widget))
|
||||
;; (dir (file-name-directory value))
|
||||
;; (file (file-name-nondirectory value))
|
||||
;; (menu-tag (widget-apply widget :menu-tag-get))
|
||||
;; (must-match (widget-get widget :must-match))
|
||||
;; (answer (read-file-name (format-prompt menu-tag value)
|
||||
;; dir nil must-match file)))
|
||||
;; (widget-value-set widget (abbreviate-file-name answer))
|
||||
;; (widget-setup)
|
||||
;; (widget-apply widget :notify widget event)))
|
||||
|
||||
;; Fixme: use file-name-as-directory.
|
||||
(define-widget 'directory 'file
|
||||
|
|
@ -3552,7 +3515,7 @@ It reads a directory name from an editable text field."
|
|||
(if (stringp value)
|
||||
(if (string-match "\\`[[:space:]]*\\'" value)
|
||||
widget-key-sequence-default-value
|
||||
(read-kbd-macro value))
|
||||
(key-parse value))
|
||||
value))
|
||||
|
||||
|
||||
|
|
@ -3825,7 +3788,7 @@ or a list with the default value of each component of the list WIDGET."
|
|||
:format "%{%t%}:\n%v"
|
||||
:match 'widget-vector-match
|
||||
:value-to-internal (lambda (_widget value) (append value nil))
|
||||
:value-to-external (lambda (_widget value) (apply 'vector value)))
|
||||
:value-to-external (lambda (_widget value) (apply #'vector value)))
|
||||
|
||||
(defun widget-vector-match (widget value)
|
||||
(and (vectorp value)
|
||||
|
|
@ -3840,7 +3803,7 @@ or a list with the default value of each component of the list WIDGET."
|
|||
:value-to-internal (lambda (_widget value)
|
||||
(list (car value) (cdr value)))
|
||||
:value-to-external (lambda (_widget value)
|
||||
(apply 'cons value)))
|
||||
(apply #'cons value)))
|
||||
|
||||
(defun widget-cons-match (widget value)
|
||||
(and (consp value)
|
||||
|
|
@ -3927,7 +3890,7 @@ example:
|
|||
(args (if options
|
||||
(list `(checklist :inline t
|
||||
:greedy t
|
||||
,@(mapcar 'widget-plist-convert-option
|
||||
,@(mapcar #'widget-plist-convert-option
|
||||
options))
|
||||
other)
|
||||
(list other))))
|
||||
|
|
@ -3940,9 +3903,7 @@ example:
|
|||
(if (listp option)
|
||||
(let ((key (nth 0 option)))
|
||||
(setq value-type (nth 1 option))
|
||||
(if (listp key)
|
||||
(setq key-type key)
|
||||
(setq key-type `(const ,key))))
|
||||
(setq key-type (if (listp key) key `(const ,key))))
|
||||
(setq key-type `(const ,option)
|
||||
value-type widget-plist-value-type))
|
||||
`(group :format "Key: %v" :inline t ,key-type ,value-type)))
|
||||
|
|
@ -3972,7 +3933,7 @@ example:
|
|||
(args (if options
|
||||
(list `(checklist :inline t
|
||||
:greedy t
|
||||
,@(mapcar 'widget-alist-convert-option
|
||||
,@(mapcar #'widget-alist-convert-option
|
||||
options))
|
||||
other)
|
||||
(list other))))
|
||||
|
|
@ -3985,9 +3946,7 @@ example:
|
|||
(if (listp option)
|
||||
(let ((key (nth 0 option)))
|
||||
(setq value-type (nth 1 option))
|
||||
(if (listp key)
|
||||
(setq key-type key)
|
||||
(setq key-type `(const ,key))))
|
||||
(setq key-type (if (listp key) key `(const ,key))))
|
||||
(setq key-type `(const ,option)
|
||||
value-type widget-alist-value-type))
|
||||
`(cons :format "Key: %v" ,key-type ,value-type)))
|
||||
|
|
@ -4045,17 +4004,13 @@ current choice is inline."
|
|||
((and widget-choice-toggle
|
||||
(= (length args) 2)
|
||||
(memq old args))
|
||||
(if (eq old (nth 0 args))
|
||||
(nth 1 args)
|
||||
(nth 0 args)))
|
||||
(nth (if (eq old (nth 0 args)) 1 0)
|
||||
args))
|
||||
(t
|
||||
(while args
|
||||
(setq current (car args)
|
||||
args (cdr args))
|
||||
(setq choices
|
||||
(cons (cons (widget-apply current :menu-tag-get)
|
||||
current)
|
||||
choices)))
|
||||
(dolist (current args)
|
||||
(push (cons (widget-apply current :menu-tag-get)
|
||||
current)
|
||||
choices))
|
||||
(let ((val (completing-read prompt choices nil t)))
|
||||
(if (stringp val)
|
||||
(let ((try (try-completion val choices)))
|
||||
|
|
@ -4206,7 +4161,7 @@ is inline."
|
|||
(help-echo (and widget (widget-get widget :help-echo))))
|
||||
(if (functionp help-echo)
|
||||
(setq help-echo (funcall help-echo widget)))
|
||||
(if help-echo (message "%s" (eval help-echo)))))
|
||||
(if help-echo (message "%s" (eval help-echo t)))))
|
||||
|
||||
(define-obsolete-function-alias 'widget-sublist #'seq-subseq "28.1")
|
||||
(define-obsolete-function-alias 'widget-visibility-value-create
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue