[elpa] externals/xr 56a8e91 4/5: More robust pretty-printing of characters

[Mattias Engdegård]

branch: externals/xr
commit 56a8e91cf5c696892c46bbb1fb0c6d3b3248e8d1
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    More robust pretty-printing of characters
    
    Previously, xr never generated characters so the pretty-printer
    ignored them. Now characters are (very rarely) generated, and since
    xr-pp-rx-to-str is exported, make it useful for arbitrary rx
    expressions.
---
 xr-test.el | 28 +++++++++++++++++++++--
 xr.el      | 76 +++++++++++++++++++++++++++++++++++++++++++++++++-------------
 2 files changed, 87 insertions(+), 17 deletions(-)

diff --git a/xr-test.el b/xr-test.el
index 0fceb16..526740d 100644
--- a/xr-test.el
+++ b/xr-test.el
@@ -268,8 +268,32 @@
                  "\"A\\e\\r\\n\\t\\x00 \\x7f\\200B\\xff\\x02\"\n"))
   (should (equal (xr-pp-rx-to-str '(?? nonl))
                  "(?? nonl)\n"))
-  (should (equal (xr-pp-rx-to-str '(repeat 1 63 "a"))
-                 "(repeat 1 63 \"a\")\n"))
+  (should (equal (xr-pp-rx-to-str '(? ?\s))
+                 "(? ?\\s)\n"))
+  (should (equal (xr-pp-rx-to-str '(+? (*? ?*)))
+                 "(+? (*? ?*))\n"))
+  (should (equal (xr-pp-rx-to-str '(seq "a" ?a ?\s ?\n ?\" ?\\ ?0 ?\0 ?\177))
+                 "(seq \"a\" ?a ?\\s ?\\n ?\\\" ?\\\\ ?0 #x00 #x7f)\n"))
+  (should (equal (xr-pp-rx-to-str '(category ?Q))
+                 "(category ?Q)\n"))
+  (should (equal (xr-pp-rx-to-str '(any ?a ?\n ?\( ?\\ ?\200 ?Å ?Ω #x3fff80 
32))
+                 "(any ?a ?\\n ?\\( ?\\\\ #x80 ?Å ?Ω #x3fff80 ?\\s)\n"))
+  (should (equal (xr-pp-rx-to-str '(any (?0 . ?9)))
+                 "(any (?0 . ?9))\n"))
+  (should (equal (xr-pp-rx-to-str '(repeat 42 ?a))
+                 "(repeat 42 ?a)\n"))
+  (should (equal (xr-pp-rx-to-str '(repeat 10 13 ?b))
+                 "(repeat 10 13 ?b)\n"))
+  (should (equal (xr-pp-rx-to-str '(** 9 32 ?c))
+                 "(** 9 32 ?c)\n"))
+  (should (equal (xr-pp-rx-to-str '(= 3 ?d))
+                 "(= 3 ?d)\n"))
+  (should (equal (xr-pp-rx-to-str '(>= 8 ?e))
+                 "(>= 8 ?e)\n"))
+  (should (equal (xr-pp-rx-to-str '(group-n 7 ?f))
+                 "(group-n 7 ?f)\n"))
+  (should (equal (xr-pp-rx-to-str '(backref 12 ?g))
+                 "(backref 12 ?g)\n"))
   (let ((indent-tabs-mode nil))
     (should (equal (xr-pp-rx-to-str
                     '(seq (1+ nonl
diff --git a/xr.el b/xr.el
index edd21b8..6dd585c 100644
--- a/xr.el
+++ b/xr.el
@@ -1230,22 +1230,70 @@ If ESCAPE-PRINTABLE, also escape \\ and \", otherwise 
don't."
         xdigit)))
    string 'fixedcase 'literal))
 
+(defun xr--take (n list)
+  "The N first elements of LIST."
+  (butlast list (- (length list) n)))
+
+(defun xr--rx-list-to-string (rx plain-prefix)
+  "Print the list `rx' to a string, unformatted.
+The first PLAIN-PREFIX elements are formatted using `prin1-to-string';
+the rest with `xr--rx-to-string'."
+  (concat "("
+          (mapconcat #'identity
+                     (append
+                      (mapcar #'prin1-to-string (xr--take plain-prefix rx))
+                      (mapcar #'xr--rx-to-string (nthcdr plain-prefix rx)))
+                     " ")
+          ")"))
+
 (defun xr--rx-to-string (rx)
-  "Print a rx expression to a string, unformatted."
+  "Print an rx expression to a string, unformatted."
   (cond
    ((eq rx '*?) "*?")                   ; Avoid unnecessary \ in symbol.
    ((eq rx '+?) "+?")
-   ((consp rx)
-    ;; Render the characters SPC and ? as ? and ?? when first in a list.
-    ;; Elsewhere, they are just integers.
-    (let ((first (cond ((eq (car rx) ?\s) "?")
-                       ((eq (car rx) ??) "??")
-                       (t (xr--rx-to-string (car rx)))))
+   ((eq rx '\??) "\\??")
+   ((stringp rx) (concat "\"" (xr--escape-string rx t) "\""))
+   ((characterp rx)
+    (let ((esc (assq rx '((?\( . ?\()
+                          (?\) . ?\))
+                          (?\[ . ?\[)
+                          (?\] . ?\])
+                          (?\\ . ?\\)
+                          (?\; . ?\;)
+                          (?\" . ?\")
+                          (?\s . ?s)
+                          (?\n . ?n)
+                          (?\r . ?r)
+                          (?\t . ?t)
+                          (?\e . ?e)
+                          (?\b . ?b)
+                          (?\f . ?f)
+                          (?\v . ?v)))))
+      (cond (esc (format "?\\%c" (cdr esc)))
+            ;; Only base characters are displayed as ?char; this excludes
+            ;; controls, combining, surrogates, noncharacters etc.
+            ((aref (char-category-set rx) ?.) (format "?%c" rx))
+            (t (format "#x%02x" rx)))))
+   ((atom rx) (prin1-to-string rx))
+   ((nlistp (cdr rx))
+    (format "(%s . %s)"
+            (xr--rx-to-string (car rx))
+            (xr--rx-to-string (cdr rx))))
+   ((or (eq (car rx) '**)
+        (and (eq (car rx) 'repeat) (> (length rx) 3)))
+    ;; First 2 args are integers.
+    (xr--rx-list-to-string rx 3))
+   ((memq (car rx) '(= >= repeat group-n backref))
+    ;; First arg is integer.
+    (xr--rx-list-to-string rx 2))
+   (t
+    ;; Render the space character as ? when first in a list.
+    ;; Elsewhere, it's a character or integer.
+    (let ((first (if (eq (car rx) ?\s)
+                     "?"
+                   (xr--rx-to-string (car rx))))
           (rest (mapcar #'xr--rx-to-string (cdr rx))))
-      (concat "(" (mapconcat #'identity (cons first rest) " ") ")")))
-   ((stringp rx)
-    (concat "\"" (xr--escape-string rx t) "\""))
-   (t (prin1-to-string rx))))
+      (concat "(" (mapconcat #'identity (cons first rest) " ") ")")))))
 
 (defun xr-pp-rx-to-str (rx)
   "Pretty-print the regexp RX (in rx notation) to a string.
@@ -1258,10 +1306,8 @@ It does a slightly better job than standard `pp' for rx 
purposes."
     ;; readability and compactness.
     (goto-char (point-min))
     (while (re-search-forward
-            (rx "("
-                (or "not" "0+" "1+" "*" "+" "?" "opt" "seq" ":" "|" "or"
-                    "??" "*?" "+?" "=" ">=" "**")
-                (group "\n" (zero-or-more (any space))))
+            (rx "(" (** 1 4 (any "a-z0-9" "+?:|*=>"))
+                (group "\n" (zero-or-more blank)))
             nil t)
       (replace-match " " t t nil 1))