summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDrew Adams <drew.adams@oracle.com>2021-01-19 09:11:18 -0300
committerMauro Aranda <maurooaranda@gmail.com>2021-01-19 09:11:18 -0300
commitba0cf1d7017894ff9e539cba83881865b3a025a1 (patch)
treebb014ab2d4de5f7f1829ab5d11940dfd7d633c9b
parentb62a1e358befe996a4e2f4038ef48a9dd44901f8 (diff)
downloademacs-ba0cf1d7017894ff9e539cba83881865b3a025a1.tar.gz
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.
-rw-r--r--lisp/wid-edit.el19
1 files changed, 17 insertions, 2 deletions
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 7dda04eda21..68a0d3d2356 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