master ba0cf1d 1/2: Tweaks to the color widget (Bug#45829)

[Mauro Aranda]

branch: master
commit ba0cf1d7017894ff9e539cba83881865b3a025a1
Author: Drew Adams <drew.adams@oracle.com>
Commit: Mauro Aranda <maurooaranda@gmail.com>

    Tweaks to the color widget (Bug#45829)
    
    * lisp/wid-edit.el (widget-color-match, widget-color-validate): New
    functions.
    (color): Use the new functions.  Base size on longest defined color
    name, defaulting to the longest RGB hex string.
---
 lisp/wid-edit.el | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 7dda04e..68a0d3d 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -4026,17 +4026,19 @@ is inline."
 
 ;;; The `color' Widget.
 
-;; Fixme: match
 (define-widget 'color 'editable-field
   "Choose a color name (with sample)."
   :format "%{%t%}: %v (%{sample%})\n"
   :value-create 'widget-color-value-create
-  :size 10
+  :size (1+ (apply #'max 13 ; Longest RGB hex string.
+                   (mapcar #'length (defined-colors))))
   :tag "Color"
   :value "black"
   :completions (or facemenu-color-alist (defined-colors))
   :sample-face-get 'widget-color-sample-face-get
   :notify 'widget-color-notify
+  :match #'widget-color-match
+  :validate #'widget-color-validate
   :action 'widget-color-action)
 
 (defun widget-color-value-create (widget)
@@ -4085,6 +4087,19 @@ is inline."
   (overlay-put (widget-get widget :sample-overlay)
               'face (widget-apply widget :sample-face-get))
   (widget-default-notify widget child event))
+
+(defun widget-color-match (_widget value)
+  "Non-nil if VALUE is a defined color or a RGB hex string."
+  (and (stringp value)
+       (or (color-defined-p value)
+           (string-match-p "^#\\(?:[[:xdigit:]]\\{3\\}\\)\\{1,4\\}$" value))))
+
+(defun widget-color-validate (widget)
+  "Check that WIDGET's value is a valid color."
+  (let ((value (widget-value widget)))
+    (unless (widget-color-match widget value)
+      (widget-put widget :error (format "Invalid color: %S" value))
+      widget)))
 
 ;;; The Help Echo