branch: elpa/haskell-tng-mode
commit 067e8a73c7fef7010f10518f058f7d54d7a974de
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
bugfix fontification of erroneous matches inside strings
---
haskell-tng-font-lock.el | 22 +++++++++++++++++++---
test/src/medley.hs | 2 ++
test/src/medley.hs.faceup | 2 ++
test/src/medley.hs.imenu | 10 +++++-----
test/src/medley.hs.layout | 2 ++
test/src/medley.hs.lexer | 2 ++
test/src/medley.hs.syntax | 2 ++
7 files changed, 34 insertions(+), 8 deletions(-)
diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index cfa17c6..bd923d7 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -274,13 +274,28 @@ succeeds and may further restrict the FIND search limit."
(defconst ,regexp-2 ,find)
(defun ,extend ()
(goto-char font-lock-end)
- (when (re-search-backward ,regexp-1 font-lock-beg t)
+ (when (and
+ ;; lots of conservative checks to make sure we never extend
+ ;; from, or into, a comment or string.
+ (not (nth 8 (syntax-ppss)))
+ (re-search-backward ,regexp-1 font-lock-beg t)
+ (not (nth 8 (syntax-ppss))))
,(finder '(point-max))
- (when (< font-lock-end (point))
+ (when (and
+ (not (nth 8 (syntax-ppss)))
+ (< font-lock-end (point)))
(setq font-lock-end (point))
nil)))
(defun ,keyword (limit)
- (when (re-search-forward ,regexp-1 limit t)
+ (when (and
+ (re-search-forward ,regexp-1 limit t)
+ ;; TODO if the last search got us into a string or comment.
We
+ ;; should recurse, otherwise we miss valid matches in the
+ ;; region. This hack just tries once more.
+ (or
+ (not (nth 8 (syntax-ppss)))
+ (re-search-forward ,regexp-1 limit t))
+ (not (nth 8 (syntax-ppss))))
(goto-char (match-beginning 0))
,(finder 'limit)))
;; TODO is this needed since we use multiline?
@@ -294,6 +309,7 @@ succeeds and may further restrict the FIND search limit."
haskell-tng--util-indent-close-previous
haskell-tng--util-type-ender)
;; TODO commas end a type signature in a record of functions (but can be used
in tuples, so complex)
+;; TODO since there is no way to exit based on context, we will match ::
inside strings and comments
(haskell-tng--font-lock-multiline topdecl
(rx line-start (| "data" "newtype" "class"
"instance") word-end)
diff --git a/test/src/medley.hs b/test/src/medley.hs
index 72c503f..2426e67 100644
--- a/test/src/medley.hs
+++ b/test/src/medley.hs
@@ -52,6 +52,8 @@ lambdas1 = \a -> a
lambdas2 = \ a -> a
lambdas3 = \(a) -> a
+bar = "blah :: " <> foo
+
class Get a s where
get :: Set s -> a
diff --git a/test/src/medley.hs.faceup b/test/src/medley.hs.faceup
index 17b02be..871e877 100644
--- a/test/src/medley.hs.faceup
+++ b/test/src/medley.hs.faceup
@@ -52,6 +52,8 @@ lambdas1 «:haskell-tng-keyword-face:=»
«:haskell-tng-keyword-face:\»a «:has
lambdas2 «:haskell-tng-keyword-face:=» «:haskell-tng-keyword-face:\» a
«:haskell-tng-keyword-face:->» a
lambdas3 «:haskell-tng-keyword-face:=»
«:haskell-tng-keyword-face:\(»a«:haskell-tng-keyword-face:)»
«:haskell-tng-keyword-face:->» a
+bar «:haskell-tng-keyword-face:=» «s:"blah :: "» <> foo
+
«:haskell-tng-keyword-face:class»«:haskell-tng-type-face: Get a s
»«:haskell-tng-keyword-face:where»
get «:haskell-tng-keyword-face:::»«:haskell-tng-type-face: Set s
»«:haskell-tng-keyword-face:->»«:haskell-tng-type-face: a
»
diff --git a/test/src/medley.hs.imenu b/test/src/medley.hs.imenu
index 5ee08d2..a0164dc 100644
--- a/test/src/medley.hs.imenu
+++ b/test/src/medley.hs.imenu
@@ -10,8 +10,8 @@
("lambdas1" . 1852)
("lambdas2" . 1871)
("lambdas3" . 1891)
- ("optionsParser" . 3464)
- ("getUsers" . 4439)
- ("test" . 4808)
- ("cases" . 4831)
- ("bar" . 4903))
+ ("bar" . 1913)
+ ("optionsParser" . 3489)
+ ("getUsers" . 4464)
+ ("test" . 4833)
+ ("cases" . 4856))
diff --git a/test/src/medley.hs.layout b/test/src/medley.hs.layout
index 3e660c5..0992e1a 100644
--- a/test/src/medley.hs.layout
+++ b/test/src/medley.hs.layout
@@ -52,6 +52,8 @@ module Foo.Bar.Main
;lambdas2 = \ a -> a
;lambdas3 = \(a) -> a
+;bar = "blah :: " <> foo
+
;class Get a s where
{get :: Set s -> a
diff --git a/test/src/medley.hs.lexer b/test/src/medley.hs.lexer
index 55ff768..d3c0b81 100644
--- a/test/src/medley.hs.lexer
+++ b/test/src/medley.hs.lexer
@@ -52,6 +52,8 @@ VARID , VARID , VARID »
; VARID = \ VARID -> VARID
; VARID = \ « VARID » -> VARID
+; VARID = § SYMID VARID
+
; class CONID VARID VARID where
{ VARID :: CONID VARID => VARID
diff --git a/test/src/medley.hs.syntax b/test/src/medley.hs.syntax
index 2dd3546..e08111d 100644
--- a/test/src/medley.hs.syntax
+++ b/test/src/medley.hs.syntax
@@ -52,6 +52,8 @@ wwwwwwww _ _w __ w>
wwwwwwww _ _ w __ w>
wwwwwwww _ _(w) __ w>
>
+www _ "wwww __ " __ www>
+>
wwwww www w w wwwww>
www __ www w __ w>
>
