In a .fln buffer numbers are coloured, a colon is not part of a name, TAB keeps a line at a valid column, evil line objects take their newline, and C-x C-e and C-u C-c C-c understand match arms, conditions, clauses and comments

This commit is contained in:
Joseph Ferano 2026-09-25 20:14:51 +07:00
parent 8c814b39c1
commit 267e84bada
4 changed files with 318 additions and 32 deletions

View File

@ -1186,8 +1186,8 @@ Use `C-c C-g` if you need frames.
| Holy | Evil | Does |
|---|---|---|
| `C-c C-c`, `C-M-x` | same | the top-level form: a declaration installed, anything else evaluated |
| `C-u C-c C-c` | same | ...and stop at the innermost bracket group, else the statement on point's line (`C-u C-u`: on entry) |
| `C-x C-e` | same, cursor on the line's last character | at a line's end, the innermost statement ending there; elsewhere, the term before point |
| `C-u C-c C-c` | same | ...and stop at the innermost bracket group, else the statement on point's line: an elif's condition, an else's block, a match arm's value (`C-u C-u`: on entry) |
| `C-x C-e` | same, cursor on the line's last character | at a line's end, the innermost statement ending there: a match arm's value, an if/elif/while condition, or the whole statement a header or clause line opens; elsewhere, the term before point |
| `C-c C-e` | same | the statement at point with its body and clauses, or the region's whole lines; on a bare `let x = v`, the `let` and the rest of its block |
| `C-c C-n` | same | `C-c C-e`, then move to the next statement |
| `C-c C-k` | same | the whole buffer |
@ -1195,7 +1195,7 @@ Use `C-c C-g` if you need frames.
| `M-a` / `M-e` | `(` / `)` | statement: start / end (`)`: start of the next) |
| `C-M-u` | same | up to the enclosing bracket, or the line that owns the block |
| `C-M-f` / `C-M-b` | same | brackets and terms, as everywhere |
| `TAB` | same | deepest valid column first; each repeat steps out a level |
| `TAB` | same | a line at a valid column stays; an empty or misplaced line goes deepest; each repeat steps out a level |
| `DEL` in indentation | same | drop one level |
| `C-c <` / `C-c >` | `<` / `>` | shift the region's lines a level |
| `M-<up>` / `M-<down>` | same | move the statement past its neighbour |

View File

