diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 172da3db1e0..005aa918087 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -555,6 +555,27 @@ widget-specify-active (delete-overlay inactive) (widget-put widget :inactive nil)))) +(defface widget-unselected + '((t :inherit shadow)) + "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) + (overlay-put overlay 'priority 100) + (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) @@ -2415,10 +2436,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. @@ -2474,15 +2501,19 @@ 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))) + widget type (cdr chosen)) + (widget-specify-selected child)) (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. @@ -2653,8 +2684,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. @@ -2704,14 +2738,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. @@ -2731,13 +2768,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))