Skip to content

Improve font-lock #1159

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Feb 17, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
72 changes: 36 additions & 36 deletions haskell-font-lock.el
Original file line number Diff line number Diff line change
Expand Up @@ -217,24 +217,15 @@ Regexp match data 0 points to the chars."
(varid "\\b[[:lower:]_][[:alnum:]'_]*\\b")
;; We allow ' preceding conids because of DataKinds/PolyKinds
(conid "\\b'?[[:upper:]][[:alnum:]'_]*\\b")
(modid (concat "\\b" conid "\\(\\." conid "\\)*\\b"))
(qvarid (concat modid "\\." varid))
(qconid (concat modid "\\." conid))
(sym "\\s.+")

;; Reserved identifiers
(reservedid
(concat "\\<"
;; `as', `hiding', and `qualified' are part of the import
;; spec syntax, but they are not reserved.
;; `_' can go in here since it has temporary word syntax.
;; (regexp-opt
;; '("case" "class" "data" "default" "deriving" "do"
;; "else" "if" "import" "in" "infix" "infixl"
;; "infixr" "instance" "let" "module" "newtype" "of"
;; "then" "type" "where" "_") t)
"\\(_\\|c\\(ase\\|lass\\)\\|d\\(ata\\|e\\(fault\\|riving\\)\\|o\\)\\|else\\|i\\(mport\\|n\\(fix[lr]?\\|stance\\)\\|[fn]\\)\\|let\\|module\\|mdo\\|newtype\\|of\\|rec\\|proc\\|t\\(hen\\|ype\\)\\|where\\)"
"\\>"))
(reservedids
;; `as', `hiding', and `qualified' are part of the import
;; spec syntax, but they are not reserved.
;; `_' can go in here since it has temporary word syntax.
'("case" "class" "data" "default" "deriving" "do"
"else" "if" "import" "in" "infix" "infixl"
"infixr" "instance" "let" "module" "mdo" "newtype" "of"
"rec" "proc" "then" "type" "where" "_"))

