branch: elpa/tuareg
commit 1a2aa93f3bb8b79a290d6a18e821cb10cd1bdf21
Author: Mattias Engdegård <matti...@acm.org>
Commit: Mattias Engdegård <matti...@acm.org>
Better phrase discovery
This rectifies imperfect phrase discovery and movement by defun for
several constructs. Fixes issue #256.
---
tuareg-tests.el | 92 ++++++++++++++++++++++++++++++++++++++-------------------
tuareg.el | 55 +++++++++++++++++++++-------------
2 files changed, 95 insertions(+), 52 deletions(-)
diff --git a/tuareg-tests.el b/tuareg-tests.el
index cef8733..720e4ed 100644
--- a/tuareg-tests.el
+++ b/tuareg-tests.el
@@ -230,7 +230,7 @@ Returns the value of the last FORM."
(end-of-defun)
(should (equal (point) p8a)))))
-(ert-deftest tuareg-phrase-discovery ()
+(ert-deftest tuareg-phrase-discovery-1 ()
(with-temp-buffer
(tuareg-mode)
(tuareg--lets
@@ -242,16 +242,13 @@ Returns the value of the last FORM."
(insert "and g x =\n"
" x * 2\n")
(let p2b (point))
+ (insert "type ta = A\n"
+ " | B of tb\n")
+ (let p3a (point))
+ (insert "and tb = C\n"
+ " | D of ta\n")
+ (let p3b (point))
(insert ";;\n")
- (let p2c (point))
- (insert "(1 < 2) = false;;\n")
- (let p3 (point))
- (insert "'a';;\n")
- (let p4 (point))
- (insert "\"abc\" ^ \" \" ^ \"def\";;\n")
- (let p5 (point))
- (insert "{|with \\ special \" chars|};;\n")
- (let p6 (point))
(goto-char (point-min))
(end-of-defun)
@@ -261,22 +258,14 @@ Returns the value of the last FORM."
(end-of-defun)
(should (equal (point) p2b))
(end-of-defun)
- (should (equal (point) p3))
- (end-of-defun)
- (should (equal (point) p4))
- (end-of-defun)
- (should (equal (point) p5))
+ (should (equal (point) p3a))
(end-of-defun)
- (should (equal (point) p6))
+ (should (equal (point) p3b))
(beginning-of-defun)
- (should (equal (point) p5))
+ (should (equal (point) p3a))
(beginning-of-defun)
- (should (equal (point) p4))
- (beginning-of-defun)
- (should (equal (point) p3))
- (beginning-of-defun)
- (should (equal (point) p2c))
+ (should (equal (point) p2b))
(beginning-of-defun)
(should (equal (point) p2a))
(beginning-of-defun)
@@ -288,15 +277,56 @@ Returns the value of the last FORM."
(list (point-min) (1- p1) (1- p1))))
(should (equal (tuareg-discover-phrase p1)
(list p1 (1- p2b) (1- p2b))))
- (should (equal (tuareg-discover-phrase p2c)
- (list p2c (1- p3) (1- p3))))
- (should (equal (tuareg-discover-phrase p3)
- (list p3 (1- p4) (1- p4))))
- (should (equal (tuareg-discover-phrase p4)
- (list p4 (1- p5) (1- p5))))
- (should (equal (tuareg-discover-phrase p5)
- (list p5 (1- p6) (1- p6))))
- )))
+ (should (equal (tuareg-discover-phrase p2b)
+ (list p2b (1- p3b) (1- p3b)))))))
+
+(ert-deftest tuareg-phrase-discovery-2 ()
+ (let ((lines
+ '("(1 < 2) = false;;"
+ "'a';;"
+ "\"abc\" ^ \" \" ^ \"def\";;"
+ "{|with \\ special \" chars|};;"
+ "max 1 2;;"
+ "if true then 1 else 2 ;;"
+ "while false do print_endline \"a\" done ;;"
+ "for i = 1 to 3 do print_int i done ;;"
+ "open Stdlib.Printf;;"
+ "begin print_char 'a'; print_char 'b'; end ;;"
+ "match [1;2] with a :: _ -> a | [] -> 3 ;;"
+ "exception E of int * string ;;"
+ "external myid : 'a -> 'a = \"%identity\";;"
+ "class k = object method m = 1 end;;")))
+
+ (with-temp-buffer
+ (tuareg-mode)
+ (dolist (line lines)
+ (insert line "\n"))
+
+ ;; Check movement by defun.
+ (goto-char (point-min))
+ (let ((pos (point-min)))
+ (dolist (line lines)
+ (let ((next-pos (+ pos (length line) 1)))
+ (ert-info ((prin1-to-string line) :prefix "line: ")
+ (end-of-defun)
+ (should (equal (point) next-pos))
+ (setq pos next-pos))))
+
+ (dolist (line (reverse lines))
+ (let ((prev-pos (- pos (length line) 1)))
+ (ert-info ((prin1-to-string line) :prefix "line: ")
+ (beginning-of-defun)
+ (should (equal (point) prev-pos))
+ (setq pos prev-pos)))))
+
+ ;; Check phrase discovery.
+ (let ((pos (point-min)))
+ (dolist (line lines)
+ (let ((next-pos (+ pos (length line) 1)))
+ (ert-info ((prin1-to-string line) :prefix "line: ")
+ (should (equal (tuareg-discover-phrase pos)
+ (list pos (1- next-pos) (1- next-pos))))
+ (setq pos next-pos))))))))
(ert-deftest tuareg-defun-separator ()
;; Check correct handling of ";;"-separated defuns/phrases.
diff --git a/tuareg.el b/tuareg.el
index 16fceea..12ea951 100644
--- a/tuareg.el
+++ b/tuareg.el
@@ -2497,26 +2497,35 @@ at the start of one."
"Assuming that we are at the beginning of a definition, move to its end.
See variable `end-of-defun-function'."
(interactive)
- (tuareg-smie--forward-token) ; Skip the head token.
- (tuareg-smie--forward-sexp-and)
- (let ((end (point)))
- ;; Check whether this defun is part of a let...and... chain that
- ;; ends with "in", in which case it is a single big defun.
- ;; Otherwise, go back to the first end position.
- (while
- (let ((tok (tuareg-smie--forward-token)))
- (cond ((equal tok "and")
- ;; Skip the "and" clause and keep looking.
- (tuareg-smie--forward-sexp-and)
- t)
- ((equal tok "in")
- ;; It's an expression, not a declaration: go to its end.
- (tuareg-smie--forward-sexp-and)
- nil)
- (t
- ;; No "in" found; use what we had at the start.
- (goto-char end)
- nil)))))
+ (let* ((start (point))
+ (head (tuareg-smie--forward-token))) ; Skip the head token.
+ (cond
+ ((member head '("type" "d-let" "let" "and" "exception" "module"
+ "class" "val" "external" "open"))
+ ;; Non-expression defun.
+ (tuareg-smie--forward-sexp-and)
+ (let ((end (point)))
+ ;; Check whether this defun is part of a let...and... chain that
+ ;; ends with "in", in which case it is a single big defun.
+ ;; Otherwise, go back to the first end position.
+ (while
+ (let ((tok (tuareg-smie--forward-token)))
+ (cond ((equal tok "and")
+ ;; Skip the "and" clause and keep looking.
+ (tuareg-smie--forward-sexp-and)
+ t)
+ ((equal tok "in")
+ ;; It's an expression, not a declaration: go to its end.
+ (tuareg-smie--forward-sexp-and)
+ nil)
+ (t
+ ;; No "in" found; use what we had at the start.
+ (goto-char end)
+ nil))))))
+ (t
+ ;; Expression: go back and skip it all at once.
+ (goto-char start)
+ (smie-forward-sexp ";;"))))
(tuareg--skip-forward-comments-semicolon))
(defun tuareg-beginning-of-defun (&optional arg)
@@ -2615,7 +2624,11 @@ point at the beginning of the error and return `nil'."
(setq begin (point))
;; Go all the way to the end of the phrase (not just the defun,
;; which could end at an "and").
- (tuareg-smie-forward-token)
+ (let ((head (tuareg-smie-forward-token)))
+ (unless (member head '("type" "d-let" "let" "and" "exception" "module"
+ "class" "val" "external" "open"))
+ ;; Expression phrase.
+ (goto-char begin)))
(smie-forward-sexp ";;")
(tuareg--skip-forward-comments-semicolon)
(setq end (point))
