From 3655056b30f5122aa8cd15ab52762f771f2fd3ec Mon Sep 17 00:00:00 2001 From: Gracjan Polak Date: Sat, 27 Aug 2016 10:14:30 +0200 Subject: [PATCH] Support pattern as keyword --- haskell-font-lock.el | 33 +++++++++++++++++--------------- tests/haskell-font-lock-tests.el | 29 +++++++++++----------------- 2 files changed, 29 insertions(+), 33 deletions(-) diff --git a/haskell-font-lock.el b/haskell-font-lock.el index 2c5e718ce..ac7d9ec63 100644 --- a/haskell-font-lock.el +++ b/haskell-font-lock.el @@ -86,6 +86,19 @@ be disabled at that position." :type '(alist string string) :group 'haskell-appearance) +(defcustom haskell-font-lock-keywords + ;; `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" "pattern" "proc" "then" "type" "where" "_") + "Identifiers treated as reserved keywords in Haskell." + :group 'haskell-appearance + :type '(repeat string)) + + (defun haskell-font-lock-dot-is-not-composition (start) "Return non-nil if the \".\" at START is not a composition operator. This is the case if the \".\" is part of a \"forall . \"." @@ -229,16 +242,6 @@ Regexp match data 0 points to the chars." ;; no face. So force evaluation by using `keep'. keep))))) -(defconst haskell-font-lock--reverved-ids - ;; `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" "_") - "Identifiers treated as reserved keywords in Haskell.") - (defun haskell-font-lock--forward-type (&optional ignore) "Find where does this type declaration end. @@ -283,7 +286,7 @@ like ::, class, instance, data, newtype, type." (setq last-token-was-newline nil)) ((and (or (member (match-string-no-properties 0) '("<-" "=" "←")) - (member (match-string-no-properties 0) haskell-font-lock--reverved-ids)) + (member (match-string-no-properties 0) haskell-font-lock-keywords)) (not (member (match-string-no-properties 0) ignore))) (setq cont nil) (setq last-token-was-newline nil)) @@ -318,7 +321,7 @@ like ::, class, instance, data, newtype, type." "Private function used to select either type or constructor face on an uppercase identifier." (cl-case (haskell-lexeme-classify-by-first-char (char-after (match-beginning 1))) - (varid (when (member (match-string 0) haskell-font-lock--reverved-ids) + (varid (when (member (match-string 0) haskell-font-lock-keywords) ;; Note: keywords parse as keywords only when not qualified. ;; GHC parses Control.let as a single but illegal lexeme. (when (member (match-string 0) '("class" "instance" "type" "data" "newtype")) @@ -440,11 +443,11 @@ on an uppercase identifier." ;; Toplevel Declarations. ;; Place them *before* generic id-and-op highlighting. - (,topdecl-var (1 (unless (member (match-string 1) haskell-font-lock--reverved-ids) + (,topdecl-var (1 (unless (member (match-string 1) haskell-font-lock-keywords) 'haskell-definition-face))) - (,topdecl-var2 (2 (unless (member (match-string 2) haskell-font-lock--reverved-ids) + (,topdecl-var2 (2 (unless (member (match-string 2) haskell-font-lock-keywords) 'haskell-definition-face))) - (,topdecl-bangpat (1 (unless (member (match-string 1) haskell-font-lock--reverved-ids) + (,topdecl-bangpat (1 (unless (member (match-string 1) haskell-font-lock-keywords) 'haskell-definition-face))) (,topdecl-sym (2 (unless (member (match-string 2) '("\\" "=" "->" "→" "<-" "←" "::" "∷" "," ";" "`")) 'haskell-definition-face))) diff --git a/tests/haskell-font-lock-tests.el b/tests/haskell-font-lock-tests.el index 789587437..22c0a0f65 100644 --- a/tests/haskell-font-lock-tests.el +++ b/tests/haskell-font-lock-tests.el @@ -975,9 +975,8 @@ ("Cons2" t haskell-constructor-face) ("Cons3" t haskell-constructor-face)))) -(ert-deftest haskell-pattern () +(ert-deftest haskell-pattern-1 () "Fontify the \"pattern\" keyword in contexts related to pattern synonyms." - :expected-result :failed (check-properties '("pattern A = B" "pattern A <- B" @@ -1006,27 +1005,21 @@ ("pattern" t haskell-keyword-face) ("pattern" t haskell-keyword-face)))) -(ert-deftest haskell-no-pattern-1 () - "Don't fontify \"pattern\" in contexts unrelated to pattern synonyms." - ;; This already works properly - ;;:expected-result :failed +(ert-deftest haskell-pattern-2 () (check-properties '("pattern :: Int" "pattern = 3") - '(("pattern" t haskell-definition-face) - ("pattern" t haskell-definition-face)))) + '(("pattern" t haskell-keyword-face) + ("pattern" t haskell-keyword-face)))) -(ert-deftest haskell-no-pattern-2 () - "Don't fontify \"pattern\" in contexts unrelated to pattern synonyms." - ;; This already works properly - ;;:expected-result :failed +(ert-deftest haskell-pattern-3 () (check-properties '("foo :: (a -> pattern) -> a -> pattern" "foo pattern x = pattern x" "bar = pattern where pattern = 5") - '(("pattern" t nil) - ("pattern" t nil) - ("pattern" t nil) - ("pattern" t nil) - ("pattern" t nil) - ("pattern" t nil)))) + '(("pattern" t haskell-keyword-face) + ("pattern" t haskell-keyword-face) + ("pattern" t haskell-keyword-face) + ("pattern" t haskell-keyword-face) + ("pattern" t haskell-keyword-face) + ("pattern" t haskell-keyword-face))))