src/TeXmacs/progs/dynamic/session-edit.scm

   1
   2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   3 ;;
   4 ;; MODULE      : session-edit.scm
   5 ;; DESCRIPTION : editing routines for sessions
   6 ;; COPYRIGHT   : (C) 2001--2009  Joris van der Hoeven
   7 ;;
   8 ;; This software falls under the GNU general public license version 3 or later.
   9 ;; It comes WITHOUT ANY WARRANTY WHATSOEVER. For details, see the file LICENSE
  10 ;; in the root directory or <http://www.gnu.org/licenses/gpl-3.0.html>.
  11 ;;
  12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13
  14 (texmacs-module (dynamic session-edit)
  15   (:use (utils library tree)
  16         (utils library cursor)
  17         (utils plugins plugin-cmd)
  18         (dynamic session-drd)
  19         (dynamic fold-edit)))
  20
  21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22 ;; Switches
  23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24
  25 (define session-math-input #f)
  26
  27 (tm-define (session-math-input?)
  28   session-math-input)
  29
  30 (tm-define (toggle-session-math-input)
  31   (:synopsis "Toggle mathematical input in sessions.")
  32   (:check-mark "v" session-math-input?)
  33   (set! session-math-input (not session-math-input))
  34   (with-innermost t field-context?
  35     (field-update-math t)))
  36
  37 (define session-multiline-input #f)
  38
  39 (tm-define (session-multiline-input?)
  40   session-multiline-input)
  41
  42 (tm-define (toggle-session-multiline-input)
  43   (:synopsis "Toggle multi-line input in sessions.")
  44   (:check-mark "v" session-multiline-input?)
  45   (set! session-multiline-input (not session-multiline-input)))
  46
  47 (define session-scheme-trees #t)
  48
  49 (tm-define (session-scheme-trees?)
  50   session-scheme-trees)
  51
  52 (tm-define (toggle-session-scheme-trees)
  53   (:synopsis "Toggle pretty tree output in scheme sessions.")
  54   (:check-mark "v" session-scheme-trees?)
  55   (set! session-scheme-trees (not session-scheme-trees)))
  56
  57 (define session-scheme-math #f)
  58
  59 (tm-define (session-scheme-math?)
  60   session-scheme-math)
  61
  62 (tm-define (toggle-session-scheme-math)
  63   (:synopsis "Toggle pretty tree output in scheme sessions.")
  64   (:check-mark "v" session-scheme-math?)
  65   (set! session-scheme-math (not session-scheme-math)))
  66
  67 (define session-output-timings #f)
  68
  69 (tm-define (session-output-timings?)
  70   session-output-timings)
  71
  72 (tm-define (toggle-session-output-timings)
  73   (:synopsis "Toggle output of evaluation timings.")
  74   (:check-mark "v" session-output-timings?)
  75   (set! session-output-timings (not session-output-timings)))
  76
  77 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78 ;; Low-level evaluation management
  79 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  80
  81 (define (session-encode in out next opts)
  82   (list (list session-do session-notify session-next session-cancel)
  83         (if (tm? in) (tm->stree in) in)
  84         (tree->tree-pointer out)
  85         (tree->tree-pointer next)
  86         opts))
  87
  88 (define (session-decode l)
  89   (list (second l)
  90         (tree-pointer->tree (third l))
  91         (tree-pointer->tree (fourth l))
  92         (fifth l)))
  93
  94 (define (session-detach l)
  95   (tree-pointer-detach (third l))
  96   (tree-pointer-detach (fourth l)))
  97
  98 (define (session-do lan ses)
  99   (with l (pending-ref lan ses)
 100     (with (in out next opts) (session-decode (car l))
 101       ;;(display* "Session do " lan ", " ses ", " in "\n")
 102       (if (tree-empty? in)
 103           (plugin-next lan ses)
 104           (begin
 105             (plugin-write lan ses in)
 106             (tree-set out :up 0 (plugin-prompt lan ses)))))))
 107
 108 (define (session-next lan ses)
 109   ;;(display* "Session next " lan ", " ses "\n")
 110   (with l (pending-ref lan ses)
 111     (with (in out next opts) (session-decode (car l))
 112       (when (and (tm-func? out 'document)
 113                  (tm-func? (tree-ref out :last) 'script-busy))
 114         (let* ((dt (plugin-timing lan ses))
 115                (ts (if (< dt 1000)
 116                        (string-append (number->string dt) " msec")
 117                        (string-append (number->string (/ dt 1000.0)) " sec"))))
 118           (if (and (in? :timings opts) (>= dt 1))
 119               (tree-set (tree-ref out :last) `(timing ,ts))
 120               (tree-remove! out (- (tree-arity out) 1) 1))))
 121       (when (tree-empty? out)
 122         (tree-set! out '(document)))
 123       (session-detach (car l)))))
 124
 125 (define (var-tree-children t)
 126   (with r (tree-children t)
 127     (if (and (nnull? r) (tree-empty? (cAr r))) (cDr r) r)))
 128
 129 (define (session-output t u)
 130   (when (tm-func? t 'document)
 131     (with i (tree-arity t)
 132       (if (and (> i 0) (tm-func? (tree-ref t (- i 1)) 'script-busy))
 133           (set! i (- i 1)))
 134       (if (and (> i 0) (tm-func? (tree-ref t (- i 1)) 'errput))
 135           (set! i (- i 1)))
 136       (if (tm-func? u 'document)
 137           (tree-insert! t i (var-tree-children u))))))
 138
 139 (define (session-errput t u)
 140   (when (tm-func? t 'document)
 141     (with i (tree-arity t)
 142       (if (and (> i 0) (tm-func? (tree-ref t (- i 1)) 'script-busy))
 143           (set! i (- i 1)))
 144       (if (and (> i 0) (tm-func? (tree-ref t (- i 1)) 'errput))
 145           (set! i (- i 1))
 146           (tree-insert! t i '((errput (document)))))
 147       (session-output (tree-ref t i 0) u))))
 148
 149 (define (session-notify lan ses ch t)
 150   ;;(display* "Session notify " lan ", " ses ", " ch ", " t "\n")
 151   (with l (pending-ref lan ses)
 152     (with (in out next opts) (session-decode (car l))
 153       (cond ((== ch "output")
 154              (session-output out t))
 155             ((== ch "error")
 156              (session-errput out t))
 157             ((== ch "prompt")
 158              (if (and (== (length l) 1) (tree-empty? (tree-ref next 1)))
 159                  (tree-set! next 0 (tree-copy t))))
 160             ((and (== ch "input") (null? (cdr l)))
 161              (tree-set! next 1 t))))))
 162
 163 (define (session-cancel lan ses dead?)
 164   ;;(display* "Session cancel " lan ", " ses ", " dead? "\n")
 165   (with l (pending-ref lan ses)
 166     (with (in out next opts) (session-decode (car l))
 167       (when (and (tm-func? out 'document)
 168                  (tm-func? (tree-ref out :last) 'script-busy))
 169         (tree-assign (tree-ref out :last)
 170                      (if dead? '(script-dead) '(script-interrupted))))
 171       (session-detach (car l)))))
 172
 173 (tm-define (session-feed lan ses in out next opts)
 174   (set! in (plugin-preprocess lan ses in opts))
 175   (tree-assign! out '(document (script-busy)))
 176   (with x (session-encode in out next opts)
 177     (apply plugin-feed `(,lan ,ses ,@(car x) ,(cdr x)))))
 178
 179 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 180 ;; Session contexts
 181 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 182
 183 (tm-define (session-document-context? t)
 184   (and (tm-func? t 'document)
 185        (tm-func? (tree-ref t :up) 'session)))
 186
 187 (tm-define (subsession-document-context? t)
 188   (or (and (tm-func? t 'document)
 189            (tm-func? (tree-ref t :up) 'session))
 190       (and (tm-func? t 'document)
 191            (tm-func? (tree-ref t :up) 'unfolded)
 192            (== (tree-index t) 1))))
 193
 194 (tm-define field-tags '(unfolded-io folded-io unfolded-io-math folded-io-math))
 195
 196 (tm-define (field-context? t)
 197   (and (tree-in? t field-tags)
 198        (tm-func? (tree-ref t :up) 'document)))
 199
 200 (tm-define (field-folded-context? t)
 201   (and (tree-in? t '(folded-io folded-io-math))
 202        (tm-func? (tree-ref t :up) 'document)))
 203
 204 (tm-define (field-unfolded-context? t)
 205   (and (tree-in? t '(unfolded-io unfolded-io-math))
 206        (tm-func? (tree-ref t :up) 'document)))
 207
 208 (tm-define (field-prog-context? t)
 209   (and (tree-in? t '(folded-io unfolded-io))
 210        (tm-func? (tree-ref t :up) 'document)))
 211
 212 (tm-define (field-math-context? t)
 213   (and (tree-in? t '(folded-io-math unfolded-io-math))
 214        (tm-func? (tree-ref t :up) 'document)))
 215
 216 (tm-define (input-context? t)
 217   (and (field-context? t)
 218        (== (tree-down-index t) 1)))
 219
 220 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 221 ;; Subroutines
 222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 223
 224 (define (field-next t forward?)
 225   (and-with u (tree-ref t (if forward? :next :previous))
 226     (if (field-context? u) u (field-next u forward?))))
 227
 228 (define (field-extreme t last?)
 229   (with u (tree-ref t :up (if last? :last :first))
 230     (if (field-context? u) u
 231         (field-next u (not last?)))))
 232
 233 (define (field-update-math t)
 234   (if (session-math-input?)
 235       (when (field-prog-context? t)
 236         (tree-assign-node! t 'folded-io-math)
 237         (tree-assign (tree-ref t 1) '(document "")))
 238       (when (field-math-context? t)
 239         (tree-assign-node! t 'folded-io)
 240         (tree-assign (tree-ref t 1) '(document "")))))
 241
 242 (define (field-create t p forward?)
 243   (let* ((d (tree-ref t :up))
 244          (i (+ (tree-index t) (if forward? 1 0)))
 245          (l (if (session-math-input?) 'folded-io-math 'folded-io))
 246          (b `(,l ,p (document "") (document))))
 247     (tree-insert d i (list b))
 248     (tree-ref d i)))
 249
 250 (define (session-forall-sub fun t)
 251   (for (u (tree-children t))
 252     (when (field-context? u)
 253       (fun u))
 254     (when (and (tm-func? u 'unfolded)
 255                (tm-func? (tree-ref u 1) 'document))
 256       (session-forall-sub fun (tree-ref u 1)))))
 257
 258 (define (session-forall fun)
 259   (with-innermost t subsession-document-context?
 260     (session-forall-sub fun t)))
 261
 262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 263 ;; Processing input
 264 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 265
 266 (tm-define (make-session lan ses)
 267   (let* ((ban `(output (document "")))
 268          (l (if (session-math-input?) 'folded-io-math 'folded-io))
 269          (p (plugin-prompt lan ses))
 270          (in `(,l (document ,p) (document "") (document)))
 271          (s `(session ,lan ,ses (document ,ban ,in))))
 272     (insert-go-to s '(2 1 1 0 0))
 273     (with-innermost t input-context?
 274       (with u (tree-ref t :previous 0)
 275         (if (url-exists? (url "$TEXMACS_STYLE_PATH" (string-append lan ".ts")))
 276             (init-add-package lan))
 277         (session-feed lan ses :start u t '())))))
 278
 279 (define (field-process-input t)
 280   (if (tm-func? t 'folded-io)
 281       (tree-assign-node! t 'unfolded-io))
 282   (if (tm-func? t 'folded-io-math)
 283       (tree-assign-node! t 'unfolded-io-math))
 284   (let* ((lan (get-env "prog-language"))
 285          (ses (get-env "prog-session"))
 286          (p (plugin-prompt lan ses))
 287          (in (tree->stree (tree-ref t 1)))
 288          (out (tree-ref t 2))
 289          (opts '()))
 290     (when (session-output-timings?) (set! opts (cons :timings opts)))
 291     (when (field-math-context? t) (set! opts (cons :math-input opts)))
 292     (with u (or (field-next t #t) (field-create t p #t))
 293       (session-feed lan ses in out u opts)
 294       (tree-go-to u 1 :end))))
 295
 296 (tm-define (kbd-return)
 297   (:context input-context?)
 298   (if (session-multiline-input?)
 299       (insert-return)
 300       (session-evaluate)))
 301
 302 (tm-define (kbd-shift-return)
 303   (:context input-context?)
 304   (if (session-multiline-input?)
 305       (session-evaluate)
 306       (insert-return)))
 307
 308 (tm-define (session-evaluate)
 309   (with-innermost t input-context?
 310     (field-process-input t)))
 311
 312 (tm-define (session-evaluate-all)
 313   (session-forall
 314     (lambda (t)
 315       (when (not (tree-empty? (tree-ref t 1)))
 316         (field-process-input t)))))
 317
 318 (tm-define (session-evaluate-above)
 319   (with-innermost me input-context?
 320     (session-forall
 321       (lambda (t)
 322         (when (not (tree-empty? (tree-ref t 1)))
 323           (when (path-inf? (tree->path t) (tree->path me))
 324             (field-process-input t)))))))
 325
 326 (tm-define (session-evaluate-below)
 327   (with-innermost me input-context?
 328     (session-forall
 329       (lambda (t)
 330         (when (not (tree-empty? (tree-ref t 1)))
 331           (when (path-inf-eq? (tree->path me) (tree->path t))
 332             (field-process-input t)))))))
 333
 334 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 335 ;; Keyboard editing
 336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 337
 338 (tm-define (kbd-left)
 339   (:context field-context?)
 340   (go-to-remain-inside go-left field-context? 1))
 341
 342 (tm-define (kbd-right)
 343   (:context field-context?)
 344   (go-to-remain-inside go-right field-context? 1))
 345
 346 (define (field-go-to-previous)
 347   (with-innermost t field-context?
 348     (with u (tree-ref t :previous)
 349       (if (and u (field-context? u))
 350           (tree-go-to u 1 :end)
 351           (go-to-previous-tag-same-argument field-tags)))))
 352
 353 (define (field-go-to-next)
 354   (with-innermost t field-context?
 355     (with u (tree-ref t :next)
 356       (if (and u (field-context? u))
 357           (tree-go-to u 1 :start)
 358           (go-to-next-tag-same-argument field-tags))
 359       (go-end-line))))
 360
 361 (define (field-go-up)
 362   (with p (cursor-path)
 363     (go-to-remain-inside go-up field-context? 1)
 364     (when (== (cursor-path) p)
 365       (field-go-to-previous))))
 366
 367 (define (field-go-down)
 368   (with p (cursor-path)
 369     (go-to-remain-inside go-down field-context? 1)
 370     (when (== (cursor-path) p)
 371       (field-go-to-next))))
 372
 373 (tm-define (kbd-up)
 374   (:context field-context?)
 375   (field-go-up))
 376
 377 (tm-define (kbd-down)
 378   (:context field-context?)
 379   (field-go-down))
 380
 381 (tm-define (kbd-page-up)
 382   (:context input-context?)
 383   (for (n 0 5)
 384     (field-go-to-previous)))
 385
 386 (tm-define (kbd-page-down)
 387   (:context input-context?)
 388   (for (n 0 5)
 389     (field-go-to-next)))
 390
 391 (tm-define (kbd-remove forward?)
 392   (:context input-context?)
 393   (with-innermost t input-context?
 394     (cond ((and (tree-cursor-at? t 1 :start) (not forward?)) (noop))
 395           ((and (tree-cursor-at? t 1 :end) forward?) (noop))
 396           (else (remove-text forward?)))))
 397
 398 (tm-define (kbd-tab)
 399   (:context input-context?)
 400   (:require (plugin-supports-completions? (get-env "prog-language")))
 401   (with-innermost t input-context?
 402     (session-complete-try? t)))
 403
 404 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 405 ;; Structured keyboard movements
 406 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 407
 408 (define (field-input-simple-context? t)
 409   (and (nleaf? t)
 410        (simple-context? (tree-down t))
 411        (input-context? t)))
 412
 413 (tm-define (document-context? t)
 414   (:case document)
 415   (:require (input-context? (tree-ref t :up)))
 416   #f)
 417
 418 (tm-define (traverse-left)
 419   (:context input-context?)
 420   (go-to-remain-inside go-to-previous-word field-context? 1))
 421
 422 (tm-define (traverse-right)
 423   (:context input-context?)
 424   (go-to-remain-inside go-to-next-word field-context? 1))
 425
 426 (tm-define (traverse-up)
 427   (:context input-context?)
 428   (field-go-up))
 429
 430 (tm-define (traverse-down)
 431   (:context input-context?)
 432   (field-go-down))
 433
 434 (tm-define (traverse-previous)
 435   (:context input-context?)
 436   (field-go-up))
 437
 438 (tm-define (traverse-next)
 439   (:context input-context?)
 440   (field-go-down))
 441
 442 (tm-define (structured-left)
 443   (:context field-input-simple-context?)
 444   (noop))
 445
 446 (tm-define (structured-right)
 447   (:context field-input-simple-context?)
 448   (noop))
 449
 450 (tm-define (structured-up)
 451   (:context field-input-simple-context?)
 452   (go-to-remain-inside field-go-up 'session))
 453
 454 (tm-define (structured-down)
 455   (:context field-input-simple-context?)
 456   (go-to-remain-inside field-go-down 'session))
 457
 458 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 459 ;; Fold and unfold
 460 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 461
 462 (tm-define (fold)
 463   (:context field-unfolded-context?)
 464   (with-innermost t field-unfolded-context?
 465     (toggle-toggle t)
 466     (tree-go-to t 1 :end)))
 467
 468 (tm-define (unfold)
 469   (:context field-folded-context?)
 470   (with-innermost t field-folded-context?
 471     (toggle-toggle t)
 472     (tree-go-to t 1 :end)))
 473
 474 (tm-define (field-fold t)
 475   (when (field-unfolded-context? t)
 476     (toggle-toggle t)))
 477
 478 (tm-define (field-unfold t)
 479   (when (field-folded-context? t)
 480     (toggle-toggle t)))
 481
 482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 483 ;; Field management
 484 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 485
 486 (tm-define (field-insert forwards?)
 487   (with-innermost t input-context?
 488     (let* ((lan (get-env "prog-language"))
 489            (ses (get-env "prog-session"))
 490            (p (plugin-prompt lan ses)))
 491       (tree-go-to (field-create t p forwards?) 1 :end))))
 492
 493 (tm-define (field-insert-text forward?)
 494   (with-innermost t input-context?
 495     (let* ((d (tree-ref t :up))
 496            (i (+ (tree-index t) (if forward? 1 0)))
 497            (b `(textput (document ""))))
 498       (tree-insert d i (list b))
 499       (tree-go-to d i 0 :start))))
 500
 501 (tm-define (field-remove-banner)
 502   (with-innermost t session-document-context?
 503     (when (tm-func? (tree-ref t 0) 'output)
 504       (tree-remove! t 0 1))))
 505
 506 (tm-define (field-remove-extreme last?)
 507   (with-innermost t input-context?
 508     (with u (field-extreme t last?)
 509       (with v (field-next t (not last?))
 510         (if (and (== u t) v)
 511             (tree-go-to v 1 :end))
 512         (if (or (!= u t) v)
 513             (tree-remove (tree-ref u :up) (tree-index u) 1))))))
 514
 515 (tm-define (field-remove forwards?)
 516   (with-innermost t input-context?
 517     (if forwards?
 518         (with u (field-next t #t)
 519           (if u (begin
 520                   (tree-remove (tree-ref t :up) (tree-index t) 1)
 521                   (tree-go-to u 1 :start))
 522               (field-remove-extreme #t)))
 523         (with u (field-next t #f)
 524           (if u (tree-remove (tree-ref u :up) (tree-index u) 1)
 525               (field-remove-banner))))))
 526
 527 (tm-define (structured-insert forwards?)
 528   (:context input-context?)
 529   (if forwards? (field-insert-fold)))
 530
 531 (tm-define (structured-insert-up)
 532   (:context input-context?)
 533   (field-insert #f))
 534
 535 (tm-define (structured-insert-down)
 536   (:context input-context?)
 537   (field-insert #t))
 538
 539 (tm-define (structured-remove forwards?)
 540   (:context input-context?)
 541   (field-remove forwards?))
 542
 543 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 544 ;; Session management
 545 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 546
 547 (tm-define (session-clear-all)
 548   (session-forall (lambda (t) (tree-set! t 2 '(document)))))
 549
 550 (tm-define (session-fold-all)
 551   (session-forall field-fold))
 552
 553 (tm-define (session-unfold-all)
 554   (session-forall field-unfold))
 555
 556 (tm-define (field-insert-fold)
 557   (with-innermost t input-context?
 558     (tree-set! t `(unfolded (document "") (document ,t)))
 559     (tree-go-to t 0 :end)))
 560
 561 (tm-define (session-split)
 562   (:context session-document-context?)
 563   (with-innermost t session-document-context?
 564     (let* ((u (tree-ref t :up)) ;; session
 565            (v (tree-ref u :up)) ;; document
 566            (i (+ (tree-down-index t) 1))
 567            (j (tree-index u))
 568            (lan (tree-ref u 0))
 569            (ses (tree-ref u 1)))
 570       (when (< i (tree-arity t))
 571         (tree-remove! u 0 2)
 572         (tree-split! u 0 i)
 573         (tree-split! v j 1)
 574         (tree-insert (tree-ref v j) 0 `(,lan ,ses))
 575         (tree-insert (tree-ref v (+ j 1)) 0 `(,lan ,ses))
 576         (tree-insert v (+ j 1) '((document "")))
 577         (tree-go-to v (+ j 1) :end)))))