@ -117,10 +117,13 @@ fine here. Brackets and strings are still paired."
(let ((table (make-syntax-table)))
;; Name characters: a name is anything up to a delimiter (`is_delimiter'
;; in lib/reader.ml), so `key-pressed?', `dyn->f64' and `rl/draw-fps' are
;; one symbol each. `:' too, so `:key-r' is one; the colon of `x: T' is
;; glued to the name and is trimmed off a term where it matters.
(dolist (c '(?- ?_ ?? ?! ?/ ?. ?$ ?& ?* ?+ ?< ?> ?= ?% ?: ?@ ?# ?^ ?| ?~))
;; one symbol each.
(dolist (c '(?- ?_ ?? ?! ?/ ?. ?$ ?& ?* ?+ ?< ?> ?= ?% ?@ ?# ?^ ?| ?~))
(modify-syntax-entry c "_" table))
;; Not `:', which ends `x: T' and `comment:': a name glued to it would
;; otherwise read as `x:', a name nothing defines. A `:key' keyword is
;; drawn by its own font-lock rule instead.
(modify-syntax-entry ?: "." table)
(modify-syntax-entry ?\; "<" table)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?\" "\"" table)
@ -473,9 +476,12 @@ For `end-of-defun-function'."
(and (< beg end) (cons beg end))))))
(defun flan-fln--term-before (pos)
"Bounds of the term that ends at POS, spaces before POS skipped, or nil."
"Bounds of the term that ends at POS, spaces before POS skipped, or nil.
A comment is skipped too: nothing in one is a term."
(save-excursion
(goto-char pos)
(let ((s (syntax-ppss pos)))
(when (nth 4 s) (goto-char (nth 8 s))))
(skip-chars-backward " \t,")
(let* ((end (point))
(beg (flan-fln--term-back end))
@ -560,11 +566,82 @@ Two: B itself, which stops on entry."
(t (or (flan-fln--pause-target (point) b) b))))
(defun flan-fln--pause-target (pos b)
(let ((g (flan-fln--group-bounds pos)))
(if (and g (cdr g) (> (car g) (car b)))
(cons (flan-fln--group-form-start (car g)) (cdr g))
(let ((s (flan-fln--statement-start-at pos)))
(and s (flan-fln--statement-bounds s))))))
"The form to stop at for point at POS inside the top-level form B.
Its start is where the reader starts that form, which is all the daemon
matches on: a match arm's value or block, not its pattern, which is no
form; an elif's condition and an else's, on's or restart's block, which are
forms, where the clause line itself is not."
(let* ((l (flan-fln--line-statement pos))
(arm (and l (flan-fln--arm l)))
(g (flan-fln--group-bounds pos)))
(cond
((and arm (< pos (plist-get arm :arrow))) (plist-get arm :value))
((and g (cdr g) (> (car g) (car b)))
(cons (flan-fln--group-form-start (car g)) (cdr g)))
(arm (plist-get arm :value))
((and l (flan-fln--clause-line-p l)) (flan-fln--clause-target l))
(t (let ((s (flan-fln--statement-start-at pos)))
(and s (flan-fln--statement-bounds s)))))))
(defun flan-fln--clause-target (l)
"What a clause line L stops at: an elif's condition, else its block."
(save-excursion
(goto-char (flan-fln--first-char l))
(if (looking-at "elif[ \t]+")
(cons (match-end 0) (flan-fln--code-end (flan-fln--logical-end l)))
(flan-fln--body-bounds l))))
(defun flan-fln--condition (l)
"Bounds of the condition on the if, elif, while or until line L, or nil.
A loop's label, `while :outer c', is not part of it."
(save-excursion
(goto-char (flan-fln--first-char l))
(when (looking-at "\\(?:if\\|elif\\|while\\|until\\)[ \t]+\\(?::[^ \t]+[ \t]+\\)?")
(let ((beg (match-end 0))
(end (flan-fln--code-end (flan-fln--logical-end l))))
(and (< beg end) (cons beg end))))))
(defun flan-fln--arm (l)
"The match arm whose joined line starts at L, or nil.
A plist: :arrow, where its ` -> ' starts; :value, the bounds of what follows
the arrow on the line, or of the block under it; :binds, non-nil when the
pattern names something, so the value cannot be evaluated alone."
(let ((parent (flan-fln--parent l)))
(when (and parent
(string-match-p "\\(?:\\`\\|[ \t]=[ \t]+\\)match\\(?:[ \t]\\|\\'\\)"
(buffer-substring-no-properties
(flan-fln--first-char parent)
(flan-fln--code-end parent))))
(save-excursion
(let* ((start (flan-fln--first-char l))
(last (flan-fln--code-end (flan-fln--logical-end l)))
(depth (car (syntax-ppss start)))
arrow)
(goto-char start)
(while (and (not arrow)
(re-search-forward "[ \t]\\(->\\)\\(?:[ \t]\\|$\\)" last t))
(let ((ps (save-excursion (syntax-ppss (match-beginning 1)))))
(when (and (= (car ps) depth) (not (nth 8 ps)))
(setq arrow (match-beginning 1)))))
(when arrow
(let* ((pat (string-trim (buffer-substring-no-properties start arrow)))
(vbeg (save-excursion (goto-char (+ arrow 2))
(skip-chars-forward " \t") (point)))
(value (if (< vbeg last) (cons vbeg last)
(flan-fln--body-bounds l))))
(and value
(list :arrow arrow :value value
:binds (or (string-match-p "[([{]" pat)
(and (string-match-p "\\`[a-z][^ \t]*\\'" pat)
(not (member pat flan--constants)))))))))))))
(defun flan-fln--arm-to-send (l arm)
"What evaluating the match arm at L sends: its value, or, when its pattern
binds a name the value uses, the whole match."
(if (plist-get arm :binds)
(flan-fln--statement-bounds
(flan-fln--statement-start-at (flan-fln--parent l)))
(plist-get arm :value)))
;;;###autoload
(defun flan-fln-eval-defun (&optional arg)
@ -609,13 +686,34 @@ before point. With ARG, stop there instead, as \\[flan-eval-last-sexp] does."
(interactive "P")
(flan-fln--client)
(let* ((end (flan-fln--point-for-last))
(st (and (>= end (flan-fln--code-end end))
(flan-fln--statement-ending-at end))))
(if st
(flan-fln--send (car st) (cdr st) arg flan--declaration-heads)
(at-end (and (>= end (flan-fln--code-end end))
(not (flan-fln--blank-p end))))
(l (and at-end (flan-fln--line-statement end)))
;; Point ends the line L starts, joined lines included.
(l-end (and l (= (flan-fln--bol end) (flan-fln--logical-end l))))
(arm (and l-end (flan-fln--arm l)))
(st (and at-end (not arm) (flan-fln--statement-ending-at end)))
(opens (and l-end (not st) (not arm)
(or (flan-fln--clause-line-p l)
(/= (flan-fln--statement-last l)
(flan-fln--logical-end l))))))
(cond
(arm (let ((b (flan-fln--arm-to-send l arm)))
(flan-fln--send (car b) (cdr b) arg flan--declaration-heads)))
(st (flan-fln--send (car st) (cdr st) arg flan--declaration-heads))
;; The end of a line that opens a block: its last word is not what was
;; meant. A condition is a value of its own; anything else is sent
;; with its block, a clause with the statement it belongs to.
((and opens (flan-fln--condition l))
(let ((c (flan-fln--condition l)))
(flan--eval-expression (car c) (cdr c) arg)))
(opens
(let ((b (flan-fln--statement-bounds (flan-fln--clause-header l))))
(flan-fln--send (car b) (cdr b) arg flan--declaration-heads)))
(t
(let ((tb (flan-fln--term-before end)))
(unless tb (user-error "flan: no form before point to evaluate"))
(flan--eval-expression (car tb) (cdr tb) arg)))))
(flan--eval-expression (car tb) (cdr tb) arg))))))
(defun flan-fln--snap-lines (beg end)
"BEG..END widened to whole lines, less leading blank lines and trailing space."
@ -650,10 +748,13 @@ before point. With ARG, stop there instead, as \\[flan-eval-last-sexp] does."
(defun flan-fln--statement-to-send (pos)
"The statement at POS as sent by `C-c C-e': with its body and clauses, and
for a bare `let x = v', with the rest of its block, which is its scope."
(let ((s (flan-fln--statement-start-at pos)))
(and s (if (flan-fln--bare-let-p s)
(flan-fln--block-rest s)
(flan-fln--statement-bounds s)))))
(let* ((l (flan-fln--line-statement pos))
(arm (and l (flan-fln--arm l)))
(s (flan-fln--statement-start-at pos)))
(cond (arm (flan-fln--arm-to-send l arm))
((null s) nil)
((flan-fln--bare-let-p s) (flan-fln--block-rest s))
(t (flan-fln--statement-bounds s)))))
;;;###autoload
(defun flan-fln-eval-statement (&optional arg)
@ -936,7 +1037,10 @@ opening line's column."
(t (flan-fln--levels (point))))))))))
(defun flan-fln-indent-line ()
"Indent the line to a block column: the deepest first, then out one per TAB."
"Indent the line to a block column.
A line with text at a valid column stays there: its column is its meaning,
and a TAB pressed to see where it goes must not change it. An empty line
goes to the deepest column. Each repeated TAB then steps out one."
(let* ((cands (flan-fln--indent-candidates (point)))
(cur (current-indentation))
(target
@ -945,6 +1049,10 @@ opening line's column."
(eq last-command 'indent-for-tab-command)
(memq cur cands))
(or (cadr (memq cur cands)) (car cands)))
((and (memq cur cands)
(not (save-excursion (beginning-of-line)
(looking-at-p "[ \t]*$"))))
cur)
(t (car cands)))))
(if (null target)
'noindent
@ -1231,7 +1339,7 @@ it, so a block pasted at another depth stays one block."
(,(concat "\\_<" (regexp-opt flan--constants t) "\\_>")
1 font-lock-constant-face)
;; A keyword. `x:' is a name with a colon glued on, not one.
("\\_<:[^][ \t\n(){},;\":]+" . font-lock-constant-face)
("\\(?:^\\|[][ \t(){},]\\)\\(:[^][ \t\n(){},;\":]+\\)" 1 font-lock-constant-face)
;; A type: after the `: ' of an annotation and after `-> '.
("[^ \t\n:]:[ \t]+\\([$a-zA-Z][^][ \t\n(){},;\"=]*\\)" 1 font-lock-type-face)
("[ \t]->[ \t]+\\([$a-zA-Z][^][ \t\n(){},;\"=]*\\)" 1 font-lock-type-face)
@ -1242,7 +1350,7 @@ it, so a block pasted at another depth stays one block."
("\\_<\\$[^][ \t\n(){},;\":]*" . font-lock-type-face)
;; A character literal, `\c' or `\space'.
("\\\\\\(?:space\\|newline\\|tab\\|return\\|[^ \t\n]\\)" . font-lock-string-face)
("\\_<-?[0-9][0-9a-fA-FxX_.]*\\_>" . font-lock-number-face))
("\\_<-?[0-9][0-9a-fA-FxX_.]*\\_>" . 'font-lock-number-face))
"Font lock for `flan-fln-mode'.")
(defvar flan-fln-imenu-generic-expression
@ -1350,18 +1458,21 @@ that says so and otherwise is its own."
;;; Evil
(defun flan-fln--evil (b type)
(if b (evil-range (car b) (cdr b) type) (error "No object here")))
;; A line range is handed over already whole -- from a line's start to the
;; start of the line after it -- and marked expanded, so Evil neither
;; stretches it to one more line nor leaves the last newline behind.
(cond ((null b) (error "No object here"))
((eq type 'line) (evil-range (car b) (cdr b) 'line :expanded t))
(t (evil-range (car b) (cdr b) type))))
(defun flan-fln--whole-lines (b)
(and b (cons (flan-fln--bol (car b)) (flan-fln--code-end (cdr b)))))
"B's lines, from the start of the first to the start of the line after."
(and b (flan-fln--lines (flan-fln--bol (car b)) (flan-fln--bol (cdr b)))))
(defun flan-fln--with-trailing-blanks (b)
"B's lines and the blank lines after them."
(and b (let ((n (flan-fln--next-code (cdr b))))
(cons (car b) (if n
(save-excursion (goto-char n) (forward-line -1)
(line-end-position))
(point-max))))))
"B's whole lines and the blank lines after them."
(and b (let ((n (flan-fln--next-code (1- (cdr b)))))
(cons (car b) (or n (point-max))))))
(defun flan-fln--term-around (b)
"B and the spaces after it, or before it when none follow."

View File

@ -30,6 +30,26 @@ fn total(n: i32) -> i32
t = t + i
t
fn sign(n: i64) -> i64
if n < 0
-1
elif n == 0
0
else
1
enum Dir
north
south
east
fn pick(d: Dir) -> i64
match d
:north -> 10
:south -> 20
_ ->
twice(3)
comment():
twice(4)
if 2 > 1
@ -134,7 +154,20 @@ comment():
;; answers `:pause' only when a form the reader made starts exactly
;; there (`Ast.mark_pause'). Each kind of target once, and one position
;; a column off to show the answer can be no.
;; C-x C-e on an arm's value, and on a condition line.
(funcall goto ":south -> 20" t)
(flan-fln-eval-last)
(test-flan--check (funcall name "C-x C-e at the end of a match arm evaluates its value")
(funcall shows "20"))
(funcall goto "if 2 > 1" t)
(flan-fln-eval-last)
(test-flan--check (funcall name "C-x C-e at the end of an if line evaluates the condition")
(funcall shows "true"))
(dolist (c '(("n - 1)" "a call, from its name")
("elif n" "an elif, at its condition")
("else\n 1" "an else, at its block")
(":south -> 20" "a match arm, at its value")
("_ ->" "a match arm, at its block")
("n < 2" "an if statement")
("t = 0" "a let")
("i in range" "a for")

View File

@ -408,6 +408,118 @@ fn twice(n: i64) -> i64 = n * 2
(test-flan-fln--is "a free parenthesis marks the value inside it"
(plist-get r :pause) '(2 6))))
;;; Match arms, header lines, clauses, comments
(defconst test-flan-fln--arms
"fn pick(n: i64) -> i64
let r = match n
0 -> 10
1 ->
twice(1)
twice(2)
k -> k + 1
if n < 0
-1
elif n == 0
or n == 1
0
else
r
handler-case
f()
on Error(e)
nil
; a comment, twice(9)
r
comment:
twice(4)
")
(defun test-flan-fln--last-at (needle &optional fn)
"What FN, C-x C-e by default, sends with point at the end of NEEDLE's line."
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms needle)
(end-of-line)
(let ((r (test-flan-fln--sending (funcall (or fn #'flan-fln-eval-last)))))
(and r (list (plist-get r :op) (test-flan-fln--sent-code r))))))
(test-flan-fln--is "C-x C-e at the end of a match arm sends its value"
(test-flan-fln--last-at "0 -> 10") '("eval-expr" "10"))
(test-flan-fln--is "at the end of an arm with a block, the block"
(test-flan-fln--last-at "1 ->")
'("eval-expr" "twice(1)\n twice(2)"))
(test-flan-fln--is "an arm whose pattern binds a name sends the whole match"
(cadr (test-flan-fln--last-at "k -> k"))
(substring test-flan-fln--arms (string-search "let r" test-flan-fln--arms)
(+ (string-search "k + 1" test-flan-fln--arms) 5)))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms "twice(2)")
(test-flan-fln--is "C-c C-e on an arm's block sends the block, not the arm"
(test-flan-fln--sent-code
(test-flan-fln--sending
(search-backward "1 ->") (flan-fln-eval-statement)))
"twice(1)\n twice(2)"))
(test-flan-fln--is "C-x C-e at the end of an if line sends its condition"
(test-flan-fln--last-at "if n < 0") '("eval-expr" "n < 0"))
(test-flan-fln--is "and of an elif, all of its condition"
(test-flan-fln--last-at "or n == 1")
'("eval-expr" "n == 0\n or n == 1"))
(test-flan-fln--is "at the end of an else line, the whole if"
(cadr (test-flan-fln--last-at "else\n r"))
"if n < 0\n -1\n elif n == 0\n or n == 1\n 0\n else\n r")
(test-flan-fln--is "at the end of an on line, the whole handler-case"
(cadr (test-flan-fln--last-at "on Error"))
"handler-case\n f()\n on Error(e)\n nil")
(test-flan-fln--is "at the end of a fn header, the fn, installed"
(car (test-flan-fln--last-at "fn pick")) "eval")
(test-flan-fln--is "at the end of comment:, the whole block"
(test-flan-fln--last-at "comment:")
'("eval-expr" "comment:\n twice(4)"))
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms "; a comment")
(end-of-line)
(let ((r (test-flan-fln--sending
(condition-case nil (flan-fln-eval-last) (user-error nil)))))
(test-flan--check "C-x C-e on a comment line sends nothing from the comment"
(null r))))
(defun test-flan-fln--pause-at (needle)
(test-flan-fln--in (test-flan-fln--at test-flan-fln--arms needle)
(plist-get (test-flan-fln--sending (flan-fln-eval-defun '(4))) :pause)))
(test-flan-fln--is "C-u C-c C-c on an arm's pattern stops at its value"
(test-flan-fln--pause-at "0 -> 10") '(3 10))
(test-flan-fln--is "on an arm with a block, at the block"
(test-flan-fln--pause-at "1 ->") '(5 7))
(test-flan-fln--is "on an elif line, at its condition"
(test-flan-fln--pause-at "elif") '(10 8))
(test-flan-fln--is "and from its condition's continuation line too"
(test-flan-fln--pause-at "or n == 1") '(10 8))
(test-flan-fln--is "on an else line, at its block"
(test-flan-fln--pause-at "else\n r") '(14 5))
(test-flan-fln--is "on an on line, at its block"
(test-flan-fln--pause-at "on Error") '(18 5))
;;; Names and colours
(test-flan-fln--in "fn f(x: i64) -> i64\n comment:\n g(:key-r, x)\n 0x1F + 12\n"
(search-forward "x:")
(backward-char 1)
(test-flan-fln--is "a colon glued to a name is not part of it"
(thing-at-point 'symbol t) "x")
(search-forward "comment")
(test-flan-fln--is "nor to a name that takes a block"
(thing-at-point 'symbol t) "comment")
(test-flan--check "font-lock draws the buffer without an error"
(condition-case nil (progn (font-lock-ensure) t) (error nil)))
(let ((face (lambda (needle)
(save-excursion (goto-char (point-min)) (search-forward needle)
(get-text-property (match-beginning 0) 'face)))))
(test-flan-fln--is "a number is drawn as one" (funcall face "12") 'font-lock-number-face)
(test-flan-fln--is "a keyword as a constant" (funcall face ":key-r") 'font-lock-constant-face)
(test-flan-fln--is "a header word as a keyword" (funcall face "fn") 'font-lock-keyword-face)
(test-flan-fln--is "a type after its colon" (funcall face "i64") 'font-lock-type-face)
(test-flan--check "and the name before the colon is not a keyword"
(null (funcall face "x:")))))
;;; Indentation
(defun test-flan-fln--tabs (text n)
@ -434,6 +546,12 @@ fn twice(n: i64) -> i64 = n * 2
(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 "a line of code already at a valid column stays there"
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 1) 2)
(test-flan-fln--is "and a second TAB steps it out"
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 2) 0)
(test-flan-fln--is "a line of code at no valid column goes to the deepest"
(test-flan-fln--tabs "fn f() -> ()\n if a\n b\n| let b = 2" 1) 4)
(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"
@ -629,6 +747,30 @@ fn twice(n: i64) -> i64 = n * 2
(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 ((deleted
(lambda (keys needle)
(let ((b (generate-new-buffer "delete.fln")))
(switch-to-buffer b)
(insert "fn f(x: i64) -> i64\n if x > 0\n a\n else\n 3\n x\n\nfn g() -> i32 = 1\n")
(flan-fln-mode)
(evil-initialize-state)
(evil-normal-state)
(goto-char (point-min))
(search-forward needle)
(goto-char (match-beginning 0))
(execute-kbd-macro keys)
(prog1 (buffer-string)
(set-buffer-modified-p nil)
(kill-buffer b))))))
(dolist (c '(("dak" "else"
"fn f(x: i64) -> i64\n if x > 0\n a\n x\n\nfn g() -> i32 = 1\n")
("das" "else"
"fn f(x: i64) -> i64\n x\n\nfn g() -> i32 = 1\n")
("dii" "if x"
"fn f(x: i64) -> i64\n if x > 0\n else\n 3\n x\n\nfn g() -> i32 = 1\n")
("dad" "else" "fn g() -> i32 = 1\n")))
(test-flan-fln--is (format "under Evil, %s leaves no blank line" (car c))
(funcall deleted (car c) (nth 1 c)) (nth 2 c))))
(let ((b (generate-new-buffer "keys.fln")))
(switch-to-buffer b)
(insert "fn f() -> i32 = 1\n")