From 6cd96547014fde20ba15d3f20b5e80bad573c775 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 28 Mar 2011 23:04:45 +0900 Subject: [PATCH] line editor now waits for complete sexps --- lib/chibi/repl.scm | 46 ++++++++++++++++----------------- lib/chibi/term/edit-line.module | 3 ++- lib/chibi/term/edit-line.scm | 34 +++++++++++++++++++----- 3 files changed, 51 insertions(+), 32 deletions(-) diff --git a/lib/chibi/repl.scm b/lib/chibi/repl.scm index d9ae63e9..5c297ee2 100644 --- a/lib/chibi/repl.scm +++ b/lib/chibi/repl.scm @@ -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) diff --git a/lib/chibi/term/edit-line.module b/lib/chibi/term/edit-line.module index 279f8c75..139aff06 100644 --- a/lib/chibi/term/edit-line.module +++ b/lib/chibi/term/edit-line.module @@ -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")) diff --git a/lib/chibi/term/edit-line.scm b/lib/chibi/term/edit-line.scm index 1c985919..15e5b169 100644 --- a/lib/chibi/term/edit-line.scm +++ b/lib/chibi/term/edit-line.scm @@ -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)