[nongnu] elpa/parseclj ce7ad0e427 025/185: implement strings

[ELPA Syncer]

branch: elpa/parseclj
commit ce7ad0e427f0db914955dfe4a58ff51271f63d8e
Author: Arne Brasseur <arne@arnebrasseur.net>
Commit: Arne Brasseur <arne@arnebrasseur.net>

    implement strings
---
 clj-lex-test.el   | 22 +++++++++++++++++++++-
 clj-lex.el        | 17 +++++++++++++++++
 clj-parse-test.el | 14 +++++++++++++-
 clj-parse.el      | 33 ++++++++++++++++++++++++++++-----
 4 files changed, 79 insertions(+), 7 deletions(-)

diff --git a/clj-lex-test.el b/clj-lex-test.el
index f3763d91c2..d70b706e35 100644
--- a/clj-lex-test.el
+++ b/clj-lex-test.el
@@ -61,7 +61,13 @@
   (with-temp-buffer
     (insert "hello-world")
     (goto-char 1)
-    (should (equal (clj-lex-next) '((type . :symbol) (form . "hello-world") 
(pos . 1))))))
+    (should (equal (clj-lex-next) '((type . :symbol) (form . "hello-world") 
(pos . 1)))))
+
+  ;; (with-temp-buffer
+  ;;   (insert "\\newline\\return\\space\\tab\\a\\b\\c")
+  ;;   (goto-char 1)
+  ;;   (should (equal (clj-lex-next) (clj-lex-token :character "\\newline" 
1))))
+  )
 
 (ert-deftest clj-lex-test-at-number? ()
   (dolist (str '("123" ".9" "+1" "0" "-456"))
@@ -105,7 +111,21 @@
   (should (equal (clj-lex-symbol-rest? ?~) nil))
   (should (equal (clj-lex-symbol-rest? ? ) nil)))
 
+(ert-deftest clj-lex-test-string ()
+  (with-temp-buffer
+    (insert "\"abc\"")
+    (goto-char 1)
+    (should (equal (clj-lex-string) (clj-lex-token :string "\"abc\"" 1))))
+
+  (with-temp-buffer
+    (insert "\"abc")
+    (goto-char 1)
+    (should (equal (clj-lex-string) (clj-lex-token :lex-error "\"abc" 1))))
 
+  (with-temp-buffer
+    (insert "\"abc\\\"\"")"abc\""
+    (goto-char 1)
+    (should (equal (clj-lex-string) (clj-lex-token :string "\"abc\\\"\"" 1)))))
 
 (provide 'clj-lex-test)
 
diff --git a/clj-lex.el b/clj-lex.el
index 9973341d60..0dc28a0da0 100644
--- a/clj-lex.el
+++ b/clj-lex.el
@@ -97,6 +97,20 @@
        ((equal sym "false") (clj-lex-token :false "false" pos))
        (t (clj-lex-token :symbol sym pos))))))
 
