[nongnu] elpa/haskell-tng-mode 1cdf901 120/385: better escape syntax detection

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 1cdf90198560d38a2b492a18d42efedf798f10eb
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@gmail.com>

    better escape syntax detection
---
 haskell-tng-syntax.el            | 43 +++++++++++++++++++++++++++++++++++-----
 test/src/medley.hs               |  3 +++
 test/src/medley.hs.faceup        |  3 +++
 test/src/medley.hs.insert.indent |  6 ++++++
 test/src/medley.hs.layout        |  3 +++
 test/src/medley.hs.lexer         |  3 +++
 test/src/medley.hs.syntax        |  3 +++
 7 files changed, 59 insertions(+), 5 deletions(-)

diff --git a/haskell-tng-syntax.el b/haskell-tng-syntax.el
index d5b437e..05adb1d 100644
--- a/haskell-tng-syntax.el
+++ b/haskell-tng-syntax.el
@@ -14,6 +14,7 @@
 ;;
 ;;; Code:
 
+(require 'cl-lib)
 (require 'dash)
 
 (defconst haskell-tng:syntax-table
@@ -80,6 +81,7 @@
   (let (case-fold-search)
     (haskell-tng:syntax:char-delims start end)
     (haskell-tng:syntax:fqn-punct start end)
+    (haskell-tng:syntax:string-escapes start end)
     (haskell-tng:syntax:escapes start end)))
 
 (defun haskell-tng:syntax:char-delims (start end)
@@ -100,14 +102,45 @@ module or qualifier, then it is punctuation."
     (let ((dot (match-beginning 0)))
       (put-text-property dot (1+ dot) 'syntax-table '(1)))))
 
-;; TODO somehow is not escaping two escaped quotes together, e.g. in "\"\""
+(defun haskell-tng:syntax:string-escapes (start end)
+  "Backslash before quotes is a string escape.
+
+This needs to run before `haskell-tng:syntax:escapes' or string
+detection will not work correctly.
+
+There is an expected false positive: an operator uses \ as its
+final character and is called with a literal string or char as
+the 2nd parameter with no whitespace."
+  (goto-char start)
+  (while (re-search-forward
+          (rx "\\" (| (syntax string-quote)
+                      (syntax character-quote)))
+          end t)
+    (let* ((escape (match-beginning 0))
+           (before (haskell-tng:syntax:count-escapes escape)))
+      (when (cl-evenp before)
+        (put-text-property escape (1+ escape) 'syntax-table '(9))))))
+
+(defun haskell-tng:syntax:count-escapes (pos)
+  "Count the number of escapes before point.
+Even means the next char is not escaped."
+  (if (or (= 1 pos) (/= ?\\ (char-before pos)))
+      0
+    (1+ (haskell-tng:syntax:count-escapes (1- pos)))))
+
 (defun haskell-tng:syntax:escapes (start end)
   "Backslash inside String is an escape character \n."
+  ;; TODO does this pull its weight? (slow, requires a ppss)
   (goto-char start)
-  (while (re-search-forward "\\\\" end t)
-    (when (nth 3 (syntax-ppss))
-      (put-text-property (- (point) 1) (point)
-                         'syntax-table '(9)))))
+  (while (re-search-forward (rx "\\") end t)
+    (let ((escape (match-beginning 0)))
+      (when (/= 9 (car (syntax-after escape))) ;; already calculated
+        (let ((before (haskell-tng:syntax:count-escapes escape)))
+          (when (and (cl-evenp before) (nth 3 (syntax-ppss)))
+            (put-text-property escape (1+ escape) 'syntax-table '(9)))))
+      (when (= 9 (car (syntax-after escape)))
+        ;; next char is escaped, so no need to check it
+        (forward-char 1)))))
 
 (provide 'haskell-tng-syntax)
 ;;; haskell-tng-syntax.el ends here
diff --git a/test/src/medley.hs b/test/src/medley.hs
index 941d02e..a1bf069 100644
--- a/test/src/medley.hs
+++ b/test/src/medley.hs
@@ -36,6 +36,9 @@ import           System.Process      (CreateProcess (..), 
StdStream (..),
 -- some chars that should be propertized
 chars = ['c', '\n', '\'']
 
+strings = ["", "\"\"", "\n\\ ", "\\"]
+-- knownWrongEscape = "foo"\\"bar"
+
 difficult = foo' 'a' 2
 
 foo = "wobble (wibble)"
diff --git a/test/src/medley.hs.faceup b/test/src/medley.hs.faceup
index 75ad73b..a37b9ae 100644
--- a/test/src/medley.hs.faceup
+++ b/test/src/medley.hs.faceup
@@ -36,6 +36,9 @@
 «m:-- »«x:some chars that should be propertized
 »«:haskell-tng:toplevel:chars» «:haskell-tng:keyword:=» 
«:haskell-tng:keyword:[»«s:'c'»«:haskell-tng:keyword:,» 
«s:'\n'»«:haskell-tng:keyword:,» «s:'\''»«:haskell-tng:keyword:]»
 
+«:haskell-tng:toplevel:strings» «:haskell-tng:keyword:=» 
«:haskell-tng:keyword:[»«s:""»«:haskell-tng:keyword:,» 
«s:"\"\""»«:haskell-tng:keyword:,» «s:"\n\\ "»«:haskell-tng:keyword:,» 
«s:"\\"»«:haskell-tng:keyword:]»
+«m:-- »«x:knownWrongEscape = "foo"\\"bar"
+»
 «:haskell-tng:toplevel:difficult» «:haskell-tng:keyword:=» foo' «s:'a'» 2
 
 «:haskell-tng:toplevel:foo» «:haskell-tng:keyword:=» «s:"wobble (wibble)"»
diff --git a/test/src/medley.hs.insert.indent b/test/src/medley.hs.insert.indent
index a0571b7..18c90b0 100644
--- a/test/src/medley.hs.insert.indent
+++ b/test/src/medley.hs.insert.indent
@@ -74,6 +74,12 @@ chars = ['c', '\n', '\'']
 1         v
 
 v
+strings = ["", "\"\"", "\n\\ ", "\\"]
+1           v
+-- knownWrongEscape = "foo"\\"bar"
+1           v
+
+v
 difficult = foo' 'a' 2
 1                v
 
diff --git a/test/src/medley.hs.layout b/test/src/medley.hs.layout
index c186632..7e0ca87 100644
--- a/test/src/medley.hs.layout
+++ b/test/src/medley.hs.layout
@@ -36,6 +36,9 @@ module Foo.Bar.Main
 -- some chars that should be propertized
 ;chars = ['c', '\n', '\'']
 
+;strings = ["", "\"\"", "\n\\ ", "\\"]
+-- knownWrongEscape = "foo"\\"bar"
+
 ;difficult = foo' 'a' 2
 
 ;foo = "wobble (wibble)"
diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer
index ff9952a..ccc6cf4 100644
--- a/test/src/medley.hs.lexer
+++ b/test/src/medley.hs.lexer
@@ -36,6 +36,9 @@ VARID , VARID , VARID »
 
 ; VARID = « § , § , § »
 
+; VARID = « § , § , § , § »
+
+
 ; VARID = VARID § 2
 
 ; VARID = §
diff --git a/test/src/medley.hs.syntax b/test/src/medley.hs.syntax
index 99385b6..be0ca4a 100644
--- a/test/src/medley.hs.syntax
+++ b/test/src/medley.hs.syntax
@@ -36,6 +36,9 @@ wwwwww           wwwwww.wwwwwww      (wwwwwwwwwwwww (__). 
wwwwwwwww (__).>
 __ wwww wwwww wwww wwwwww ww wwwwwwwwwww>
 wwwww _ ("w". "\w". "\w")>
 >
+wwwwwww _ ("". "\"\"". "\w\_ ". "\_")>
+__ wwwwwwwwwwwwwwww _ "www"__"www">
+>
 wwwwwwwww _ wwww "w" w>
 >
 www _ "wwwwww (wwwwww)">