[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 129bc91a2c9 2/2: wid-edit.el: Cosmetic changes
|
From: |
Stefan Monnier |
|
Subject: |
master 129bc91a2c9 2/2: wid-edit.el: Cosmetic changes |
|
Date: |
Thu, 21 Mar 2024 12:10:37 -0400 (EDT) |
branch: master
commit 129bc91a2c9b7a6e314b4a5a4c60c266ca1cac0f
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
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.
---
lisp/wid-edit.el | 363 ++++++++++++++++++++++++-------------------------------
1 file changed, 159 insertions(+), 204 deletions(-)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 0645871f16d..f69a3d3b05f 100644
--- a/lisp/wid-edit.el
+++ b/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