[elpa] externals/compat 1604b929be 1/2: Improve parsing of RGBi color specification

[ELPA Syncer]

branch: externals/compat
commit 1604b929be0bad0368b6e47fe12d0e3d00879731
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    Improve parsing of RGBi color specification
---
 compat-28.el    | 108 +++++++++++++++++++++++++++++++-------------------------
 compat-tests.el |   1 +
 2 files changed, 61 insertions(+), 48 deletions(-)

diff --git a/compat-28.el b/compat-28.el
index 895136b106..b31dbb0b42 100644
--- a/compat-28.el
+++ b/compat-28.el
@@ -260,54 +260,66 @@ If SPEC is not in one of the above forms, return nil.
 
 Each of the 3 integer members of the resulting list, RED, GREEN,
 and BLUE, is normalized to have its value in [0,65535]."
-  (save-match-data
-    (cond
-     ((string-match
-       ;; (rx bos "#"
-       ;;     (or (: (group-n 1 (= 1 hex)) (group-n 2 (= 1 hex)) (group-n 3 (= 
1 hex)))
-       ;;         (: (group-n 1 (= 2 hex)) (group-n 2 (= 2 hex)) (group-n 3 (= 
2 hex)))
-       ;;         (: (group-n 1 (= 3 hex)) (group-n 2 (= 3 hex)) (group-n 3 (= 
3 hex)))
-       ;;         (: (group-n 1 (= 4 hex)) (group-n 2 (= 4 hex)) (group-n 3 (= 
4 hex))))
-       ;;     eos)
-       
"\\`#\\(?:\\(?1:[[:xdigit:]]\\{1\\}\\)\\(?2:[[:xdigit:]]\\{1\\}\\)\\(?3:[[:xdigit:]]\\{1\\}\\)\\|\\(?1:[[:xdigit:]]\\{2\\}\\)\\(?2:[[:xdigit:]]\\{2\\}\\)\\(?3:[[:xdigit:]]\\{2\\}\\)\\|\\(?1:[[:xdigit:]]\\{3\\}\\)\\(?2:[[:xdigit:]]\\{3\\}\\)\\(?3:[[:xdigit:]]\\{3\\}\\)\\|\\(?1:[[:xdigit:]]\\{4\\}\\)\\(?2:[[:xdigit:]]\\{4\\}\\)\\(?3:[[:xdigit:]]\\{4\\}\\)\\)\\'"
-       spec)
-      (let ((max (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4)))))
-        (list (/ (* (string-to-number (match-string 1 spec) 16) 65535) max)
-              (/ (* (string-to-number (match-string 2 spec) 16) 65535) max)
-              (/ (* (string-to-number (match-string 3 spec) 16) 65535) max))))
-     ((string-match
-       ;; (rx bos "rgb:"
-       ;;     (group (** 1 4 hex)) "/"
-       ;;     (group (** 1 4 hex)) "/"
-       ;;     (group (** 1 4 hex))
-       ;;     eos)
-       
"\\`rgb:\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)\\'"
-       spec)
-      (list (/ (* (string-to-number (match-string 1 spec) 16) 65535)
-               (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4))))
-            (/ (* (string-to-number (match-string 2 spec) 16) 65535)
-               (1- (ash 1 (* (- (match-end 2) (match-beginning 2)) 4))))
-            (/ (* (string-to-number (match-string 3 spec) 16) 65535)
-               (1- (ash 1 (* (- (match-end 3) (match-beginning 3)) 4))))))
-     ((string-match
-       ;; (rx bos "rgbi:" (* space)
-       ;;     (group (or (: "0" (? "." (* digit)))
-       ;;                (: "." (+ digit))
-       ;;                (: "1" (? "." (* "0")))))
-       ;;     "/" (* space)
-       ;;     (group (or (: "0" (? "." (* digit)))
-       ;;                (: "." (+ digit))
-       ;;                (: "1" (? "." (* "0")))))
-       ;;     "/" (* space)
-       ;;     (group (or (: "0" (? "." (* digit)))
-       ;;                (: "." (+ digit))
-       ;;                (: "1" (? "." (* "0")))))
-       ;;     eos)
-       
"\\`rgbi:[[:space:]]*\\(0\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\|1\\(?:\\.0*\\)?\\)/[[:space:]]*\\(0\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\|1\\(?:\\.0*\\)?\\)/[[:space:]]*\\(0\\(?:\\.[[:digit:]]*\\)?\\|\\.[[:digit:]]+\\|1\\(?:\\.0*\\)?\\)\\'"
-       spec)
-      (list (round (* (string-to-number (match-string 1 spec)) 65535))
-            (round (* (string-to-number (match-string 2 spec)) 65535))
-            (round (* (string-to-number (match-string 3 spec)) 65535)))))))
+  (let ((case-fold-search nil))
+    (save-match-data
+      (cond
+       ((string-match
+         ;; (rx bos "#"
+         ;;     (or (: (group-n 1 (= 1 hex)) (group-n 2 (= 1 hex)) (group-n 3 
(= 1 hex)))
+         ;;         (: (group-n 1 (= 2 hex)) (group-n 2 (= 2 hex)) (group-n 3 
(= 2 hex)))
+         ;;         (: (group-n 1 (= 3 hex)) (group-n 2 (= 3 hex)) (group-n 3 
(= 3 hex)))
+         ;;         (: (group-n 1 (= 4 hex)) (group-n 2 (= 4 hex)) (group-n 3 
(= 4 hex))))
+         ;;     eos)
+         
"\\`#\\(?:\\(?1:[[:xdigit:]]\\{1\\}\\)\\(?2:[[:xdigit:]]\\{1\\}\\)\\(?3:[[:xdigit:]]\\{1\\}\\)\\|\\(?1:[[:xdigit:]]\\{2\\}\\)\\(?2:[[:xdigit:]]\\{2\\}\\)\\(?3:[[:xdigit:]]\\{2\\}\\)\\|\\(?1:[[:xdigit:]]\\{3\\}\\)\\(?2:[[:xdigit:]]\\{3\\}\\)\\(?3:[[:xdigit:]]\\{3\\}\\)\\|\\(?1:[[:xdigit:]]\\{4\\}\\)\\(?2:[[:xdigit:]]\\{4\\}\\)\\(?3:[[:xdigit:]]\\{4\\}\\)\\)\\'"
+         spec)
+        (let ((max (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4)))))
+          (list (/ (* (string-to-number (match-string 1 spec) 16) 65535) max)
+                (/ (* (string-to-number (match-string 2 spec) 16) 65535) max)
+                (/ (* (string-to-number (match-string 3 spec) 16) 65535) 
max))))
+       ((string-match
+         ;; (rx bos "rgb:"
+         ;;     (group (** 1 4 hex)) "/"
+         ;;     (group (** 1 4 hex)) "/"
+         ;;     (group (** 1 4 hex))
+         ;;     eos)
+         
"\\`rgb:\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)/\\([[:xdigit:]]\\{1,4\\}\\)\\'"
+         spec)
+        (list (/ (* (string-to-number (match-string 1 spec) 16) 65535)
+                 (1- (ash 1 (* (- (match-end 1) (match-beginning 1)) 4))))
+              (/ (* (string-to-number (match-string 2 spec) 16) 65535)
+                 (1- (ash 1 (* (- (match-end 2) (match-beginning 2)) 4))))
+              (/ (* (string-to-number (match-string 3 spec) 16) 65535)
+                 (1- (ash 1 (* (- (match-end 3) (match-beginning 3)) 4))))))
+       ;; The "RGBi" (RGB Intensity) specification is defined by
+       ;; XCMS[0], see [1] for the implementation in Xlib.
+       ;;
+       ;; [0] http://www.nic.funet.fi/pub/X11/X11R4/DOCS/color/Xcms.text
+       ;; [1] 
https://gitlab.freedesktop.org/xorg/lib/libx11/-/blob/master/src/xcms/LRGB.c#L1392
+       ((string-match
+         (rx bos "rgbi:" (* space)
+             (group (? (or "-" "+"))
+                    (or (: (+ digit) (? "." (* digit)))
+                        (: "." (+ digit)))
+                    (? "e" (? (or "-" "+")) (+ digit)))
+             "/" (* space)
+             (group (? (or "-" "+"))
+                    (or (: (+ digit) (? "." (* digit)))
+                        (: "." (+ digit)))
+                    (? "e" (? (or "-" "+")) (+ digit)))
+             "/" (* space)
+             (group (? (or "-" "+"))
+                    (or (: (+ digit) (? "." (* digit)))
+                        (: "." (+ digit)))
+                    (? "e" (? (or "-" "+")) (+ digit)))
+             eos)
+         spec)
+        (let ((r (round (* (string-to-number (match-string 1 spec)) 65535)))
+              (g (round (* (string-to-number (match-string 2 spec)) 65535)))
+              (b (round (* (string-to-number (match-string 3 spec)) 65535))))
+          (when (and (<= 0 r) (<= r 65535)
+                     (<= 0 g) (<= g 65535)
+                     (<= 0 b) (<= b 65535))
+            (list r g b))))))))
 
 ;;;; Defined in subr.el
 
diff --git a/compat-tests.el b/compat-tests.el
index ccdcd78a35..24fb5b50a4 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1624,6 +1624,7 @@ being compared against."
   (ought '(65535 0 0) "rgbi:1.0/0/0.0000")
   (ought '(65535 32768 0) "rgbi:1.0/0.5/0.0000")
   (ought '(6554 21843 65469) "rgbi:0.1/0.3333/0.999")
+  (ought '(6554 21843 65469) "rgbi:1e-1/+0.3333/0.00999e2")
   (ought nil "rgbi:1.0001/0/0")
   (ought nil "rgbi:2/0/0")
   (ought nil "rgbi:0.a/0/0")