branch: elpa/haskell-tng-mode
commit 1cdf90198560d38a2b492a18d42efedf798f10eb
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@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)">