;; Top-level declarations
(topdecl-var
Expand Down Expand Up @@ -263,8 +254,6 @@ Regexp match data 0 points to the chars."

,@(haskell-font-lock-symbols-keywords)

(,reservedid 1 'haskell-keyword-face)

;; Special case for `as', `hiding', `safe' and `qualified', which are
;; keywords in import statements but are not otherwise reserved.
("\\<import[ \t]+\\(?:\\(safe\\>\\)[ \t]*\\)?\\(?:\\(qualified\\>\\)[ \t]*\\)?\\(?:\"[^\"]*\"[\t ]*\\)?[^ \t\n()]+[ \t]*\\(?:\\(\\<as\\>\\)[ \t]*[^ \t\n()]+[ \t]*\\)?\\(\\<hiding\\>\\)?"
Expand Down Expand Up @@ -302,9 +291,12 @@ Regexp match data 0 points to the chars."

;; Toplevel Declarations.
;; Place them *before* generic id-and-op highlighting.
(,topdecl-var (1 'haskell-definition-face))
(,topdecl-var2 (2 'haskell-definition-face))
(,topdecl-bangpat (1 'haskell-definition-face))
(,topdecl-var (1 (unless (member (match-string 1) ',reservedids)
'haskell-definition-face)))
(,topdecl-var2 (2 (unless (member (match-string 2) ',reservedids)
'haskell-definition-face)))
(,topdecl-bangpat (1 (unless (member (match-string 1) ',reservedids)
'haskell-definition-face)))
(,topdecl-sym (2 (unless (member (match-string 2) '("\\" "=" "->" "→" "<-" "←" "::" "∷" "," ";" "`"))
'haskell-definition-face)))
(,topdecl-sym2 (1 (unless (member (match-string 1) '("\\" "=" "->" "→" "<-" "←" "::" "∷" "," ";" "`"))
Expand All @@ -314,19 +306,26 @@ Regexp match data 0 points to the chars."
("(\\(,*\\|->\\))" 0 'haskell-constructor-face)
("\\[\\]" 0 'haskell-constructor-face)

(,(concat "`" varid "`") 0 'haskell-operator-face)
(,(concat "`" conid "`") 0 'haskell-operator-face)
(,(concat "`" qvarid "`") 0 'haskell-operator-face)
(,(concat "`" qconid "`") 0 'haskell-operator-face)

(,qconid 0 'haskell-constructor-face)

(,conid 0 'haskell-constructor-face)

(,sym 0 (if (and (eq (char-after (match-beginning 0)) ?:)
(not (member (match-string 0) '("::" "∷"))))
'haskell-constructor-face
'haskell-operator-face))))
(,(concat "`" haskell-lexeme-qid-or-qsym "`") 0 'haskell-operator-face)

(,haskell-lexeme-qid-or-qsym
0 (cl-case (haskell-lexeme-classify-by-first-char (char-after (match-beginning 1)))
(varid (when (member (match-string 0) ',reservedids)
;; Note: keywords parse as keywords only when not qualified.
;; GHC parses Control.let as a single but illegal lexeme.
'haskell-keyword-face))
(conid 'haskell-constructor-face)
(varsym (when (and (not (member (match-string 0) '("-" "+" ".")))
(not (save-excursion
(goto-char (match-beginning 1))
(looking-at-p "\\sw"))))
;; We need to protect against the case of
;; plus, minus or dot inside a floating
;; point number.
'haskell-operator-face))
(consym (if (not (member (match-string 1) '("::" "∷")))
'haskell-constructor-face
'haskell-operator-face))))))
keywords))


Expand Down Expand Up @@ -456,7 +455,8 @@ Regexp match data 0 points to the chars."
(font-lock-syntactic-face-function
. haskell-syntactic-face-function)
;; Get help from font-lock-syntactic-keywords.
(parse-sexp-lookup-properties . t))))
(parse-sexp-lookup-properties . t)
(font-lock-extra-managed-props . (composition)))))

(defun haskell-fontify-as-mode (text mode)
"Fontify TEXT as MODE, returning the fontified text."
Expand Down
3 changes: 2 additions & 1 deletion haskell-mode.el
Original file line number Diff line number Diff line change
Expand Up @@ -761,7 +761,8 @@ Minor modes that work well with `haskell-mode':
(font-lock-syntactic-face-function
. haskell-syntactic-face-function)
;; Get help from font-lock-syntactic-keywords.
(parse-sexp-lookup-properties . t)))
(parse-sexp-lookup-properties . t)
(font-lock-extra-managed-props . (composition))))
;; Haskell's layout rules mean that TABs have to be handled with extra care.
;; The safer option is to avoid TABs. The second best is to make sure
;; TABs stops are 8 chars apart, as mandated by the Haskell Report. --Stef
Expand Down
18 changes: 9 additions & 9 deletions tests/haskell-font-lock-tests.el
Original file line number Diff line number Diff line change
Expand Up @@ -162,16 +162,16 @@ if all of its characters have syntax and face. See
("." "." haskell-constructor-face)
("C" "w" haskell-constructor-face)

("D" "w" haskell-constructor-face)
("." "." haskell-constructor-face)
("E" "w" haskell-constructor-face)
("." "." haskell-operator-face)
("D" "w" nil)
("." "." nil)
("E" "w" nil)
("." "." nil)
("f" "w" nil)

("G" "w" haskell-constructor-face)
("." "." haskell-constructor-face)
("H" "w" haskell-constructor-face)
("." "." haskell-operator-face) ; this is wrong
("G" "w" haskell-operator-face)
("." "." haskell-operator-face)
("H" "w" haskell-operator-face)
("." "." haskell-operator-face)
(">>=" "." haskell-operator-face)

("<=<" "." haskell-operator-face))))
Expand Down Expand Up @@ -452,7 +452,7 @@ if all of its characters have syntax and face. See
"nope :: nope"
"nope <- nope"
"nope ` nope")
'(("," t haskell-operator-face)
'(("," t nil)
("=" t haskell-operator-face)
("->" t haskell-operator-face)
("::" t haskell-operator-face)
Expand Down
2 changes: 1 addition & 1 deletion tests/haskell-lexeme-tests.el
Original file line number Diff line number Diff line change
Expand Up @@ -92,7 +92,7 @@ order."

(ert-deftest haskell-lexeme-unicode-ids-2 ()
"Unicode ids, unicode as last character in line"
:expected-result :failed
;;:expected-result :failed
(check-lexemes
'("Żółw.head,Data.żółw,Артур.Артур")
'("Żółw.head" "," "Data.żółw" "," "Артур.Артур")))
Expand Down