branch: elpa/haskell-tng-mode
commit 52f0cb9b574b3af163252ff16277ed6d87fe4675
Author: Tseen She <ts33n....@gmail.com>
Commit: Tseen She <ts33n....@gmail.com>
expand parens
---
haskell-tng-font-lock.el | 80 +++++++++++++++++++++++++-----------------------
haskell-tng-mode.el | 2 ++
haskell-tng-syntax.el | 24 +++++++--------
3 files changed, 54 insertions(+), 52 deletions(-)
diff --git a/haskell-tng-font-lock.el b/haskell-tng-font-lock.el
index ab95f9f..9883266 100644
--- a/haskell-tng-font-lock.el
+++ b/haskell-tng-font-lock.el
@@ -158,59 +158,61 @@
)))
-;; TODO: consider previous/next symbol instead of whole line detection in
-;; font-lock-extend-region-functions for super duper hyper perf.
+;; TODO: consider previous/next symbol instead of the default whole line
+;; detection in font-lock-extend-region-functions for super duper hyper perf.
(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))
+;; TODO optimise extend-parens-* to module / import / types
+(defun haskell-tng:extend-parens-open ()
+ "For use in `font-lock-extend-region-functions'.
+Expand the region to include the opening parenthesis.
+The caller loops until everything is opened."
+ (goto-char font-lock-beg)
+ (let* ((scan (syntax-ppss))
+ (open (nth 1 scan)))
+ (when (and open
+ (goto-char open)
+ (looking-at "("))
+ ;;(haskell-tng:debug-extend (point))
+ (setq font-lock-beg (point)))))
+
+(defun haskell-tng:extend-parens-close ()
+ "For use in `font-lock-extend-region-functions'.
+Expand the region to include a closing parenthesis.
+The caller loops until everything is closed."
+ (goto-char font-lock-end)
+ (let* ((scan (syntax-ppss))
+ (open (nth 1 scan)))
+ (when (and open
+ (goto-char open)
+ (looking-at "(")
+ (goto-char font-lock-end)
+ (re-search-forward ")" (point-max) t))
+ (haskell-tng:debug-extend (point))
+ (setq font-lock-end (point)))))
+
(defun haskell-tng:multiline-faces ()
"For use in `font-lock-extend-region-functions'.
Detects multiline patterns, such as multiline `module', `import'
and type signatures, setting `font-lock-beg' / `font-lock-end'
appropriately, returning nil."
- (save-excursion
- ;; TODO break this logic into multiple deffuns so we can use the replay
- ;; logic as intended.
- (goto-char font-lock-end)
- (let ((detect-type (rx (| (: symbol-start "::" symbol-end)
- (: line-start (+ space) "->" symbol-end)))))
- (when (re-search-backward detect-type font-lock-beg t)
- ;; we're in the middle of a type signature. Close any dangling parens or
- ;; scan until we see a line that doesn't start with ->
- (if-let (close (haskell-tng:closing-paren))
- (when (< font-lock-end close)
- (haskell-tng:debug-extend close)
- (setq font-lock-end close))
- ;; TODO scan forward
- nil)))
-
- ;; TODO: detect -> and move to the start of the type (unless its a lambda)
- ;; TODO: detect module / import and check if its multiline
- ;; TODO: detect unbalanced parens and scan back for import
- ))
+ ;; TODO: detect -> and move to the start of the type (unless its a lambda)
+ ;; TODO: detect module / import (including from the parens block)
+ nil
+ )
(defun haskell-tng:debug-extend (to)
- (message "extending `%s' to `%s'!"
+ (message "extending `%s' to include `%s'!"
(buffer-substring-no-properties font-lock-beg font-lock-end)
- (buffer-substring-no-properties font-lock-end to)))
-
-;; TODO: this feels like something that would be in the stdlib...
-(defun haskell-tng:closing-paren ()
- "If point is in an unbalanced parenthesis return the point that
-closes it, otherwise nil."
- (let* ((scan (syntax-ppss))
- (open (nth 1 scan)))
- (when open
- (save-excursion
- (goto-char open)
- (when (looking-at "(")
- (ignore-errors
- (forward-list)
- (backward-char)
- (point)))))))
+ (if (< to font-lock-beg)
+ (buffer-substring-no-properties to font-lock-beg)
+ (buffer-substring-no-properties font-lock-end to))))
(defun haskell-tng:mark-block ()
;; TODO: this is kinda obscure, replace with mark-defun when it is defined
diff --git a/haskell-tng-mode.el b/haskell-tng-mode.el
index 2ce02411..6049d79 100644
--- a/haskell-tng-mode.el
+++ b/haskell-tng-mode.el
@@ -51,6 +51,8 @@
nil nil nil nil
(font-lock-mark-block-function .
haskell-tng:mark-block))
font-lock-extend-region-functions '(font-lock-extend-region-wholelines
+ haskell-tng:extend-parens-open
+ haskell-tng:extend-parens-close
haskell-tng:multiline-faces)
;; whitespace is meaningful, no electric indentation
diff --git a/haskell-tng-syntax.el b/haskell-tng-syntax.el
index 015e804..5f7a564 100644
--- a/haskell-tng-syntax.el
+++ b/haskell-tng-syntax.el
@@ -75,22 +75,20 @@
(defun haskell-tng:propertize-char-delims (start end)
"Matching apostrophes are string delimiters (literal chars)."
- (save-excursion
- (goto-char start)
- (while (re-search-forward "'\\\\?.'" end t)
- (let ((open (match-beginning 0))
- (close (- (point) 1)))
- (put-text-property open (1+ open) 'syntax-table '(7 . ?\'))
- (put-text-property close (1+ close) 'syntax-table '(7 . ?\'))))))
+ (goto-char start)
+ (while (re-search-forward "'\\\\?.'" end t)
+ (let ((open (match-beginning 0))
+ (close (- (point) 1)))
+ (put-text-property open (1+ open) 'syntax-table '(7 . ?\'))
+ (put-text-property close (1+ close) 'syntax-table '(7 . ?\')))))
(defun haskell-tng:propertize-escapes (start end)
"Backslash inside String is an escape character."
- (save-excursion
- (goto-char start)
- (while (re-search-forward "\\\\" end t)
- (when (nth 3 (syntax-ppss))
- (put-text-property (- (point) 1) (point)
- 'syntax-table '(9 . ?\\))))))
+ (goto-char start)
+ (while (re-search-forward "\\\\" end t)
+ (when (nth 3 (syntax-ppss))
+ (put-text-property (- (point) 1) (point)
+ 'syntax-table '(9 . ?\\)))))
(provide 'haskell-tng-syntax)
;;; haskell-tng-syntax.el ends here
