Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Tentative change to enable restarting at a fresh line in the REPL.

Browse source
This commit is contained in:
Alex Shinn 2014-07-23 23:01:41 +09:00
parent 455c8debce
commit 9be980a100
2 changed files with 37 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lib/chibi/repl.scm
View file

@ -400,7 +400,8 @@
'history: (repl-history rp) 'history: (repl-history rp)
'complete?: buffer-complete-sexp? 'complete?: buffer-complete-sexp?
'completion: (make-sexp-buffer-completer) 'completion: (make-sexp-buffer-completer)
'catch-control-c?: #t))))) 'catch-control-c?: #t
'fresh-line: " \x1B;[33m\\\x1B;[0m")))))
(define repl-commands (define repl-commands
`((import . ,repl/import) `((import . ,repl/import)

36
lib/chibi/term/edit-line.scm
View file

@ -10,7 +10,8 @@
(write-char (integer->char 27) out) (write-char (integer->char 27) out)
(write-char #\[ out) (write-char #\[ out)
(if arg (display arg out)) (if arg (display arg out))
(write-char ch out)) (write-char ch out)
(flush-output out))
;; we use zero-based columns ;; we use zero-based columns
(define (terminal-goto-col out n) (terminal-escape out #\G (+ n 1))) (define (terminal-goto-col out n) (terminal-escape out #\G (+ n 1)))
@ -19,6 +20,33 @@
(define (terminal-clear-below out) (terminal-escape out #\J #f)) (define (terminal-clear-below out) (terminal-escape out #\J #f))
(define (terminal-clear-right out) (terminal-escape out #\K #f)) (define (terminal-clear-right out) (terminal-escape out #\K #f))
(define (read-numeric-sequence in)
(let lp ((c (peek-char in)) (acc '()))
(case c
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
(read-char in) ;; skip peeked char
(lp (peek-char in) (cons c acc)))
(else
(string->number (apply string (reverse acc)))))))
(define (terminal-current-position in out)
(with-stty '(not icanon isig echo)
(lambda ()
(terminal-escape out #\n 6)
(read-char in)
(and (eqv? #\[ (read-char in))
(let ((y (read-numeric-sequence in)))
(and y
(eqv? #\; (read-char in))
(let ((x (read-numeric-sequence in)))
(and x
(eqv? #\R (read-char in))
(list (- y 1) (- x 1))))))))))
(define (at-first-column? in out)
(let ((pos (terminal-current-position in out)))
(and pos (zero? (cadr pos)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; history ;; history
@ -755,6 +783,7 @@
(completion (get-key args 'completion: #f)) (completion (get-key args 'completion: #f))
(terminal-width (get-key args 'terminal-width:)) (terminal-width (get-key args 'terminal-width:))
(single-line? (get-key args 'single-line?: #f)) (single-line? (get-key args 'single-line?: #f))
(fresh-line (get-key args 'fresh-line: #f))
(no-stty? (get-key args 'no-stty?: #f)) (no-stty? (get-key args 'no-stty?: #f))
(keymap0 (get-key args 'keymap: (keymap0 (get-key args 'keymap:
(if (get-key args 'catch-control-c?: #f) (if (get-key args 'catch-control-c?: #f)
@ -769,6 +798,11 @@
(prompt (if (procedure? prompter) (prompter) prompter)) (prompt (if (procedure? prompter) (prompter) prompter))
(done? #f) (done? #f)
(return (lambda o (set! done? (if (pair? o) (car o) #t))))) (return (lambda o (set! done? (if (pair? o) (car o) #t)))))
;; Maybe start at a fresh line.
(cond
((and fresh-line (not (at-first-column? in out)))
(if (string? fresh-line) (display fresh-line out))
(newline out)))
;; Clear buffer and reset prompt. ;; Clear buffer and reset prompt.
(buffer-refresh?-set! buf #t) (buffer-refresh?-set! buf #t)
(buffer-min-set! buf 0) (buffer-min-set! buf 0)