branch: elpa/forth-mode
commit 162b79f005a64b1f91e60b8f4c022d1d90cd3d95
Author: Helmut Eller <eller.hel...@gmail.com>
Commit: Lars Brinkhoff <l...@nocrew.org>
Better indentation in the presence of POSTPONE.
Make the SMIE lexer aware of POSTPONE, so that indentation isn't so
easily messed up when POSTPONE quotes IF or other words relevant to
indentation.
* forth-smie.el (forth-smie--backward-token)
(forth-smie--backward-token): Look at the next two words, so that we
can recognize "POSTPONE IF" as a single token.
(forth-smie--backward-word, forth-smie--forward-word): New helpers.
(forth-smie--parsing-word-regexp): New precomputed regexp.
* test/tests.el (forth-indent-postpone, forth-smie-backward-token)
(forth-smie-forward-token): New tests.
(forth-assert-backward-token,forth-assert-forward-token): New
helpers.
---
forth-smie.el | 40 ++++++++++++++++++++++++------
test/tests.el | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 111 insertions(+), 9 deletions(-)
diff --git a/forth-smie.el b/forth-smie.el
index df6678151d..077f387894 100644
--- a/forth-smie.el
+++ b/forth-smie.el
@@ -75,19 +75,43 @@ This variable can also be set in .dir-locals.el, e.g.:
(`(:list-intro . ,_) t)
(_ nil)))
+(defconst forth-smie--parsing-word-regexp
+ (eval-when-compile
+ (concat "^"
+ (regexp-opt '("postpone" "[']" "[char]"))
+ "$")))
+
+(defun forth-smie--forward-word ()
+ (let* ((start (progn (skip-syntax-forward " ") (point)))
+ (end (progn (skip-syntax-forward "w_") (point))))
+ (buffer-substring-no-properties start end)))
+
+(defun forth-smie--backward-word ()
+ (let* ((end (progn (skip-syntax-backward " ") (point)))
+ (start (progn (skip-syntax-backward "w_") (point))))
+ (buffer-substring-no-properties start end)))
+
(defun forth-smie--forward-token ()
(forward-comment (point-max))
- (downcase (buffer-substring-no-properties
- (point)
- (progn (skip-syntax-forward "w_")
- (point)))))
+ (let* ((word1 (downcase (forth-smie--forward-word)))
+ (pos1 (point))
+ (word2 (downcase (forth-smie--forward-word))))
+ (cond ((string-match forth-smie--parsing-word-regexp word1)
+ (list word1 word2))
+ (t
+ (goto-char pos1)
+ word1))))
(defun forth-smie--backward-token ()
(forward-comment (- (point)))
- (downcase (buffer-substring-no-properties
- (point)
- (progn (skip-syntax-backward "w_")
- (point)))))
+ (let* ((word1 (downcase (forth-smie--backward-word)))
+ (pos1 (point))
+ (word2 (downcase (forth-smie--backward-word))))
+ (cond ((string-match forth-smie--parsing-word-regexp word2)
+ (list word2 word1))
+ (t
+ (goto-char pos1)
+ word1))))
(defun forth-smie-setup ()
(smie-setup (forth-smie--grammar) #'forth-smie--indentation-rules
diff --git a/test/tests.el b/test/tests.el
index 94a87d2d12..039319d41b 100644
--- a/test/tests.el
+++ b/test/tests.el
@@ -120,6 +120,22 @@ The whitespace before and including \"|\" on each line is
removed."
(progn . ,body)
(kill-process proc))))
+(defun forth-assert-backward-token (content token)
+ (cl-destructuring-bind (content pos1 pos2) (forth-strip-|-and-¹² content)
+ (forth-with-temp-buffer content
+ (goto-char pos1)
+ (let ((token2 (forth-smie--backward-token)))
+ (should (equal token2 token))
+ (should (= (point) pos2))))))
+
+(defun forth-assert-forward-token (content token)
+ (cl-destructuring-bind (content pos1 pos2) (forth-strip-|-and-¹² content)
+ (forth-with-temp-buffer content
+ (goto-char pos1)
+ (let ((token2 (forth-smie--forward-token)))
+ (should (equal token2 token))
+ (should (= (point) pos2))))))
+
(ert-deftest forth-paren-comment-font-lock ()
(forth-assert-face "→( )" font-lock-comment-delimiter-face)
(forth-assert-face "→.( )" font-lock-comment-face)
@@ -306,10 +322,44 @@ The whitespace before and including \"|\" on each line is
removed."
| ;
|execute"))
+(ert-deftest forth-indent-postpone ()
+ (forth-should-indent
+ ": foo
+ | postpone :
+ | 42 postpone literal
+ | postpone ;
+ |;")
+ (forth-should-indent
+ ": foo
+ | POSTPONE :
+ | 42 POSTPONE literal
+ | postpone ;
+ |;")
+ (forth-should-indent
+ ": foo
+ | postpone if
+ | if
+ | postpone then
+ | else
+ | postpone then
+ | then
+ |;")
+ (forth-should-indent
+ ": foo
+ | ['] :
+ | if
+ | postpone ;
+ | else
+ | postpone recurse postpone ;
+ | then
+ |;")
+ )
+
(ert-deftest forth-sexp-movements ()
(forth-assert-forward-sexp " ¹: foo bar ;² \ x")
(forth-assert-forward-sexp " ¹:noname foo bar ;² \ x")
- (forth-assert-forward-sexp " ¹if drop exit else 1+ then² bar "))
+ (forth-assert-forward-sexp " ¹if drop exit else 1+ then² bar ")
+ (forth-assert-forward-sexp " : foo ¹postpone if² postpone then ;"))
;; IDEA: give the filename in "include filename" string syntax.
(ert-deftest forth-word-movements ()
@@ -386,3 +436,31 @@ The whitespace before and including \"|\" on each line is
removed."
"2c→"
"2Constant→"
#'completion-at-point)))
+
+(ert-deftest forth-smie-backward-token ()
+ (forth-assert-backward-token "²foo¹" "foo")
+ (forth-assert-backward-token "²foo-bar¹" "foo-bar")
+ (forth-assert-backward-token " ²foo-bar ¹baz" "foo-bar")
+ (forth-assert-backward-token " ²?#!-+ ¹" "?#!-+")
+ (forth-assert-backward-token " ²foo ( x y ) ¹" "foo")
+ (forth-assert-backward-token " foo \ x ²y ¹" "y")
+ (forth-assert-backward-token " ²postpone foo¹" '("postpone" "foo"))
+ (forth-assert-backward-token " ²['] foo ¹" '("[']" "foo"))
+ (forth-assert-backward-token " ²[char] : ¹" '("[char]" ":"))
+ ;; We're mostly interested in getting indentation inside colon
+ ;; definitions right, so here we don't treat ' as parsing word.
+ (forth-assert-backward-token " ' ²foo¹" "foo")
+ (forth-assert-backward-token " : ²foo¹" "foo"))
+
+(ert-deftest forth-smie-forward-token ()
+ (forth-assert-forward-token "¹foo²" "foo")
+ (forth-assert-forward-token "¹foo-bar²" "foo-bar")
+ (forth-assert-forward-token " ¹foo-bar² baz" "foo-bar")
+ (forth-assert-forward-token " ¹?#!-+² " "?#!-+")
+ (forth-assert-forward-token " ¹foo² ( x y )" "foo")
+ (forth-assert-forward-token " foo \ x ¹y² " "y")
+ (forth-assert-forward-token " ¹postpone foo²" '("postpone" "foo"))
+ (forth-assert-forward-token " ¹ ['] foo² " '("[']" "foo"))
+ (forth-assert-forward-token " ¹[char] :² " '("[char]" ":"))
+ (forth-assert-forward-token " ¹'² foo" "'")
+ (forth-assert-forward-token " ¹:² foo" ":"))
