;;; -*-Scheme-*-
;;;
-;;; $Id: intmod.scm,v 1.69 1993/10/16 07:34:12 cph Exp $
+;;; $Id: intmod.scm,v 1.70 1993/10/16 10:11:21 cph Exp $
;;;
;;; Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
;;;
(set! repl-buffers '())
unspecific)
-(define (wait-for-input port mode ready?)
- (let ((level (nearest-cmdl/level)))
- (signal-thread-event editor-thread
- (lambda ()
- (maybe-switch-modes! port mode)
- (let ((buffer (port/buffer port)))
- (define-variable-local-value! buffer
- (ref-variable-object mode-line-process)
- (list ": "
- 'RUN-LIGHT
- (if (= level 1)
- ""
- (string-append " [level: " (number->string level) "]"))))
- (set-run-light! buffer #f)))))
+(define (wait-for-input port mode ready? level)
+ (signal-thread-event editor-thread
+ (lambda ()
+ (maybe-switch-modes! port mode)
+ (let ((buffer (port/buffer port)))
+ (define-variable-local-value! buffer
+ (ref-variable-object mode-line-process)
+ (list ": "
+ 'RUN-LIGHT
+ (if (= level 1)
+ ""
+ (string-append " [level: " (number->string level) "]"))))
+ (set-run-light! buffer #f))))
;; This doesn't do any output, but prods the editor to notice that
;; the modeline has changed and a redisplay is needed.
(inferior-thread-output! (port/output-registration port))
(write-string
";Type D to debug error, Q to quit back to REP loop: "
port)
- (let ((char (read-command-char port)))
+ (let ((char (read-command-char port (cmdl/level rep))))
(write-char char port)
(cond ((char-ci=? char #\d)
(fresh-line port)
(define (operation/read port parser-table)
parser-table
(standard-prompt-spacing port)
- (read-expression port))
+ (read-expression port (nearest-cmdl/level)))
(define read-expression
(let ((empty (cons '() '())))
- (lambda (port)
+ (lambda (port level)
(let ((queue (port/expression-queue port))
(mode (ref-mode-object inferior-repl))
(ready?
(let ((element (dequeue! queue empty)))
(if (eq? element empty)
(begin
- (wait-for-input port mode ready?)
+ (wait-for-input port mode ready? level)
(loop))
(begin
(set-port/current-queue-element! port element)
(remove-select-buffer-hook buffer hook))))
(add-select-buffer-hook buffer hook))))
\f
-(define (operation/prompt-for-command-expression port prompt)
+(define (operation/prompt-for-command-expression port prompt level)
(parse-command-prompt port prompt)
- (read-expression port))
+ (read-expression port level))
-(define (operation/prompt-for-command-char port prompt)
+(define (operation/prompt-for-command-char port prompt level)
(parse-command-prompt port prompt)
- (read-command-char port))
+ (read-command-char port level))
-(define (read-command-char port)
+(define (read-command-char port level)
(set-port/command-char! port false)
- (wait-for-input port (ref-mode-object inferior-cmdl) port/command-char)
+ (wait-for-input port (ref-mode-object inferior-cmdl) port/command-char level)
(port/command-char port))
(define (parse-command-prompt port prompt)
(standard-prompt-spacing port)
- (let ((prompt
- (string-trim-right
- (let ((prefix
- (string-append (number->string (nearest-cmdl/level)) " ")))
- (if (and (string-prefix? prefix prompt)
- (not (string=? prefix prompt)))
- (string-tail prompt (string-length prefix))
- prompt)))))
+ (let ((prompt (string-trim prompt)))
(if (not (and suppress-standard-prompts?
(or (string=? prompt user-initial-prompt)
(member prompt standard-prompts))))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dbgcmd.scm,v 14.13 1991/11/26 07:05:04 cph Exp $
+$Id: dbgcmd.scm,v 14.14 1993/10/16 10:10:56 cph Exp $
-Copyright (c) 1988-91 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(write-condition-report condition port)
(continuation unspecific))
(lambda ()
- (let ((command-set (vector-ref (cmdl/state cmdl) 0))
- (prompt
- (string-append (number->string (cmdl/level cmdl))
- " "
- (vector-ref (cmdl/state cmdl) 1)))
- (state (vector-ref (cmdl/state cmdl) 2)))
- (let loop ()
- (let ((entry
- (assv (char-upcase (prompt-for-command-char prompt port))
- (cdr command-set))))
- (if entry
- ((cadr entry) state port)
- (begin
- (beep port)
- (newline port)
- (write-string "Unknown command character" port)
- (loop)))))))))))
+ (let ((state (cmdl/state cmdl)))
+ (let ((command-set (vector-ref state 0))
+ (prompt (vector-ref state 1))
+ (state (vector-ref state 2)))
+ (let loop ()
+ (let ((entry
+ (assv (char-upcase
+ (prompt-for-command-char prompt port))
+ (cdr command-set))))
+ (if entry
+ ((cadr entry) state port)
+ (begin
+ (beep port)
+ (newline port)
+ (write-string "Unknown command character" port)
+ (loop))))))))))))
(cmdl-message/null))
(define ((standard-help-command command-set) state port)
#| -*-Scheme-*-
-$Id: emacs.scm,v 14.16 1993/10/16 07:32:43 cph Exp $
+$Id: emacs.scm,v 14.17 1993/10/16 10:11:04 cph Exp $
Copyright (c) 1988-93 Massachusetts Institute of Technology
\f
;;;; Prompting
-(define (emacs/prompt-for-command-expression port prompt)
- (transmit-modeline-string port prompt)
+(define (emacs/prompt-for-command-expression port prompt level)
+ (transmit-modeline-string port prompt level)
(transmit-signal port #\R)
(read port))
-(define (emacs/prompt-for-command-char port prompt)
- (transmit-modeline-string port prompt)
+(define (emacs/prompt-for-command-char port prompt level)
+ (transmit-modeline-string port prompt level)
(transmit-signal-with-argument port #\D "")
(transmit-signal port #\o)
(read-char-internal port))
-(define (transmit-modeline-string port prompt)
+(define (transmit-modeline-string port prompt level)
(transmit-signal-with-argument
port
#\p
- (let ((prefix (string-append (number->string (nearest-cmdl/level)) " ")))
- (string-append prefix
- (let ((prompt
- (string-trim-right
- (if (and (string-prefix? prefix prompt)
- (not (string=? prefix prompt)))
- (string-tail prompt (string-length prefix))
- prompt))))
- (let ((entry (assoc prompt cmdl-prompt-alist)))
- (if entry
- (cadr entry)
- (string-append "[Evaluator] " prompt))))))))
+ (let ((prefix (number->string level))
+ (prompt (string-trim prompt)))
+ (let ((entry (assoc prompt cmdl-prompt-alist)))
+ (if entry
+ (string-append prefix " " (cadr entry))
+ (string-append prefix " [Evaluator] " prompt))))))
(define cmdl-prompt-alist
'(("]=>" "[Evaluator]")
#| -*-Scheme-*-
-$Id: rep.scm,v 14.36 1993/10/15 10:26:33 cph Exp $
+$Id: rep.scm,v 14.37 1993/10/16 10:10:47 cph Exp $
Copyright (c) 1988-93 Massachusetts Institute of Technology
(define (initialize-package!)
(set! *nearest-cmdl* false)
- (set! hook/repl-prompt default/repl-prompt)
(set! hook/repl-eval default/repl-eval)
(set! hook/repl-write default/repl-write)
(set! hook/set-default-environment default/set-default-environment)
(port/set-default-syntax-table (cmdl/port repl) (repl/syntax-table repl))
(do () (false)
(let ((s-expression
- (hook/repl-prompt
- (string-append (number->string (cmdl/level repl))
- " "
- (repl/prompt repl))
- (cmdl/port repl))))
+ (prompt-for-command-expression (repl/prompt repl)
+ (cmdl/port repl))))
(repl-history/record! reader-history s-expression)
(let ((value
(hook/repl-eval repl
(repl-history/record! printer-history value)
(hook/repl-write repl s-expression value))))))
-(define hook/repl-prompt)
-(define (default/repl-prompt prompt port)
- (prompt-for-command-expression prompt port))
-
(define hook/repl-eval)
(define (default/repl-eval repl s-expression environment syntax-table)
(let ((scode (syntax s-expression syntax-table)))
#| -*-Scheme-*-
-$Id: usrint.scm,v 1.7 1993/10/16 07:32:34 cph Exp $
+$Id: usrint.scm,v 1.8 1993/10/16 10:10:39 cph Exp $
Copyright (c) 1991-93 Massachusetts Institute of Technology
(define (prompt-for-command-expression prompt #!optional port)
(let ((prompt (canonicalize-prompt prompt " "))
- (port (if (default-object? port) (nearest-cmdl/port) port)))
+ (port (if (default-object? port) (nearest-cmdl/port) port))
+ (level (nearest-cmdl/level)))
(let ((operation (port/operation port 'PROMPT-FOR-COMMAND-EXPRESSION)))
(if operation
- (operation port prompt)
- (default/prompt-for-command-expression port prompt)))))
+ (operation port prompt level)
+ (default/prompt-for-command-expression port prompt level)))))
-(define (default/prompt-for-command-expression port prompt)
+(define (default/prompt-for-command-expression port prompt level)
(port/with-output-terminal-mode port 'COOKED
(lambda ()
(fresh-line port)
(newline port)
- (write-string prompt port)
+ (write level port)
(write-string " " port)
+ (write-string prompt port)
(flush-output port)))
(port/with-input-terminal-mode port 'COOKED
(lambda ()
(operation port prompt)
(default/prompt-for-expression port prompt)))))
-(define default/prompt-for-expression
- default/prompt-for-command-expression)
+(define (default/prompt-for-expression port prompt)
+ (port/with-output-terminal-mode port 'COOKED
+ (lambda ()
+ (fresh-line port)
+ (newline port)
+ (write-string prompt port)
+ (flush-output port)))
+ (port/with-input-terminal-mode port 'COOKED
+ (lambda ()
+ (read port))))
(define (prompt-for-evaluated-expression prompt #!optional environment port)
(hook/repl-eval #f
\f
(define (prompt-for-command-char prompt #!optional port)
(let ((prompt (canonicalize-prompt prompt " "))
- (port (if (default-object? port) (nearest-cmdl/port) port)))
+ (port (if (default-object? port) (nearest-cmdl/port) port))
+ (level (nearest-cmdl/level)))
(let ((operation (port/operation port 'PROMPT-FOR-COMMAND-CHAR)))
(if operation
- (operation port prompt)
- (default/prompt-for-command-char port prompt)))))
+ (operation port prompt level)
+ (default/prompt-for-command-char port prompt level)))))
-(define (default/prompt-for-command-char port prompt)
+(define (default/prompt-for-command-char port prompt level)
(port/with-output-terminal-mode port 'COOKED
(lambda ()
(port/with-input-terminal-mode port 'RAW
(lambda ()
(fresh-line port)
(newline port)
+ (write level port)
+ (write-string " " port)
(write-string prompt port)
(flush-output port)
(let loop ()
projects / mit-scheme.git / commitdiff