[nongnu] elpa/haskell-tng-mode 52f0cb9 011/385: expand parens

[ELPA Syncer]

branch: elpa/haskell-tng-mode
commit 52f0cb9b574b3af163252ff16277ed6d87fe4675
Author: Tseen She <ts33n.sh3@gmail.com>
Commit: Tseen She <ts33n.sh3@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