diff --git a/haskell-font-lock.el b/haskell-font-lock.el index 8ea4b5966..56816d14b 100644 --- a/haskell-font-lock.el +++ b/haskell-font-lock.el @@ -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 @@ -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. ("\\\\)[ \t]*\\)?\\(?:\\(qualified\\>\\)[ \t]*\\)?\\(?:\"[^\"]*\"[\t ]*\\)?[^ \t\n()]+[ \t]*\\(?:\\(\\\\)[ \t]*[^ \t\n()]+[ \t]*\\)?\\(\\\\)?" @@ -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) '("\\" "=" "->" "→" "<-" "←" "::" "∷" "," ";" "`")) @@ -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)) @@ -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." diff --git a/haskell-mode.el b/haskell-mode.el index 2534db000..e19a37369 100644 --- a/haskell-mode.el +++ b/haskell-mode.el @@ -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 diff --git a/tests/haskell-font-lock-tests.el b/tests/haskell-font-lock-tests.el index 58b805bbb..2e583b5fc 100644 --- a/tests/haskell-font-lock-tests.el +++ b/tests/haskell-font-lock-tests.el @@ -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)))) @@ -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) diff --git a/tests/haskell-lexeme-tests.el b/tests/haskell-lexeme-tests.el index 8654ea351..dfddc58c8 100644 --- a/tests/haskell-lexeme-tests.el +++ b/tests/haskell-lexeme-tests.el @@ -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" "," "Артур.Артур")))