diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index dc481d4d0a5..b7673b01c73 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -555,6 +555,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) @@ -2439,10 +2462,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. @@ -2498,15 +2527,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. @@ -2677,8 +2709,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. @@ -2728,14 +2763,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. @@ -2755,13 +2793,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))