648 lines
29 KiB
EmacsLisp
648 lines
29 KiB
EmacsLisp
;;; test-flan-fln.el --- The .fln mode, from written-out text -*- lexical-binding: t; -*-
|
|
|
|
;; Loaded by test-flan-cider.el, which runs under `dune test', for the reason
|
|
;; test-flan-mode.el is: `emacs/*.el' is already that stanza's dependency.
|
|
;; Nothing here needs a daemon; what the daemon makes of what these commands
|
|
;; send is test-flan-fln-live.el's, run from test-flan.el.
|
|
;;
|
|
;; Every snippet is text; each check says where point is with a `|' written
|
|
;; into it, which is removed before the check runs.
|
|
|
|
;;; Code:
|
|
|
|
(require 'flan-fln-mode)
|
|
(require 'flan)
|
|
|
|
(declare-function test-flan--check "test-flan-cider" (name ok))
|
|
|
|
(defmacro test-flan-fln--in (text &rest body)
|
|
"Run BODY in a .fln buffer holding TEXT, point where TEXT has its `|'."
|
|
(declare (indent 1))
|
|
`(with-temp-buffer
|
|
(insert ,text)
|
|
(flan-fln-mode)
|
|
(goto-char (point-min))
|
|
(when (search-forward "|" nil t)
|
|
(delete-char -1))
|
|
,@body))
|
|
|
|
(defun test-flan-fln--text (b)
|
|
(and b (cdr b) (buffer-substring-no-properties (car b) (cdr b))))
|
|
|
|
(defun test-flan-fln--is (name got want)
|
|
(test-flan--check name (equal got want))
|
|
(unless (equal got want)
|
|
(message " want %S\n got %S" want got)))
|
|
|
|
(defun test-flan-fln--thing (thing)
|
|
(test-flan-fln--text (bounds-of-thing-at-point thing)))
|
|
|
|
(message "\nthe .fln mode")
|
|
|
|
;;; One parent
|
|
|
|
(test-flan--check "flan-mode is a flan-base-mode"
|
|
(provided-mode-derived-p 'flan-mode 'flan-base-mode))
|
|
(test-flan--check "flan-fln-mode is a flan-base-mode"
|
|
(provided-mode-derived-p 'flan-fln-mode 'flan-base-mode))
|
|
(test-flan--check ".fln opens in flan-fln-mode"
|
|
(eq (cdr (assoc "\\.fln\\'" auto-mode-alist)) 'flan-fln-mode))
|
|
(test-flan-fln--in "fn f() -> i32 = 1\n"
|
|
(test-flan--check "a .fln buffer sends the indented syntax"
|
|
(equal (flan--syntax) "indented"))
|
|
(test-flan--check "and gets the client's completion, as a .flan one does"
|
|
(memq #'flan-completion-at-point completion-at-point-functions))
|
|
(test-flan--check "and the modeline indicator"
|
|
(member '(:eval (flan-mode-line)) mode-line-misc-info))
|
|
(test-flan--check "the shared keys reach it through the parent's map"
|
|
(eq (key-binding (kbd "C-c C-b")) 'flan-cnr-show))
|
|
(test-flan--check "and its own keys pick .fln forms"
|
|
(and (eq (key-binding (kbd "C-c C-c")) 'flan-fln-eval-defun)
|
|
(eq (key-binding (kbd "C-x C-e")) 'flan-fln-eval-last))))
|
|
(require 'flan-watch)
|
|
(let ((b (generate-new-buffer "ghost.fln")))
|
|
(with-current-buffer b (flan-fln-mode))
|
|
(switch-to-buffer b)
|
|
(test-flan--check "watch paints ghost text in a shown .fln buffer"
|
|
(memq b (flan-watch--ghost-buffers)))
|
|
(with-current-buffer b
|
|
(insert "fn f() -> ()\n watch-i64(\"x\", 1)\n")
|
|
(test-flan--check "and finds a watch call written as a .fln call"
|
|
(equal (mapcar #'car (flan-watch--ghost-sites)) '("x"))))
|
|
(kill-buffer b))
|
|
(require 'flan-dape)
|
|
(test-flan--check "dape offers its config in any Flan buffer"
|
|
(equal (plist-get flan-dape-config 'modes) '(flan-base-mode)))
|
|
(let ((buffer-file-name "/tmp/x.fln"))
|
|
(test-flan--check "and debugs the .fln file it was started from"
|
|
(equal (flan-dape--source) "/tmp/x.fln")))
|
|
|
|
;;; The objects
|
|
|
|
(defconst test-flan-fln--settle
|
|
"fn settle(row: i32, col: i32) -> ()
|
|
let vel = f32(gravity) + velocity[row, col]
|
|
while y > row
|
|
if 0 == grid[y, col]
|
|
grid[y, col] = grid[row, col]
|
|
; a comment inside the body
|
|
|
|
return
|
|
let left? = col > 0
|
|
if left? or right?
|
|
let side =
|
|
if not left?
|
|
1
|
|
elif not right?
|
|
-1
|
|
else
|
|
if f32(rand()) < 0.5 then 1 else -1
|
|
grid[y, col + side] = grid[row, col]
|
|
y = y - 1
|
|
velocity[row, col] = 0.0
|
|
|
|
; trailing comment, not part of the function
|
|
|
|
fn step() -> ()
|
|
paint-at(i32(m.y) / cell-size,
|
|
i32(m.x) / cell-size)
|
|
if r >= 0 and r < rows - 1
|
|
and c >= 0
|
|
grid[r, c] = 1
|
|
step()
|
|
")
|
|
|
|
(defun test-flan-fln--at (text needle)
|
|
"TEXT with a `|' before the first NEEDLE."
|
|
(let ((i (string-search needle text)))
|
|
(concat (substring text 0 i) "|" (substring text i))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "if 0 == grid")
|
|
(test-flan-fln--is "a statement takes its body, through blank and comment lines"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"if 0 == grid[y, col]
|
|
grid[y, col] = grid[row, col]
|
|
; a comment inside the body
|
|
|
|
return")
|
|
(test-flan-fln--is "its body is the lines under its first"
|
|
(test-flan-fln--thing 'flan-fln-body)
|
|
"grid[y, col] = grid[row, col]
|
|
; a comment inside the body
|
|
|
|
return"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "elif not right")
|
|
(test-flan-fln--is "on a clause, the statement is its header's, clauses and all"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"if not left?
|
|
1
|
|
elif not right?
|
|
-1
|
|
else
|
|
if f32(rand()) < 0.5 then 1 else -1")
|
|
(test-flan-fln--is "and the clause is its own line and block"
|
|
(test-flan-fln--thing 'flan-fln-clause)
|
|
"elif not right?
|
|
-1"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "1\n elif")
|
|
(test-flan-fln--is "a clause is not found from the header's own block"
|
|
(test-flan-fln--thing 'flan-fln-clause) nil))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
|
(test-flan-fln--is "from inside else's block, the clause is the else"
|
|
(test-flan-fln--thing 'flan-fln-clause)
|
|
"else
|
|
if f32(rand()) < 0.5 then 1 else -1"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "let side =")
|
|
(test-flan-fln--is "let x = with the value as a block"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"let side =
|
|
if not left?
|
|
1
|
|
elif not right?
|
|
-1
|
|
else
|
|
if f32(rand()) < 0.5 then 1 else -1"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "i32(m.x)")
|
|
(test-flan-fln--is "a line inside a bracket is part of its statement"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"paint-at(i32(m.y) / cell-size,
|
|
i32(m.x) / cell-size)")
|
|
(test-flan-fln--is "a term is glued, brackets and all"
|
|
(test-flan-fln--thing 'flan-fln-term) "i32(m.x)")
|
|
(test-flan-fln--is "a group is a bracket pair"
|
|
(test-flan-fln--thing 'flan-fln-group)
|
|
"(i32(m.y) / cell-size,
|
|
i32(m.x) / cell-size)"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
|
(test-flan-fln--is "an operator continuation line is part of its statement"
|
|
(test-flan-fln--thing 'flan-fln-statement)
|
|
"if r >= 0 and r < rows - 1
|
|
and c >= 0
|
|
grid[r, c] = 1")
|
|
(test-flan-fln--is "and not the start of the body"
|
|
(test-flan-fln--thing 'flan-fln-body) "grid[r, c] = 1"))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "velocity[row, col] = 0.0")
|
|
(test-flan-fln--is "a top-level form ends before trailing comment lines"
|
|
(test-flan-fln--thing 'flan-fln-toplevel)
|
|
(substring test-flan-fln--settle 0
|
|
(+ (string-search "= 0.0" test-flan-fln--settle) 5))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "trailing comment")
|
|
(test-flan--check "a comment between forms belongs to the form above"
|
|
(string-prefix-p "fn settle"
|
|
(test-flan-fln--thing 'flan-fln-toplevel))))
|
|
|
|
(test-flan-fln--in "; a header comment\n|\nfn f() -> i32 = 1\n"
|
|
(test-flan-fln--is "before any form, the next one"
|
|
(test-flan-fln--thing 'flan-fln-toplevel) "fn f() -> i32 = 1"))
|
|
|
|
(test-flan-fln--in "def xs = [1 2\n3 4]\n + 1\nfn|x() -> i32 = 1\n"
|
|
(test-flan-fln--is "column 0 inside a bracket or after a leading operator is no form start"
|
|
(save-excursion (beginning-of-defun)
|
|
(buffer-substring-no-properties (point) (line-end-position)))
|
|
"fnx() -> i32 = 1"))
|
|
|
|
(test-flan-fln--in "x = 1\nhandler-case\n f()\non E(c)\n nil\n|restart y\n"
|
|
(test-flan--check "on and restart at column 0 are clauses, not forms"
|
|
(progn (beginning-of-defun)
|
|
(looking-at "handler-case"))))
|
|
|
|
(test-flan-fln--in "let on = 3\nfoo(x):|\n bar()\n"
|
|
(test-flan-fln--is "a term ends before the trailing colon of a call's block"
|
|
(test-flan-fln--text (flan-fln--term-before (point))) "foo(x)"))
|
|
|
|
(test-flan-fln--in "f(\\(, \\) , x.y)|\n"
|
|
(test-flan-fln--is "a character literal is not a bracket"
|
|
(test-flan-fln--text (flan-fln--term-before (point)))
|
|
"f(\\(, \\) , x.y)"))
|
|
|
|
;;; Top-level motion
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " y = y - 1")
|
|
(beginning-of-defun)
|
|
(test-flan--check "C-M-a goes to the form's first line" (looking-at "fn settle"))
|
|
(end-of-defun)
|
|
(test-flan--check "C-M-e goes past its last code line, not its trailing comment"
|
|
(save-excursion (forward-line -1)
|
|
(looking-at " velocity\\[row, col\\] = 0.0")))
|
|
(end-of-defun)
|
|
(test-flan--check "and the next C-M-e ends the next form"
|
|
(= (point) (point-max)))
|
|
(goto-char (point-max))
|
|
(beginning-of-defun)
|
|
(test-flan--check "C-M-a from the end reaches the last form" (looking-at "fn step"))
|
|
(mark-defun)
|
|
(test-flan--check "C-M-h marks the form"
|
|
(let ((m (buffer-substring (region-beginning) (region-end))))
|
|
(and (string-prefix-p "fn step" (string-trim-left m "\n"))
|
|
(string-suffix-p " step()\n" m)))))
|
|
|
|
;;; Statement motion
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " let left?")
|
|
(flan-fln-backward-statement)
|
|
(test-flan--check "M-a at a statement's start goes to the one before at its level"
|
|
(looking-at "if 0 == grid"))
|
|
(flan-fln-backward-statement)
|
|
(test-flan--check "and out to the owner when there is none" (looking-at "while y"))
|
|
(flan-fln-forward-statement)
|
|
(test-flan--check "M-e goes to the end of the statement, body and all"
|
|
(looking-back "y = y - 1" (line-beginning-position)))
|
|
(flan-fln-forward-statement)
|
|
(test-flan--check "and again, to the end of the next"
|
|
(looking-back "= 0.0" (line-beginning-position))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle " -1")
|
|
(flan-fln-up)
|
|
(test-flan--check "C-M-u goes to the line that owns the block"
|
|
(looking-at "elif not right"))
|
|
(flan-fln-up)
|
|
(test-flan--check "and from there to its owner's" (looking-at "let side")))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "m.x)")
|
|
(flan-fln-up)
|
|
(test-flan--check "C-M-u inside a bracket goes to the bracket" (looking-at "(m.x)")))
|
|
|
|
;;; What each key sends
|
|
|
|
;; The request, captured where it leaves: the daemon's answer is the live
|
|
;; test's business, and here what matters is which text went out and where
|
|
;; it said the text starts.
|
|
(defvar test-flan-fln--sent nil)
|
|
|
|
(defmacro test-flan-fln--sending (&rest body)
|
|
`(progn
|
|
(setq test-flan-fln--sent nil)
|
|
(cl-letf (((symbol-function 'flan--request)
|
|
(lambda (form) (push form test-flan-fln--sent)
|
|
(list :status "ok" :value "0")))
|
|
((symbol-function 'pulse-momentary-highlight-region) #'ignore))
|
|
,@body)
|
|
(car test-flan-fln--sent)))
|
|
|
|
(defun test-flan-fln--sent-code (req)
|
|
(plist-get req :code))
|
|
|
|
(defconst test-flan-fln--prog
|
|
"fn fib(n: i64) -> i64
|
|
if n < 2
|
|
n
|
|
else
|
|
fib(n - 1) + fib(n - 2)
|
|
|
|
comment():
|
|
twice(4)
|
|
let x = 3
|
|
if x > 2
|
|
twice(x)
|
|
else
|
|
0
|
|
|
|
fn twice(n: i64) -> i64 = n * 2
|
|
")
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "fib(n - 1)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun))))
|
|
(test-flan--check "C-c C-c inside a fn installs the whole fn"
|
|
(and (equal (plist-get r :op) "eval")
|
|
(string-suffix-p "fib(n - 1) + fib(n - 2)"
|
|
(test-flan-fln--sent-code r))
|
|
(string-prefix-p "fn fib" (test-flan-fln--sent-code r))
|
|
(equal (plist-get r :syntax) "indented")))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun))))
|
|
(test-flan--check "C-c C-c on a column-0 call evaluates it"
|
|
(equal (plist-get r :op) "eval-expr"))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n let x")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "C-x C-e at a line's end sends the statement ending there"
|
|
(and (equal (plist-get r :op) "eval-expr")
|
|
(equal (test-flan-fln--sent-code r) "twice(4)")
|
|
(equal (plist-get r :line) 8)
|
|
(equal (plist-get r :col) 3)))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n else\n 0")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "the innermost one: the last line of a block, not the if"
|
|
(equal (test-flan-fln--sent-code r) "twice(x)"))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "(4)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "C-x C-e inside a line sends the term before point"
|
|
(and (equal (test-flan-fln--sent-code r) "twice")
|
|
(equal (plist-get r :col) 3)))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "\n\ncomment")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "at the end of a fn's last line, the innermost statement, not the fn"
|
|
(equal (test-flan-fln--sent-code r) "fib(n - 1) + fib(n - 2)"))))
|
|
|
|
(test-flan-fln--in test-flan-fln--prog
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "\n")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-last))))
|
|
(test-flan--check "a column-0 one-line fn at its end is installed"
|
|
(and (equal (plist-get r :op) "eval")
|
|
(string-suffix-p "fn twice(n: i64) -> i64 = n * 2"
|
|
(test-flan-fln--sent-code r))))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "else\n 0")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
|
(test-flan--check "C-c C-e on a clause sends its whole statement"
|
|
(and (equal (test-flan-fln--sent-code r)
|
|
"if x > 2\n twice(x)\n else\n 0")
|
|
(equal (plist-get r :line) 10)
|
|
(equal (plist-get r :col) 3)))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "let x = 3")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
|
(test-flan--check "C-c C-e on a bare let sends it with the rest of its block"
|
|
(equal (test-flan-fln--sent-code r)
|
|
"let x = 3\n if x > 2\n twice(x)\n else\n 0"))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement-and-next))))
|
|
(test-flan--check "C-c C-n sends the statement"
|
|
(equal (test-flan-fln--sent-code r) "twice(4)"))
|
|
(test-flan--check "and moves to the next" (looking-at "let x = 3"))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "twice(4)")
|
|
(transient-mark-mode 1)
|
|
(set-mark (point))
|
|
(search-forward "twice(x)")
|
|
(forward-char -3)
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-statement))))
|
|
(test-flan--check "C-c C-e sends the region's whole lines"
|
|
(equal (test-flan-fln--sent-code r)
|
|
"twice(4)\n let x = 3\n if x > 2\n twice(x)"))))
|
|
|
|
;; The pause target. The position sent is where the reader starts the form,
|
|
;; which for a call is its name and not its parenthesis; the live test checks
|
|
;; the daemon finds a form there.
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "n - 1)")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
|
(test-flan-fln--is "C-u C-c C-c in a call marks the call, from its name"
|
|
(plist-get r :pause) '(5 5))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "< 2")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
|
(test-flan-fln--is "outside a bracket, the statement on point's line"
|
|
(plist-get r :pause) '(2 3))))
|
|
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--prog "n < 2")
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(16)))))
|
|
(test-flan-fln--is "C-u C-u, the fn: stop on entry"
|
|
(plist-get r :pause) '(1 1))))
|
|
|
|
(test-flan-fln--in "fn f(x: i64) -> i64\n g((x| + 1), [x 2])\n"
|
|
(let ((r (test-flan-fln--sending (flan-fln-eval-defun '(4)))))
|
|
(test-flan-fln--is "a free parenthesis marks the value inside it"
|
|
(plist-get r :pause) '(2 6))))
|
|
|
|
;;; Indentation
|
|
|
|
(defun test-flan-fln--tabs (text n)
|
|
"The column TEXT's `|' line reaches after N TABs."
|
|
(test-flan-fln--in text
|
|
(let ((last-command nil) (this-command 'indent-for-tab-command))
|
|
(dotimes (_ n)
|
|
(indent-for-tab-command)
|
|
(setq last-command 'indent-for-tab-command)))
|
|
(current-indentation)))
|
|
|
|
(defconst test-flan-fln--nest
|
|
"fn f() -> ()
|
|
while a
|
|
if b
|
|
c()
|
|
|")
|
|
|
|
(test-flan-fln--is "the first TAB after a block goes to its column"
|
|
(test-flan-fln--tabs test-flan-fln--nest 1) 6)
|
|
(test-flan-fln--is "each TAB after that steps out one"
|
|
(list (test-flan-fln--tabs test-flan-fln--nest 2)
|
|
(test-flan-fln--tabs test-flan-fln--nest 3)
|
|
(test-flan-fln--tabs test-flan-fln--nest 4)
|
|
(test-flan-fln--tabs test-flan-fln--nest 5))
|
|
'(4 2 0 6))
|
|
(test-flan-fln--is "after a header, one level deeper first"
|
|
(test-flan-fln--tabs "fn f() -> ()\n while a\n|" 1) 4)
|
|
(test-flan-fln--is "after a trailing colon too"
|
|
(test-flan-fln--tabs "rl/with-drawing():\n|" 1) 2)
|
|
(test-flan-fln--is "and after let x ="
|
|
(test-flan-fln--tabs "def colors =\n|" 1) 2)
|
|
(test-flan-fln--is "but not after a one-line fn"
|
|
(test-flan-fln--tabs "fn f() -> i32 = 1\n|" 1) 0)
|
|
(test-flan-fln--is "else goes to its if's column, whatever the depth"
|
|
(test-flan-fln--tabs "if a\n if b\n c\n |else" 1) 2)
|
|
(test-flan-fln--is "and a second TAB to the outer if's"
|
|
(test-flan-fln--tabs "if a\n if b\n c\n |else" 2) 0)
|
|
(test-flan-fln--is "on goes to its handler-case's"
|
|
(test-flan-fln--tabs " handler-case\n f()\n |on E(c)" 1) 2)
|
|
(test-flan-fln--is "inside a call, under its first argument"
|
|
(test-flan-fln--tabs " paint-at(i32(m.y) / cell-size,\n|i32(m.x))" 1) 11)
|
|
(test-flan-fln--is "inside a bracket with nothing after it, one level in"
|
|
(test-flan-fln--tabs " let v = [\n|1 2]" 1) 4)
|
|
(test-flan-fln--is "a closing bracket, at its opening line's column"
|
|
(test-flan-fln--tabs " let v = [\n 1 2\n|]" 1) 2)
|
|
(test-flan-fln--is "after a line ending in an operator, deeper than its statement"
|
|
(test-flan-fln--tabs " if a and\n|b" 1) 4)
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n while a\n b()\n |"
|
|
(flan-fln-dedent-or-delete 1)
|
|
(test-flan-fln--is "backspace in the indentation drops one level"
|
|
(current-indentation) 2)
|
|
(flan-fln-dedent-or-delete 1)
|
|
(test-flan-fln--is "and another" (current-indentation) 0))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n ab|"
|
|
(flan-fln-dedent-or-delete 1)
|
|
(test-flan-fln--is "backspace after text deletes a character"
|
|
(buffer-substring (line-beginning-position) (point)) " a"))
|
|
|
|
(test-flan-fln--in "if a\n if b\n c\n els|"
|
|
(let ((last-command-event ?e))
|
|
(insert "e")
|
|
(run-hooks 'post-self-insert-hook))
|
|
(let ((last-command-event ?\s))
|
|
(insert " ")
|
|
(run-hooks 'post-self-insert-hook))
|
|
(test-flan-fln--is "else snaps to its if as it is typed"
|
|
(current-indentation) 2))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n b\n| c\n d\n"
|
|
(indent-region (point) (point-max))
|
|
(test-flan-fln--is "indent-region moves a block rigidly"
|
|
(buffer-substring (point) (point-max))
|
|
" c\n d\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n b\n |c\n"
|
|
(indent-region (point-min) (point-max))
|
|
(test-flan-fln--is "and leaves lines at valid columns alone"
|
|
(buffer-string) "fn f() -> ()\n if a\n b\n c\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n b\n |\n"
|
|
(kill-new "if x\n y\n else\n z")
|
|
(flan-fln-yank)
|
|
(test-flan-fln--is "a statement cut from its first character yanks as one block"
|
|
(buffer-string)
|
|
"fn f() -> ()\n if a\n b\n if x\n y\n else\n z\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n |\n"
|
|
(kill-new " while x\n y\n")
|
|
(flan-fln-yank)
|
|
(test-flan-fln--is "whole lines yank at point's column"
|
|
(buffer-string)
|
|
"fn f() -> ()\n if a\n while x\n y\n\n"))
|
|
|
|
;;; Block editing
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n if a\n |b()\n c()\n d()\n"
|
|
(flan-fln-slurp)
|
|
(test-flan-fln--is "slurp pulls the next statement into the block"
|
|
(buffer-string) "fn f() -> ()\n if a\n b()\n c()\n d()\n")
|
|
(flan-fln-barf)
|
|
(test-flan-fln--is "barf pushes the last one out again"
|
|
(buffer-string) "fn f() -> ()\n if a\n b()\n c()\n d()\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n |a()\n if x\n y\n b()\n"
|
|
(flan-fln-move-statement-down)
|
|
(test-flan-fln--is "a statement moves down past its sibling's whole block"
|
|
(buffer-string) "fn f() -> ()\n if x\n y\n a()\n b()\n")
|
|
(test-flan--check "and point moves with it" (looking-at "a()"))
|
|
(flan-fln-move-statement-up)
|
|
(test-flan-fln--is "and back up"
|
|
(buffer-string) "fn f() -> ()\n a()\n if x\n y\n b()\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n when(c):\n if x\n |y\n"
|
|
(flan-fln-raise-statement)
|
|
(test-flan-fln--is "raise replaces the owner with the statement"
|
|
(buffer-string) "fn f() -> ()\n when(c):\n y\n"))
|
|
|
|
(test-flan-fln--in "fn f() -> ()\n |if x\n y\n else\n z\n b()\n"
|
|
(flan-fln-kill-statement)
|
|
(test-flan-fln--is "kill takes the whole statement's lines"
|
|
(buffer-string) "fn f() -> ()\n b()\n")
|
|
(test-flan-fln--is "into the kill ring" (current-kill 0)
|
|
" if x\n y\n else\n z\n"))
|
|
|
|
;;; expand-region, where it is installed
|
|
|
|
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/expand-region-[0-9]*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/expand-region-[0-9]*")))
|
|
(load-path (append dirs load-path)))
|
|
(if (not (require 'expand-region nil t))
|
|
(message " skip expand-region (not installed)")
|
|
(test-flan-fln--in (test-flan-fln--at test-flan-fln--settle "right?\n -1")
|
|
(transient-mark-mode 1)
|
|
(let ((steps nil))
|
|
(dotimes (_ 6)
|
|
(er/expand-region 1)
|
|
(push (buffer-substring-no-properties (region-beginning) (region-end)) steps))
|
|
(setq steps (nreverse steps))
|
|
(test-flan-fln--is "term, then statement's clause, then statement, then out"
|
|
(mapcar (lambda (s) (car (split-string s "\n"))) steps)
|
|
'("right?" "elif not right?" "if not left?" "let side ="
|
|
"if left? or right?" "let left? = col > 0"))))))
|
|
|
|
;;; smartparens, where it is installed
|
|
|
|
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/smartparens-[0-9]*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/smartparens-[0-9]*")
|
|
(file-expand-wildcards "~/.config/emacs/elpa/dash-[0-9]*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/dash-[0-9]*")))
|
|
(load-path (append dirs load-path)))
|
|
(if (not (require 'smartparens nil t))
|
|
(message " skip smartparens (not installed)")
|
|
;; A setup that puts sexp commands on the top-level keys, as the
|
|
;; author's does.
|
|
(define-key smartparens-mode-map (kbd "C-M-a") 'sp-backward-down-sexp)
|
|
(define-key smartparens-mode-map (kbd "C-M-u") 'sp-backward-up-sexp)
|
|
(let ((b (generate-new-buffer "sp.fln")))
|
|
(switch-to-buffer b)
|
|
(flan-fln-mode)
|
|
(test-flan--check "smartparens is on in a .fln buffer" smartparens-mode)
|
|
(test-flan--check "and C-M-a and C-M-u stay the mode's"
|
|
(and (eq (key-binding (kbd "C-M-a")) 'beginning-of-defun)
|
|
(eq (key-binding (kbd "C-M-u")) 'flan-fln-up)))
|
|
(execute-kbd-macro "f(")
|
|
(test-flan-fln--is "it pairs a bracket" (buffer-string) "f()")
|
|
(erase-buffer)
|
|
(execute-kbd-macro "'a")
|
|
(test-flan-fln--is "and not a quote" (buffer-string) "'a")
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer b))
|
|
(define-key smartparens-mode-map (kbd "C-M-a") nil)
|
|
(define-key smartparens-mode-map (kbd "C-M-u") nil)))
|
|
|
|
;;; Under Evil
|
|
|
|
(let* ((dirs (append (file-expand-wildcards "~/.config/emacs/elpa/evil-[0-9]*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/evil-[0-9]*")
|
|
(file-expand-wildcards "~/.config/emacs/elpa/goto-chg-*")
|
|
(file-expand-wildcards "~/.emacs.d/elpa/goto-chg-*")))
|
|
(load-path (append dirs load-path)))
|
|
(if (not (require 'evil nil t))
|
|
(message " skip the .fln text objects (Evil is not installed)")
|
|
(evil-mode 1)
|
|
(unwind-protect
|
|
(let ((yanked
|
|
(lambda (text keys)
|
|
(let ((b (generate-new-buffer "objects.fln")))
|
|
(switch-to-buffer b)
|
|
(insert text)
|
|
(flan-fln-mode)
|
|
(evil-initialize-state)
|
|
(evil-normal-state)
|
|
(goto-char (point-min))
|
|
(search-forward "|")
|
|
(delete-char -1)
|
|
(execute-kbd-macro keys)
|
|
(prog1 (substring-no-properties (current-kill 0))
|
|
(set-buffer-modified-p nil)
|
|
(kill-buffer b))))))
|
|
(dolist (c `(("yiw" ,(test-flan-fln--at test-flan-fln--settle "settle(")
|
|
"settle")
|
|
("yie" ,(test-flan-fln--at test-flan-fln--settle "i32(m.x)")
|
|
"i32(m.x)")
|
|
("yis" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
|
"if r >= 0 and r < rows - 1\n and c >= 0\n grid[r, c] = 1")
|
|
("yas" ,(test-flan-fln--at test-flan-fln--settle "and c >= 0")
|
|
" if r >= 0 and r < rows - 1\n and c >= 0\n grid[r, c] = 1\n")
|
|
("yii" ,(test-flan-fln--at test-flan-fln--settle "if not left")
|
|
" 1\n")
|
|
("yik" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
|
" if f32(rand()) < 0.5 then 1 else -1\n")
|
|
("yak" ,(test-flan-fln--at test-flan-fln--settle "if f32(rand())")
|
|
" else\n if f32(rand()) < 0.5 then 1 else -1\n")
|
|
("yid" ,(test-flan-fln--at test-flan-fln--settle "paint-at")
|
|
,(substring test-flan-fln--settle
|
|
(string-search "fn step" test-flan-fln--settle)))))
|
|
(test-flan-fln--is (format "under Evil, %s" (car c))
|
|
(funcall yanked (nth 1 c) (car c)) (nth 2 c)))
|
|
(let ((b (generate-new-buffer "keys.fln")))
|
|
(switch-to-buffer b)
|
|
(insert "fn f() -> i32 = 1\n")
|
|
(flan-fln-mode)
|
|
(evil-initialize-state)
|
|
(test-flan--check "under Evil, C-x C-e is still the mode's"
|
|
(eq (key-binding (kbd "C-x C-e")) 'flan-fln-eval-last))
|
|
(goto-char (point-min))
|
|
(end-of-line)
|
|
(backward-char)
|
|
(test-flan--check "under Evil, C-x C-e counts the cursor's character"
|
|
(= (flan-fln--point-for-last) (line-end-position)))
|
|
(kill-buffer b)))
|
|
(evil-mode -1))))
|
|
|
|
;;; test-flan-fln.el ends here
|