From 2f47738170a6efb203068ffac892b17fba78d0ec Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Thu, 3 Jul 1997 07:11:10 +0000 Subject: [PATCH] (color-sample, editable-color): New widget types. (widget-button-face): Default value widget-button-face. (widget-default-button-face-get): Use variable widget-button-face. --- lisp/wid-edit.el | 34 +++++++++++++++++++++++++++++----- 1 file changed, 29 insertions(+), 5 deletions(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index d5783d07b17..198599ba6ed 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -157,6 +157,10 @@ This exists as a variable so it can be set locally in certain buffers.") :group 'widget-documentation :group 'widget-faces) +(defvar widget-button-face 'widget-button-face + "Face used for buttons in widges. +This exists as a variable so it can be set locally in certain buffers.") + (defface widget-button-face '((t (:bold t))) "Face used for widget buttons." :group 'widget-faces) @@ -1533,17 +1537,13 @@ If that does not exists, call the value of `widget-complete-field'." (error "Unknown escape `%c'" escape))) (widget-put widget :buttons buttons))) -(defvar widget-button-face nil - "Face to use for buttons. -This is a variable so that it can be buffer-local.") - (defun widget-default-button-face-get (widget) ;; Use :button-face or widget-button-face (or (widget-get widget :button-face) (let ((parent (widget-get widget :parent))) (if parent (widget-apply parent :button-face-get) - 'widget-button-face)))) + widget-button-face)))) (defun widget-default-sample-face-get (widget) ;; Use :sample-face. @@ -3389,6 +3389,30 @@ To use this type, you must define :match or :match-alternatives." (widget-setup) (widget-apply widget :notify widget event)))) +;;; The alternative `editable-color' widget and its subroutine. + +(define-widget 'color-sample 'choice-item + "A color name (with sample)." + :format "(%{sample%})" + :sample-face-get 'widget-color-item-button-face-get) + +(define-widget 'editable-color 'editable-field + "A color name, editable" + :tag "Color" + :format "%{%t%}: %v" + :complete-function 'widget-color-complete + :value-create 'widget-editable-color-value-create + :prompt-match '(lambda (color) (member color widget-color-choice-list)) + :prompt-history 'widget-string-prompt-value-history) + +(defun widget-editable-color-value-create (widget) + (widget-field-value-create widget) + (forward-line -1) + (end-of-line) + (let ((child (widget-create-child-and-convert + widget 'color-sample (widget-get widget :value)))) + (widget-put widget :children (list child)))) + ;;; The Help Echo (defun widget-echo-help-mouse () -- 2.39.2