branch: elpa/haskell-tng-mode
commit 639fc6cc07a1043c86d9c94fd4c581af759edb2f
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
multiline types and font-lock-multiline
---
haskell-tng-font-lock.el | 86 +++++++++++++++++++-----------------------------
haskell-tng-mode.el | 6 ++--
2 files changed, 36 insertions(+), 56 deletions(-)
diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index 1faf036..600059c 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -49,8 +49,6 @@
"Haskell top level declarations."
:group 'haskell-tng:faces)
-;; TODO: a macro to call rx-to-string at runtime that doesn't need (: )
-;;
;; TODO: regression tests https://github.com/Lindydancer/faceup
;;
;; TODO: pragmas
@@ -58,12 +56,6 @@
;; TODO: numeric / char primitives?
;;
;; TODO: haddock, different face vs line comments, and some markup.
-;;
-;; TODO: multiline support for imports and type detection.
-;;
-;; TODO: consider comments and newlines where we currently check for spaces.
-;;
-;; TODO: consider ; in the "until the end of the line" searches.
(defconst haskell-tng:conid '(: upper (* wordchar)))
(defconst haskell-tng:qual `(: (+ (: ,haskell-tng:conid (char ?.)))))
@@ -118,9 +110,9 @@
. 'haskell-tng:keyword)
;; types
- (,(rx-to-string '(: symbol-start "::" symbol-end)) .
- (haskell-tng:explicit-type-paint
- (backward-char 2) nil (0 'haskell-tng:type keep)))
+ (haskell-tng:explicit-type-paint
+ (0 'haskell-tng:type keep))
+ ;; TODO multiline data/newtype/class/instance types
(,(rx-to-string `(: line-start "data" (+ space)
(group (| ,conid ,consym))))
(1 'haskell-tng:type))
@@ -129,18 +121,19 @@
(+ space) "where"))
(1 'haskell-tng:type keep))
;; TypeApplications
- (,(rx-to-string `(: symbol-start "@" (+ space)
+ (,(rx-to-string `(: symbol-start "@" (* space)
+ ;; TODO: more liberal type application
(group (opt ,qual) (| ,conid ,consym))))
(1 'haskell-tng:type))
+ ;; TODO: multiline module / import sections
+
;; modules
(,(rx-to-string `(: symbol-start "module" symbol-end (+ space)
symbol-start (group (opt ,qual) ,conid) symbol-end))
1 'haskell-tng:module)
- ;; TODO types vs constructor highlighting.
- ;; needs a multi-line anchor.
- ;; imports (multi-line support would improve this)
+ ;; imports
(,(rx-to-string '(: word-start "import" word-end)) ;; anchor matcher
(,(rx-to-string `(: point (+ space) (group word-start "qualified"
word-end)))
nil nil (1 'haskell-tng:keyword))
@@ -179,23 +172,21 @@
"Matches an explicit type at point, bounded by a closing paren."
(let ((end (min limit (or (haskell-tng:paren-close) limit))))
(re-search-forward haskell-tng:explicit-type-regex end t)))
-
-;; FIXME: this is for debugging only
(defun haskell-tng:explicit-type-paint (limit)
+ ;; ideally we would use an anchored `haskell-tng:explicit-type' with a `::'
+ ;; trigger, but there is a bug in GNU Emacs where anchored functions receive
a
+ ;; much smaller `limit' than `font-lock-end' requested
+ ;; https://lists.gnu.org/archive/html/emacs-devel/2018-11/msg00136.html
"Matches an explicit type at point, bounded by a closing paren."
- (let ((end (min limit (or (haskell-tng:paren-close) limit))))
- ;; FIXME: why do we sometimes get empty searches? Or without the backward
2?
- (message "explicit-type-paint in %s" (buffer-substring-no-properties
(point) end))
- (re-search-forward haskell-tng:explicit-type-regex end t)))
-
-;; FIXME FIXME FIXME: for interactive debugging
-(defun type ()
- (interactive)
- (let ((case-fold-search nil))
- (haskell-tng:explicit-type (point-max))))
-
+ (when (re-search-forward (rx symbol-start "::" symbol-end) limit t)
+ (goto-char (match-beginning 0))
+ (haskell-tng:explicit-type limit)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Below are `font-lock-extend-region-functions' procedures for extending the
+;; region. Note that because we are using `font-lock-multiline' then multiline
+;; patterns will always be rehighlighted as a group.
(eval-when-compile
- ;; available inside font-lock-extend-region-functions procedures.
;; NOTE: font-lock-end is non-inclusive.
(defvar font-lock-beg)
(defvar font-lock-end))
@@ -216,7 +207,7 @@ The caller loops until everything is opened."
(goto-char open)
(when (looking-at "(")
(unless (re-search-forward haskell-tng:non-import font-lock-beg t)
- (haskell-tng:debug-extend open)
+ ;;(haskell-tng:debug-extend open)
(setq font-lock-beg open)))))
(defun haskell-tng:extend-parens-close ()
@@ -229,7 +220,7 @@ The caller loops until everything is closed."
(let ((end (+ 1 close)))
(goto-char end)
(unless (re-search-backward haskell-tng:non-import font-lock-end t)
- (haskell-tng:debug-extend end)
+ ;;(haskell-tng:debug-extend end)
(setq font-lock-end end)))))
(defun haskell-tng:paren-close ()
@@ -242,9 +233,9 @@ The caller loops until everything is closed."
(point)))))
(setq
- haskell-tng:beg-type
- ;; TODO: more restrictive search, do not scan past non-type constructs
- (rx symbol-start "::" symbol-end))
+ haskell-tng:beg-type
+ ;; TODO: more restrictive search, add more like \ and =
+ (rx symbol-start "::" symbol-end (* (not (any ?\\ ?=)))))
(defun haskell-tng:extend-type-open ()
"For use in `font-lock-extend-region-functions'.
Ensures that multiline type signatures are opened."
@@ -255,16 +246,10 @@ Ensures that multiline type signatures are opened."
(let ((beg (match-beginning 0)))
(when (< beg font-lock-beg)
(goto-char beg)
- (message "checking for types at %s" (buffer-substring-no-properties
beg (+ beg 10)))
;; validate that it's actually a type
- (haskell-tng:explicit-type (point-max)) ;; is this needed if we trust
the non-lambda backscan?
- (message "found one %s from %s to %s in (%s, %s) "
- (match-string 0)
- (match-beginning 0) (match-end 0)
- font-lock-beg font-lock-end)
+ (haskell-tng:explicit-type (point-max)) ;; would not be needed if
backscan was more reliable
(when (<= font-lock-beg (match-end 0))
- ;; FIXME FIXME FIXME this is never triggering, is the
re-search-backward going too far back?
- (haskell-tng:debug-extend beg)
+ ;;(haskell-tng:debug-extend beg)
(setq font-lock-beg beg)
nil)))))
@@ -279,10 +264,15 @@ Ensures that multiline type signatures are closed."
(haskell-tng:explicit-type (point-max))
(let ((end (match-end 0)))
(when (< font-lock-end end)
- (haskell-tng:debug-extend end)
+ ;;(haskell-tng:debug-extend end)
(setq font-lock-beg end)
nil)))))
+(defun haskell-tng:extend-defns ()
+ "Extends data, type, class and instance definitons to include their full
type part."
+ nil
+ )
+
(defun haskell-tng:extend-module-open ()
"For use in `font-lock-extend-region-functions'.
Ensures that multiline `module' definitions are opened."
@@ -314,15 +304,5 @@ Ensures that multiline `import' definitions are closed."
(buffer-substring-no-properties font-lock-end to)
"BADNESS! Reduced the region"))))
-(defun haskell-tng:mark-block ()
- ;; TODO: this is kinda obscure, replace with mark-defun when it is defined
- "For use as `font-lock-mark-block-function'."
- (let ((toplevel (rx-to-string haskell-tng:toplevel)))
- (right-char)
- (re-search-forward toplevel (point-max) 'limit)
- (move-beginning-of-line nil)
- (set-mark (point))
- (re-search-backward toplevel (point-min) 'limit)))
-
(provide 'haskell-tng-font-lock)
;;; haskell-tng-font-lock.el ends here
diff --git a/haskell-tng-mode.el b/haskell-tng-mode.el
index 136cf04..d162cc9 100644
--- a/haskell-tng-mode.el
+++ b/haskell-tng-mode.el
@@ -47,14 +47,14 @@
syntax-propertize-function #'haskell-tng:syntax-propertize
parse-sexp-lookup-properties t
- font-lock-defaults '(haskell-tng:keywords
- nil nil nil nil
- (font-lock-mark-block-function .
haskell-tng:mark-block))
+ font-lock-defaults '(haskell-tng:keywords)
+ font-lock-multiline t
font-lock-extend-region-functions '(font-lock-extend-region-wholelines
haskell-tng:extend-parens-open
haskell-tng:extend-parens-close
haskell-tng:extend-type-open
haskell-tng:extend-type-close
+ haskell-tng:extend-defns
haskell-tng:extend-module-open
haskell-tng:extend-module-close
haskell-tng:extend-import-open
