* 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:
parent
982a8aec9f
commit
a1011a5d27
|
@ -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*)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue