Add new face 'widget-unselected' to wid-edit.el

* doc/misc/widget.texi (Customization): Document it.

* etc/NEWS: Announce 'widget-unselected' face.

* lisp/wid-edit.el (widget-unselected): New face.
(widget-specify-unselected, widget-specify-selected): New functions.
(widget-checkbox-action, widget-checklist-add-item)
(widget-radio-add-item, widget-radio-value-set)
(widget-radio-action): Use them.
This commit is contained in:
Stephen Berman 2024-06-26 08:42:19 +02:00
parent 1809f6a93e
commit 8d354925dd
3 changed files with 74 additions and 17 deletions

View file

@ -3287,6 +3287,16 @@ Face used for pressed buttons.
Face used for inactive widgets. Face used for inactive widgets.
@end deffn @end deffn
@deffn Face widget-unselected
Face used for unselected widgets. This face is also used on the text
labels of radio-button and checkbox widgets.
The default value inherits from the @code{widget-inactive} face. If you
want to visually distinguish the labels of unselected active
radio-button or checkbox widgets from the labels of unselected inactive
widgets, customize this face to a non-default value.
@end deffn
@defopt widget-mouse-face @defopt widget-mouse-face
Face used for highlighting a button when the mouse pointer moves Face used for highlighting a button when the mouse pointer moves
across it. across it.

View file

@ -1906,6 +1906,12 @@ options of GNU 'ls'.
** Widget ** Widget
+++ +++
*** New face 'widget-unselected'.
Customize this face to a non-default value to visually distinguish the
labels of unselected active radio-button or checkbox widgets from the
labels of unselected inactive widgets (the default value inherits from
the 'widget-inactive' face).
*** New user option 'widget-skip-inactive'. *** New user option 'widget-skip-inactive'.
If non-nil, moving point forward or backward between widgets by typing If non-nil, moving point forward or backward between widgets by typing
'TAB' or 'S-TAB' skips over inactive widgets. The default value is nil. 'TAB' or 'S-TAB' skips over inactive widgets. The default value is nil.

View file

@ -568,6 +568,29 @@ With CHECK-AFTER non-nil, considers also the content after point, if needed."
(delete-overlay inactive) (delete-overlay inactive)
(widget-put widget :inactive nil)))) (widget-put widget :inactive nil))))
(defface widget-unselected
'((t :inherit widget-inactive))
"Face used for unselected widgets."
:group 'widget-faces
:version "30.1")
(defun widget-specify-unselected (widget from to)
"Fontify WIDGET as unselected."
(let ((overlay (make-overlay from to nil t nil)))
(overlay-put overlay 'face 'widget-unselected)
(overlay-put overlay 'evaporate t)
;; The overlay priority here should be lower than the priority in
;; `widget-specify-active' (bug#69942).
(overlay-put overlay 'priority 90)
(widget-put widget :unselected overlay)))
(defun widget-specify-selected (widget)
"Remove fontification of WIDGET as unselected."
(let ((unselected (widget-get widget :unselected)))
(when unselected
(delete-overlay unselected)
(widget-put widget :unselected nil))))
;;; Widget Properties. ;;; Widget Properties.
(defsubst widget-type (widget) (defsubst widget-type (widget)
@ -2450,10 +2473,16 @@ when he invoked the menu."
(defun widget-checkbox-action (widget &optional event) (defun widget-checkbox-action (widget &optional event)
"Toggle checkbox, notify parent, and set active state of sibling." "Toggle checkbox, notify parent, and set active state of sibling."
(widget-toggle-action widget event) (widget-toggle-action widget event)
(let ((sibling (widget-get-sibling widget))) (let* ((sibling (widget-get-sibling widget))
(from (widget-get sibling :from))
(to (widget-get sibling :to)))
(when sibling (when sibling
(widget-apply sibling (if (widget-value widget)
(if (widget-value widget) :activate :deactivate)) (progn
(widget-apply sibling :activate)
(widget-specify-selected sibling))
:deactivate
(widget-specify-unselected sibling from to))
(widget-clear-undo)))) (widget-clear-undo))))
;;; The `checklist' Widget. ;;; The `checklist' Widget.
@ -2509,15 +2538,18 @@ If the item is checked, CHOSEN is a cons whose cdr is the value."
((eq escape ?v) ((eq escape ?v)
(setq child (setq child
(cond ((not chosen) (cond ((not chosen)
(let ((child (widget-create-child widget type))) (let* ((child (widget-create-child widget type))
(widget-apply child :deactivate) (from (widget-get child :from))
(to (widget-get child :to)))
(widget-specify-unselected child from to)
child)) child))
((widget-inline-p type t) ((widget-inline-p type t)
(widget-create-child-value (widget-create-child-value
widget type (cdr chosen))) widget type (cdr chosen)))
(t (t
(widget-create-child-value (widget-create-child-value
widget type (car (cdr chosen))))))) widget type (car (cdr chosen)))
(widget-specify-selected child)))))
(t (t
(error "Unknown escape `%c'" escape))))) (error "Unknown escape `%c'" escape)))))
;; Update properties. ;; Update properties.
@ -2688,8 +2720,11 @@ Return an alist of (TYPE MATCH)."
(widget-create-child-value (widget-create-child-value
widget type value) widget type value)
(widget-create-child widget type))) (widget-create-child widget type)))
(unless chosen (if chosen
(widget-apply child :deactivate))) (widget-specify-selected child)
(let ((from (widget-get child :from))
(to (widget-get child :to)))
(widget-specify-unselected child from to))))
(t (t
(error "Unknown escape `%c'" escape))))) (error "Unknown escape `%c'" escape)))))
;; Update properties. ;; Update properties.
@ -2739,14 +2774,17 @@ Return an alist of (TYPE MATCH)."
(dolist (current (widget-get widget :children)) (dolist (current (widget-get widget :children))
(let* ((button (widget-get current :button)) (let* ((button (widget-get current :button))
(match (and (not found) (match (and (not found)
(widget-apply current :match value)))) (widget-apply current :match value)))
(from (widget-get current :from))
(to (widget-get current :to)))
(widget-value-set button match) (widget-value-set button match)
(if match (if match
(progn (progn
(widget-value-set current value) (widget-value-set current value)
(widget-apply current :activate)) (widget-apply current :activate)
(widget-apply current :deactivate)) (widget-specify-selected current))
(setq found (or found match)))))) (widget-specify-unselected current from to))
(setq found (or found match))))))
(defun widget-radio-validate (widget) (defun widget-radio-validate (widget)
;; Valid if we have made a valid choice. ;; Valid if we have made a valid choice.
@ -2766,13 +2804,16 @@ Return an alist of (TYPE MATCH)."
(let ((buttons (widget-get widget :buttons))) (let ((buttons (widget-get widget :buttons)))
(when (memq child buttons) (when (memq child buttons)
(dolist (current (widget-get widget :children)) (dolist (current (widget-get widget :children))
(let* ((button (widget-get current :button))) (let* ((button (widget-get current :button))
(from (widget-get current :from))
(to (widget-get current :to)))
(cond ((eq child button) (cond ((eq child button)
(widget-value-set button t) (widget-value-set button t)
(widget-apply current :activate)) (widget-apply current :activate)
(widget-specify-selected current))
((widget-value button) ((widget-value button)
(widget-value-set button nil) (widget-value-set button nil)
(widget-apply current :deactivate))))))) (widget-specify-unselected current from to)))))))
;; Pass notification to parent. ;; Pass notification to parent.
(widget-apply widget :notify child event)) (widget-apply widget :notify child event))