* Display evaluation package in Scheme prompt

* Non-working attempt to install a Ctrl-c handler for the scheme mode
* Wait for the user to open the debug tty
This commit is contained in:
mainzelm 2006-04-05 07:48:27 +00:00
parent 982a8aec9f
commit a1011a5d27
3 changed files with 67 additions and 30 deletions

View File

@ -1,13 +1,26 @@
(define (init-evaluation-environment package)
(define *evaluation-environment*)
(define *evaluation-environment-name*)
(define *user-environment* #f)
(define (load-evaluation-environment package)
(let ((structure (reify-structure package)))
(load-structure structure)
(rt-structure->environment structure)))
(define *evaluation-environment*)
(define (evaluation-environment-name)
(if (eq? *evaluation-environment*
*user-environment*)
(string->symbol "") ; aehm...
*evaluation-environment-name*))
(define (set-evaluation-package! package-name)
(set! *evaluation-environment*
(init-evaluation-environment package-name)))
(load-evaluation-environment package-name))
(set! *evaluation-environment-name* package-name))
(define (init-evaluation-environment! user-env)
(set-evaluation-package! user-env)
(set! *user-environment* (evaluation-environment)))
(define (evaluation-environment)
*evaluation-environment*)

View File

@ -18,14 +18,6 @@
(define-option 'main 'switch-command-buffer-mode-key key-f7)
;; configurable options
(define-option 'main 'switch-command-buffer-mode-key key-f7)
;; configurable options
(define-option 'main 'switch-command-buffer-mode-key key-f7)
;; mode of the command buffer
(define-option 'main 'initial-command-mode 'command)
@ -136,7 +128,12 @@
(begin
(display "Debug messages will be on ")
(display tty-name)
(newline))))
(newline)
(display "Please (re-)open this device for reading now and then press RET to continue")
(newline)
(read-char)
)))
(set! nuit-engine-thread (current-thread))
(with-inspecting-handler
8888
(lambda (condition)
@ -173,13 +170,18 @@
(cond
((command-buffer-in-command-mode?)
(enter-scheme-mode!)
(change-command-buffer-prompt! (command-buffer) "> "))
(change-command-buffer-prompt!
(command-buffer)
(lambda ()
(string-append
(symbol->string (evaluation-environment-name))
"> "))))
((command-buffer-in-scheme-mode?)
(enter-command-mode!)
(change-command-buffer-prompt! (command-buffer) (lambda ()
(string-append (cwd)
"> ")))))
(paint-command-frame-window)
"> "))))
(paint-command-frame-window))
(paint-command-window-contents)
(refresh-command-window))
@ -334,15 +336,29 @@
(lambda ignore
'terminal-output))
(define nuit-engine-thread #f)
(define keyboard-handler
(lambda ignore
(if (command-buffer-in-command-mode?)
23
(schedule-event
nuit-engine-thread
(enum
event-type
interrupt)
(enum interrupt keyboard)))))
(define (install-signal-handlers)
(for-each
(lambda (signal)
(set-interrupt-handler signal #f))
(list interrupt/int
;interrupt/quit
interrupt/tstp))
(set-interrupt-handler signal/ttin terminal-input-handler)
(set-interrupt-handler signal/ttou terminal-output-handler))
; (for-each
; (lambda (signal)
; (set-interrupt-handler signal #f))
; (list interrupt/int
; ;interrupt/quit
; interrupt/tstp))
;(set-interrupt-handler signal/ttin terminal-input-handler)
;(set-interrupt-handler signal/ttou terminal-output-handler)
(set-interrupt-handler interrupt/keyboard keyboard-handler))
(define (enable-tty-output-control! port)
(let ((info (copy-tty-info (tty-info port))))
@ -358,6 +374,7 @@
;; handle input
(define (run)
(ignore-signal signal/ttou)
(install-signal-handlers)
(save-initial-tty-info! (current-input-port))
(init-screen)
@ -365,7 +382,7 @@
(read-config-file!)
(set! *command-buffer-mode* (config 'main 'initial-command-mode))
(set-evaluation-package! 'nuit-eval)
(init-evaluation-environment! 'nuit-eval)
(clear)
(if (not (process-group-leader?))
@ -729,8 +746,8 @@
completions)
num-lines))
(define (display-completed-line line cursor-pos)
(debug-message "display-completed-line " line "," cursor-pos)
(define (display-completed-line line)
(debug-message "display-completed-line " line)
(set-buffer-text! (command-buffer) line)
(wclrtoeol (app-window-curses-win (command-window)))
(print-command-buffer (command-buffer))
@ -753,7 +770,7 @@
(if maybe-completed-line
;; #### don't ask about the 2...
(display-completed-line maybe-completed-line (+ 2 cursor-index)))
(display-completed-line maybe-completed-line))
(cond
((null? completions)
@ -815,8 +832,7 @@
(lambda (to-complete)
(display completion))))
(lambda (completed-line new-cursor-pos)
(display-completed-line completed-line
(+ 2 new-cursor-pos))))
(display-completed-line completed-line)))
(delete-app-window! dialog)
#t))
((select-list-key? key)

View File

@ -251,6 +251,7 @@
let-opt
sorting
handle-fatal-error
configuration
focus-table
objects
@ -539,8 +540,10 @@
(define-interface eval-environment-interface
(export
init-evaluation-environment!
set-evaluation-package!
evaluation-environment
evaluation-environment-name
eval-string
eval-s-expr))
@ -733,7 +736,9 @@
threads
rendezvous
rendezvous-channels
(subset primitives (eof-object))
handle-fatal-error
ncurses
plugin
tty-debug
@ -975,6 +980,9 @@
(receive cml-receive)))
let-opt
destructuring
threads-internal
enumerated
architecture
(modify ncurses (hide filter))
command-buffer