From: Mauro Aranda <maurooaranda@gmail.com>
To: "Basil L. Contovounesios" <contovob@tcd.ie>
Cc: 45829@debbugs.gnu.org
Subject: bug#45829: 28.0.50; Some tweaks to the color widget, from wid-edit+.el
Date: Sat, 16 Jan 2021 09:10:35 -0300 [thread overview]
Message-ID: <6002d7be.1c69fb81.a7260.b538@mx.google.com> (raw)
In-Reply-To: <87v9bxg7rl.fsf@tcd.ie> (Basil L. Contovounesios's message of "Fri, 15 Jan 2021 22:22:38 +0000")
[-- Attachment #1: Type: text/plain, Size: 1813 bytes --]
"Basil L. Contovounesios" <contovob@tcd.ie> writes:
> Mauro Aranda <maurooaranda@gmail.com> writes:
>
>> Opinions?
>
> Just some minor nits from me.
Hi Basil, thanks for taking a look.
>> -;; 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 (mapcar #'length (defined-colors))))
>
> Is defined-colors guaranteed to return non-nil?
> If not, you need (apply #'max 0 ...).
Thanks for catching this one. I modified it so as to default to 13,
which would be the longest hex string.
>> +(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))))
>
> Shouldn't that be "\\`#[[:xdigit:]]\\{3\\}\\{1,4\\}\\'"
> or at least "\\`#\\(?:[[:xdigit:]]\\{3\\}\\)\\{1,4\\}\\'"
> (if you want to be explicit)?
I prefer the latter. I kept the ^ and $, though.
>> +(ert-deftest widget-test-color-match ()
>> + "Test that the :match function for the color widget works."
>> + (let* ((widget (widget-convert 'color)))
>
> Nit: could also be let.
Ah yes, the let* was just a leftover.
>> + (should (widget-apply widget :match "red"))
>> + (should (widget-apply widget :match "#fa3"))
>> + (should (widget-apply widget :match "#ff0000"))
>> + (should (widget-apply widget :match "#111222333"))
>> + (should (widget-apply widget :match "#111122223333"))
>> + (should-not (widget-apply widget :match "someundefinedcolorihope"))
>> + (should-not (widget-apply widget :match "#11223"))))
>
> Thanks,
New patch attached, thanks.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch --]
[-- Type: text/x-patch, Size: 2080 bytes --]
From be6b966173a9d0d455df884d28efcd6aaa0d54f7 Mon Sep 17 00:00:00 2001
From: Drew Adams <drew.adams@oracle.com>
Date: Sat, 16 Jan 2021 08:56:55 -0300
Subject: [PATCH] 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 7dda04eda2..68a0d3d235 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -4026,17 +4026,19 @@ widget-boolean-prompt-value
\f
;;; 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 @@ widget-color-notify
(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)))
\f
;;; The Help Echo
--
2.29.2
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Patch2 --]
[-- Type: text/x-patch, Size: 1281 bytes --]
From 19efd50021fd5e415305bd367d7fbf6a001db987 Mon Sep 17 00:00:00 2001
From: Mauro Aranda <maurooaranda@gmail.com>
Date: Tue, 12 Jan 2021 19:19:21 -0300
Subject: [PATCH] Add test for the widget-color-match function (Bug#45829)
* test/lisp/wid-edit-tests.el (widget-test-color-match): New test.
---
test/lisp/wid-edit-tests.el | 11 +++++++++++
1 file changed, 11 insertions(+)
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el
index 17fdfefce8..f843649784 100644
--- a/test/lisp/wid-edit-tests.el
+++ b/test/lisp/wid-edit-tests.el
@@ -322,4 +322,15 @@ widget-test-widget-move
(widget-backward 1)
(should (string= "Second" (widget-value (widget-at))))))
+(ert-deftest widget-test-color-match ()
+ "Test that the :match function for the color widget works."
+ (let ((widget (widget-convert 'color)))
+ (should (widget-apply widget :match "red"))
+ (should (widget-apply widget :match "#fa3"))
+ (should (widget-apply widget :match "#ff0000"))
+ (should (widget-apply widget :match "#111222333"))
+ (should (widget-apply widget :match "#111122223333"))
+ (should-not (widget-apply widget :match "someundefinedcolorihope"))
+ (should-not (widget-apply widget :match "#11223"))))
+
;;; wid-edit-tests.el ends here
--
2.29.2
next prev parent reply other threads:[~2021-01-16 12:10 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-01-12 22:13 bug#45829: 28.0.50; Some tweaks to the color widget, from wid-edit+.el Mauro Aranda
2021-01-12 22:23 ` Mauro Aranda
2021-01-15 22:22 ` Basil L. Contovounesios
2021-01-16 7:09 ` Eli Zaretskii
2021-01-16 12:10 ` Mauro Aranda [this message]
2021-01-19 6:43 ` Lars Ingebrigtsen
2021-01-19 12:22 ` Mauro Aranda
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=6002d7be.1c69fb81.a7260.b538@mx.google.com \
--to=maurooaranda@gmail.com \
--cc=45829@debbugs.gnu.org \
--cc=contovob@tcd.ie \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).