unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: Mauro Aranda <maurooaranda@gmail.com>
To: 45829@debbugs.gnu.org
Subject: bug#45829: 28.0.50; Some tweaks to the color widget, from wid-edit+.el
Date: Tue, 12 Jan 2021 19:23:03 -0300	[thread overview]
Message-ID: <5ffe2149.1c69fb81.b9bf6.0d1d@mx.google.com> (raw)
In-Reply-To: <5ffe1f20.1c69fb81.77469.0e30@mx.google.com> (Mauro Aranda's message of "Tue, 12 Jan 2021 19:13:50 -0300")

[-- Attachment #1: Type: text/plain, Size: 141 bytes --]

tags 45829 patch
quit

(CCing Drew)

I attach one patch with the changes, and one patch with a test for the
new :match function.

Opinions?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch --]
[-- Type: text/x-patch, Size: 1986 bytes --]

From 8a3a2f8b92708175c62a3b4efd7eb00228c5011a Mon Sep 17 00:00:00 2001
From: Drew Adams <drew.adams@oracle.com>
Date: Tue, 12 Jan 2021 19:14:19 -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.
---
 lisp/wid-edit.el | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 8b10d71dcb..19e58f5345 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -4024,17 +4024,18 @@ 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 (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)
@@ -4083,6 +4084,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: Test --]
[-- Type: text/x-patch, Size: 1282 bytes --]

From 5d6bc24b3b16307361d6411e1b4f1e3735664125 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..c410b8e367 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


  reply	other threads:[~2021-01-12 22:23 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 [this message]
2021-01-15 22:22   ` Basil L. Contovounesios
2021-01-16  7:09     ` Eli Zaretskii
2021-01-16 12:10     ` Mauro Aranda
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=5ffe2149.1c69fb81.b9bf6.0d1d@mx.google.com \
    --to=maurooaranda@gmail.com \
    --cc=45829@debbugs.gnu.org \
    /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).