Merge pull request #1059 from gracjan/pr-literate-font-lock

Add literate font lock tests, remove unused parts

Author: gracjan

haskell-font-lock.el

@@ -319,55 +319,6 @@ Returns keywords suitable for `font-lock-keywords'."
                       'haskell-operator-face))))
     keywords))
 
-(defvar haskell-font-lock-latex-cache-pos nil
-  "Position of cache point used by `haskell-font-lock-latex-cache-in-comment'.
-Should be at the start of a line.")
-(make-variable-buffer-local 'haskell-font-lock-latex-cache-pos)
-
-(defvar haskell-font-lock-latex-cache-in-comment nil
-  "If `haskell-font-lock-latex-cache-pos' is outside a
-\\begin{code}..\\end{code} block (and therefore inside a comment),
-this variable is set to t, otherwise nil.")
-(make-variable-buffer-local 'haskell-font-lock-latex-cache-in-comment)
-
-(defun haskell-font-lock-latex-comments (end)
-  "Sets `match-data' according to the region of the buffer before end
-that should be commented under LaTeX-style literate scripts."
-  (let ((start (point)))
-    (if (= start end)
-        ;; We're at the end.  No more to fontify.
-        nil
-      (if (not (eq start haskell-font-lock-latex-cache-pos))
-          ;; If the start position is not cached, calculate the state
-          ;; of the start.
-          (progn
-            (setq haskell-font-lock-latex-cache-pos start)
-            ;; If the previous \begin{code} or \end{code} is a
-            ;; \begin{code}, then start is not in a comment, otherwise
-            ;; it is in a comment.
-            (setq haskell-font-lock-latex-cache-in-comment
-                  (if (and
-                       (re-search-backward
-                        "^\\(\\(\\\\begin{code}\\)\\|\\(\\\\end{code}\\)\\)$"
-                        (point-min) t)
-                       (match-end 2))
-                      nil t))
-            ;; Restore position.
-            (goto-char start)))
-      (if haskell-font-lock-latex-cache-in-comment
-          (progn
-            ;; If start is inside a comment, search for next \begin{code}.
-            (re-search-forward "^\\\\begin{code}$" end 'move)
-            ;; Mark start to end of \begin{code} (if present, till end
-            ;; otherwise), as a comment.
-            (set-match-data (list start (point)))
-            ;; Return point, as a normal regexp would.
-            (point))
-        ;; If start is inside a code block, search for next \end{code}.
-        (if (re-search-forward "^\\\\end{code}$" end t)
-            ;; If one found, mark it as a comment, otherwise finish.
-            (point))))))
-
 (defconst haskell-basic-syntactic-keywords
   '(;; Character constants (since apostrophe can't have string syntax).
     ;; Beware: do not match something like 's-}' or '\n"+' since the first '

tests/haskell-font-lock-tests.el

@@ -51,7 +51,7 @@ after a test as this aids interactive debugging."
        (haskell-mode)
        ,@body)))
 
-(defun check-properties (lines props)
+(defun check-properties (lines props &optional literate)
   "Check if syntax properties and font-lock properties as set properly.
 
 LINES is a list of strings that will be inserted to a new
@@ -63,10 +63,12 @@ if all of its characters have syntax and face. See
     (kill-buffer "*haskell-mode-buffer*"))
   (save-current-buffer
     (set-buffer (get-buffer-create "*haskell-mode-buffer*"))
-    (haskell-mode)
     (dolist (line lines)
       (insert line)
       (insert "\n"))
+    (if literate
+        (literate-haskell-mode)
+      (haskell-mode))
     (font-lock-fontify-buffer)
     (goto-char (point-min))
     (dolist (prop props)
@@ -464,3 +466,91 @@ if all of its characters have syntax and face. See
   (check-properties
    '("Q +++ 12.12")
    '(("+++" t haskell-definition-face))))
+
+(ert-deftest haskell-literate-bird-1 ()
+  (check-properties
+   '("Comment1"
+     ""
+     "> code1 = 1"
+     "> code2 = 1"
+     ""
+     "Comment2"
+     ""
+     "> code3 = 1"
+     ""
+     "Comment3")
+   '(("Comment1" t haskell-literate-comment-face)
+     ("code1" t haskell-definition-face)
+     ("code2" t haskell-definition-face)
+     ("Comment2" t haskell-literate-comment-face)
+     ("code3" t haskell-definition-face)
+     ("Comment3" t haskell-literate-comment-face))
+   'literate))
+
+(ert-deftest haskell-literate-bird-2 ()
+  ;; Haskell Report requires empty line before bird code block. So it
+  ;; is a code block, just in error.
+  :expected-result :failed
+  (check-properties
+   '("Comment1"
+     "> code1 = 1"
+     "> code2 = 1"
+     "Comment2"
+     ""
+     "> code3 = 1"
+     ""
+     "Comment3")
+   '(("Comment1" t haskell-literate-comment-face)
+     (">" t font-lock-warning-face)
+     ("code1" t haskell-definition-face)
+     ("code2" t haskell-definition-face)
+     ("Comment2" t haskell-literate-comment-face)
+     ("code3" t haskell-definition-face)
+     ("Comment3" t haskell-literate-comment-face))
+   'literate))
+
+(ert-deftest haskell-literate-latex-1 ()
+  (check-properties
+   '("Comment1"
+     ""
+     "\\begin{code}"
+     "code1 = 1"
+     "code2 = 1"
+     "\\end{code}"
+     ""
+     "Comment2"
+     "\\begin{code}"
+     "code3 = 1"
+     "\\end{code}"
+     "Comment3")
+   '(("Comment1" t haskell-literate-comment-face)
+     ("code1" t haskell-definition-face)
+     ("code2" t haskell-definition-face)
+     ("Comment2" t haskell-literate-comment-face)
+     ("code3" t haskell-definition-face)
+     ("Comment3" t haskell-literate-comment-face))
+   'literate))
+
+(ert-deftest haskell-literate-mixed-1 ()
+  :expected-result :failed
+  ;; Although Haskell Report does not advice mixing modes, it is a
+  ;; perfectly valid construct that we should support in syntax
+  ;; highlighting.
+  (check-properties
+   '("Comment1"
+     ""
+     "> code1 = 1"
+     "> code2 = 1"
+     ""
+     "Comment2"
+     "\\begin{code}"
+     "code3 = 1"
+     "\\end{code}"
+     "Comment3")
+   '(("Comment1" t haskell-literate-comment-face)
+     ("code1" t haskell-definition-face)
+     ("code2" t haskell-definition-face)
+     ("Comment2" t haskell-literate-comment-face)
+     ("code3" t haskell-definition-face)
+     ("Comment3" t haskell-literate-comment-face))
+   'literate))