+(defun clj-lex-string ()
+  (let ((pos (point)))
+    (right-char)
+    (while (not (or (equal (char-after (point)) ?\") (clj-lex-at-eof?)))
+      (message (buffer-substring-no-properties pos (point)))
+      (if (equal (char-after (point)) ?\\)
+          (right-char 2)
+        (right-char)))
+    (if (equal (char-after (point)) ?\")
+        (progn
+          (right-char)
+          (clj-lex-token :string (buffer-substring-no-properties pos (point)) 
pos))
+      (clj-lex-token :lex-error (buffer-substring-no-properties pos (point)) 
pos))))
+
 (defun clj-lex-next ()
   (if (clj-lex-at-eof?)
       (clj-lex-token :eof nil (point))
@@ -120,6 +134,9 @@
        ((clj-lex-symbol-start? char)
         (clj-lex-symbol))
 
+       ((equal char ?\")
+        (clj-lex-string))
+
        ":("))))
 
 (provide 'clj-lex)
diff --git a/clj-parse-test.el b/clj-parse-test.el
index 8de09a3e8c..0f93277997 100644
--- a/clj-parse-test.el
+++ b/clj-parse-test.el
@@ -49,7 +49,17 @@
   (with-temp-buffer
     (insert "((.9 abc (true) (hello)))")
     (goto-char 1)
-    (should (equal (clj-parse) '(((0.9 abc (t) (hello))))))))
+    (should (equal (clj-parse) '(((0.9 abc (t) (hello)))))))
+
+  (with-temp-buffer
+    (insert "\"abc hello \\t\\\"x\"")
+    (goto-char 1)
+    (should (equal (clj-parse) '("abc hello \t\"x"))))
+
+  (with-temp-buffer
+    (insert "(\"---\\f---\\\"-'\\'-\\\\-\\r\\n\")")
+    (goto-char 1)
+    (should (equal (clj-parse) '(("---\f---\"-''-\\-\r\n"))))))
 
 ;; (ert-deftest clj-parse-test--reduce-list ()
 ;;   (clj-parse-test--reduce-list ))
@@ -57,3 +67,5 @@
 (provide 'clj-parse-test)
 
 ;;; clj-parse-test.el ends here
+
+"hello"
diff --git a/clj-parse.el b/clj-parse.el
index cc40237278..48efd43eff 100644
--- a/clj-parse.el
+++ b/clj-parse.el
@@ -24,9 +24,9 @@
 
 ;;; Code:
 
-(require 'cl-lib)
 ;; Before emacs 25.1 it's an ELPA package
 (require 'let-alist)
+(require 'cl-lib)
 (require 'clj-lex)
 
 (defvar clj-parse--leaf-tokens '(:whitespace
@@ -34,9 +34,28 @@
                                  :nil
                                  :true
                                  :false
-                                 :symbol)
+                                 :symbol
+                                 :string)
   "Tokens that represent leaf nodes in the AST.")
 
+;; Java/JavaScript strings support other escape codes like "\u0111", but
+;; these are the only ones mentioned in the EDN spec.
+;; Although of course for bare characters
+(defun clj-parse-string (s)
+  (replace-regexp-in-string "\\\\[tbnrf'\"\\]"
+                            (lambda (x)
+                              (cl-case (elt x 1)
+                                (?t "\t")
+                                (?f "\f")
+                                (?\" "\"")
+                                (?r "\r")
+                                (?n "\n")
+                                (?\\ "\\\\")
+                                (t (substring x 1 2))))
+                            (substring s 1 -1)))
+
+(replace-regexp-in-string "x" "\\\\" "x")
+
 (defun clj-parse-edn-reduce1 (stack token)
   (cl-case (cdr (assq 'type token))
     (:whitespace stack)
@@ -44,7 +63,8 @@
     (:nil (cons nil stack))
     (:true (cons t stack))
     (:false (cons nil stack))
-    (:symbol (cons (intern (cdr (assq 'form token))) stack))))
+    (:symbol (cons (intern (cdr (assq 'form token))) stack))
+    (:string (cons (clj-parse-string (cdr (assq 'form token))) stack))))
 
 (defun clj-parse-edn-reduceN (stack type coll)
   (cons
@@ -61,7 +81,8 @@
 
 (defun clj-parse--reduce-list (stack reducN)
   (let ((coll nil))
-    (while (and stack (not (eq (clj-parse--token-type (car stack)) :lparen)))
+    (while (and stack
+                (not (eq (clj-parse--token-type (car stack)) :lparen)))
       (push (pop stack) coll))
     (if (eq (clj-parse--token-type (car stack)) :lparen)
         (progn
@@ -79,7 +100,8 @@
       (message "TOKEN: %S\n" token)
 
       (setf stack
-            (if (member (clj-parse--token-type token) clj-parse--leaf-tokens)
+            (if (member (clj-parse--token-type token)
+                        clj-parse--leaf-tokens)
                 (funcall reduce1 stack token)
               (cons token stack)))
 
@@ -95,4 +117,5 @@
   (clj-parse-reduce 'clj-parse-edn-reduce1 'clj-parse-edn-reduceN))
 
 (provide 'clj-parse)
+
 ;;; clj-parse.el ends here