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

line editor now waits for complete sexps

Browse source
This commit is contained in:
Alex Shinn 2011-03-28 23:04:45 +09:00
parent 3b14c5ae7b
commit 6cd9654701
3 changed files with 51 additions and 32 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
lib/chibi/repl.scm
View file

@ -1,17 +1,8 @@
;;;; repl.scm - friendlier repl with line editing and signal handling
;;
;; Copyright (c) 2010 Alex Shinn. All rights reserved.
;; Copyright (c) 2011 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
(define-syntax handle-exceptions
(syntax-rules ()
((handle-exceptions exn handle-expr expr)
(call-with-current-continuation
(lambda (return)
(with-exception-handler
(lambda (exn) (return handle-expr))
(lambda () expr)))))))
(define (with-signal-handler sig handler thunk)
(let ((old-handler #f))
(dynamic-wind
@ -19,32 +10,39 @@
thunk
(lambda () (set-signal-action! sig old-handler)))))
(define (buffer-complete-sexp? buf)
(guard (exn (else #f))
(call-with-input-string (buffer->string buf) read)
#t))
(define (run-repl module env . o)
(let ((history (make-history)))
(let lp ((module module) (env env))
(let ((line
(edit-line
(string-append (if module (symbol->string module) "") "> ")
'history: history)))
'history: history
'complete?: buffer-complete-sexp?)))
(cond
((or (not line) (eof-object? line)))
((equal? line "") (lp module env))
(else
(history-commit! history line)
(handle-exceptions
exn
(print-exception exn (current-error-port))
(guard
(exn
(else (print-exception exn (current-error-port))))
(let* ((expr (call-with-input-string line read/ss))
(thread (make-thread
(lambda ()
(handle-exceptions
exn
(print-exception exn (current-error-port))
(let ((res (eval expr env)))
(cond
((not (eq? res (if #f #f)))
(write/ss res)
(newline)))))))))
(thread
(make-thread
(lambda ()
(guard
(exn
(else (print-exception exn (current-error-port))))
(let ((res (eval expr env)))
(cond
((not (eq? res (if #f #f)))
(write/ss res)
(newline)))))))))
(with-signal-handler
signal/interrupt
(lambda (n)

3
lib/chibi/term/edit-line.module
View file

@ -1,5 +1,6 @@
(define-module (chibi term edit-line)
(export edit-line edit-line-repl make-history history-insert! history-commit!)
(export edit-line edit-line-repl make-history history-insert! history-commit!
buffer->string)
(import-immutable (scheme) (chibi stty) (srfi 9))
(include "edit-line.scm"))

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

@ -1,6 +1,6 @@
;;;; edit-line.scm - pure scheme line editing tool
;;;; edit-line.scm - pure scheme line editor
;;
;; Copyright (c) 2010 Alex Shinn. All rights reserved.
;; Copyright (c) 2011 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -104,6 +104,13 @@
((< i start))
(string-set! dst j (string-ref src i)))))
(define (string-index ch x)
(let ((len (string-length x)))
(let lp ((i 0))
(cond ((>= i len) #f)
((eqv? ch (string-ref x i)))
(else (lp (+ i 1)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; buffers
@ -120,7 +127,8 @@
(width buffer-width buffer-width-set!)
(string buffer-string buffer-string-set!)
(kill-ring buffer-kill-ring buffer-kill-ring-set!)
(history buffer-history buffer-history-set!))
(history buffer-history buffer-history-set!)
(complete? buffer-complete? buffer-complete?-set!))
(define default-buffer-size 256)
(define default-buffer-width 80)
@ -159,6 +167,7 @@
(define (buffer-update-position! buf)
(let ((pos (buffer-pos buf))
(gap (buffer-gap buf))
(str (buffer-string buf))
(end (string-length (buffer-string buf)))
(width (buffer-width buf)))
(let lp ((i 0) (row 0) (col 0)) ;; update row/col
@ -169,6 +178,8 @@
((>= i end)
(buffer-max-row-set!
buf (if (and (zero? col) (> row 0)) (- row 1) row)))
((eqv? #\newline (string-ref str i))
(lp (+ i 1) (+ row 1) 0))
((= (+ col 1) width)
(lp (+ i 1) (+ row 1) 0))
(else
@ -234,7 +245,10 @@
(cond
((buffer-refresh? buf))
((and (= (buffer-gap buf) (string-length (buffer-string buf)))
(< (+ (buffer-col buf) len) (buffer-width buf)))
(< (+ (buffer-col buf) len) (buffer-width buf))
(if (char? x)
(not (eqv? x #\newline))
(not (string-index #\newline x))))
;; fast path - append to end of buffer w/o wrapping to next line
(display x out)
(buffer-col-set! buf (+ (buffer-col buf) len)))
@ -344,9 +358,13 @@
(buffer-insert! buf out ch))
(define (command/enter ch buf out return)
(command/end-of-line ch buf out return)
(newline out)
(return))
(cond
(((buffer-complete? buf) buf)
(command/end-of-line ch buf out return)
(newline out)
(return))
(else
(command/self-insert ch buf out return))))
(define (command/beep ch buf out return)
(write-char (integer->char 7) out))
@ -442,6 +460,7 @@
(define (make-line-editor . args)
(let* ((prompt (get-key args 'prompt: "> "))
(history (get-key args 'history:))
(complete? (get-key args 'complete?: (lambda (buf) #t)))
(terminal-width (get-key args 'terminal-width:))
(keymap (get-key args 'keymap: standard-keymap)))
(lambda (in out)
@ -454,6 +473,7 @@
(buffer-insert! buf out prompt)
(buffer-min-set! buf (string-length prompt))
(buffer-history-set! buf history)
(buffer-complete?-set! buf complete?)
(buffer-refresh buf out)
(flush-output out)
((if (get-key args 'no-stty?:) (lambda (out f) (f)) with-raw-io)