diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index 2e378e86fc7..8769d9c6191 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -3287,6 +3287,16 @@ Customization Face used for inactive widgets. @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 @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 Face used for highlighting a button when the mouse pointer moves across it. diff --git a/etc/NEWS b/etc/NEWS index d8fa92eb71e..841eb7c9c35 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1906,6 +1906,12 @@ options of GNU 'ls'. ** 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 +'widget-inactive' face). + *** New user option 'widget-skip-inactive'. 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. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 3b467434d29..c86e82f5852 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -568,6 +568,29 @@ widget-specify-active (delete-overlay inactive) (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 (not chosen)." + (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 (not chosen)." + (let ((unselected (widget-get widget :unselected))) + (when unselected + (delete-overlay unselected) + (widget-put widget :unselected nil)))) + ;;; Widget Properties. (defsubst widget-type (widget) @@ -2452,10 +2475,16 @@ 'checkbox (defun widget-checkbox-action (widget &optional event) "Toggle checkbox, notify parent, and set active state of sibling." (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 - (widget-apply sibling - (if (widget-value widget) :activate :deactivate)) + (if (widget-value widget) + (progn + (widget-apply sibling :activate) + (widget-specify-selected sibling)) + :deactivate + (widget-specify-unselected sibling from to)) (widget-clear-undo)))) ;;; The `checklist' Widget. @@ -2511,15 +2540,18 @@ widget-checklist-add-item ((eq escape ?v) (setq child (cond ((not chosen) - (let ((child (widget-create-child widget type))) - (widget-apply child :deactivate) + (let* ((child (widget-create-child widget type)) + (from (widget-get child :from)) + (to (widget-get child :to))) + (widget-specify-unselected child from to) child)) ((widget-inline-p type t) (widget-create-child-value widget type (cdr chosen))) (t (widget-create-child-value - widget type (car (cdr chosen))))))) + widget type (car (cdr chosen))) + (widget-specify-selected child))))) (t (error "Unknown escape `%c'" escape))))) ;; Update properties. @@ -2690,8 +2722,11 @@ widget-radio-add-item (widget-create-child-value widget type value) (widget-create-child widget type))) - (unless chosen - (widget-apply child :deactivate))) + (if chosen + (widget-specify-selected child) + (let ((from (widget-get child :from)) + (to (widget-get child :to))) + (widget-specify-unselected child from to)))) (t (error "Unknown escape `%c'" escape))))) ;; Update properties. @@ -2741,14 +2776,17 @@ widget-radio-value-set (dolist (current (widget-get widget :children)) (let* ((button (widget-get current :button)) (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) (if match - (progn - (widget-value-set current value) - (widget-apply current :activate)) - (widget-apply current :deactivate)) - (setq found (or found match)))))) + (progn + (widget-value-set current value) + (widget-apply current :activate) + (widget-specify-selected current)) + (widget-specify-unselected current from to)) + (setq found (or found match)))))) (defun widget-radio-validate (widget) ;; Valid if we have made a valid choice. @@ -2768,13 +2806,16 @@ widget-radio-action (let ((buttons (widget-get widget :buttons))) (when (memq child buttons) (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) (widget-value-set button t) - (widget-apply current :activate)) + (widget-apply current :activate) + (widget-specify-selected current)) ((widget-value button) (widget-value-set button nil) - (widget-apply current :deactivate))))))) + (widget-specify-unselected current from to))))))) ;; Pass notification to parent. (widget-apply widget :notify child event))