622 lines
11 KiB
Scheme
622 lines
11 KiB
Scheme
;;; utilities
|
|
|
|
(define-interface handle-fatal-error-interface
|
|
(export with-fatal-error-handler*
|
|
(with-fatal-error-handler :syntax)))
|
|
|
|
(define-structure handle-fatal-error handle-fatal-error-interface
|
|
(open scheme conditions handle)
|
|
(files handle-fatal-error))
|
|
|
|
;;; history data structure
|
|
|
|
(define-interface history-interface
|
|
(export make-empty-history
|
|
history?
|
|
entry?
|
|
entry-data
|
|
append-history-item!
|
|
insert-history-item!
|
|
history-next-entry
|
|
history-prev-entry
|
|
history-first-entry
|
|
history-last-entry))
|
|
|
|
(define-structure history history-interface
|
|
(open scheme
|
|
define-record-types)
|
|
(files history))
|
|
|
|
;;; layout utilities
|
|
|
|
(define-interface layout-interface
|
|
(export seperate-line
|
|
layout-result-standard
|
|
get-marked-positions-1
|
|
get-marked-positions-2
|
|
get-marked-positions-3
|
|
exp->string
|
|
sublist
|
|
|
|
fill-up-string
|
|
cut-to-size
|
|
|
|
;; old drawing cruft
|
|
make-result-buffer
|
|
result-buffer?
|
|
result-buffer-line
|
|
set-result-buffer-line!
|
|
result-buffer-column
|
|
set-result-buffer-column!
|
|
result-buffer-y
|
|
set-result-buffer-y!
|
|
result-buffer-x
|
|
set-result-buffer-x!
|
|
result-buffer-num-lines
|
|
set-result-buffer-num-lines!
|
|
result-buffer-num-cols
|
|
set-result-buffer-num-cols!
|
|
result-buffer-highlighted
|
|
set-result-buffer-highlighted!
|
|
result-buffer-marked
|
|
set-result-buffer-marked!
|
|
make-simple-result-buffer-printer
|
|
|
|
show-shell-screen
|
|
with-output-to-result-screen
|
|
wait-for-key
|
|
|
|
paint-lock))
|
|
|
|
(define-structure layout layout-interface
|
|
(open scheme-with-scsh
|
|
srfi-6 ;; basic string ports
|
|
define-record-types
|
|
let-opt
|
|
locks
|
|
|
|
tty-debug
|
|
ncurses)
|
|
(files layout))
|
|
|
|
;;; windows and buffers
|
|
|
|
(define-interface app-windows-interface
|
|
(export make-app-window
|
|
app-window?
|
|
app-window-x
|
|
app-window-y
|
|
app-window-height
|
|
app-window-width
|
|
app-window-curses-win))
|
|
|
|
(define-interface nuit-windows-interface
|
|
(export bar-1
|
|
active-command-window
|
|
command-frame-window
|
|
command-window
|
|
result-window
|
|
result-frame-window
|
|
command-buffer
|
|
result-buffer
|
|
focus-on-command-buffer?
|
|
focus-command-buffer!
|
|
focus-on-result-buffer?
|
|
focus-result-buffer!
|
|
init-windows!))
|
|
|
|
(define-interface result-buffer-changes-interface
|
|
(export result-buffer-other-object-has-focus-rv
|
|
signal-result-buffer-object-change))
|
|
|
|
(define-structures
|
|
((app-windows app-windows-interface)
|
|
(nuit-windows nuit-windows-interface)
|
|
(result-buffer-changes result-buffer-changes-interface)
|
|
(initial-tty (export save-initial-tty-info!
|
|
restore-initial-tty-info!)))
|
|
(open (modify scheme-with-scsh
|
|
(hide select receive))
|
|
define-record-types
|
|
threads
|
|
|
|
rendezvous
|
|
rendezvous-channels
|
|
|
|
ncurses
|
|
tty-debug
|
|
layout)
|
|
(files win))
|
|
|
|
;;; process viewer plugin
|
|
|
|
(define-structure process-viewer
|
|
(export)
|
|
(open scheme
|
|
define-record-types
|
|
srfi-1
|
|
srfi-13
|
|
formats
|
|
signals
|
|
|
|
focus-table
|
|
ncurses
|
|
pps
|
|
plugin
|
|
layout
|
|
select-list
|
|
tty-debug)
|
|
(files process))
|
|
|
|
;;; user/group viewer plugin
|
|
|
|
(define-structure user-group-info-plugin (export)
|
|
(open scheme-with-scsh
|
|
define-record-types
|
|
(subset primitives (record-ref record?))
|
|
|
|
dirlist-view-plugin
|
|
fs-object
|
|
plugin
|
|
layout
|
|
select-list
|
|
tty-debug)
|
|
(files user-group-info))
|
|
|
|
;;; AFS
|
|
|
|
|
|
(define-structure afs-plugin (export)
|
|
(open scheme-with-scsh
|
|
afs-fs
|
|
define-record-types
|
|
(subset srfi-1 (iota delete))
|
|
threads
|
|
|
|
ncurses
|
|
select-list
|
|
completion-sets
|
|
run-jobs
|
|
plugin
|
|
layout)
|
|
(files afs))
|
|
|
|
;;; file list view plugin
|
|
|
|
(define-structure dirlist-view-plugin (export make-browser-for-dir
|
|
make-fsobjects-viewer)
|
|
(open (modify nuit-eval (hide string-copy))
|
|
srfi-1
|
|
(subset srfi-13
|
|
(string-copy string-drop string-join
|
|
string-drop-right string-prefix-length))
|
|
signals
|
|
let-opt
|
|
|
|
focus-table
|
|
objects
|
|
layout
|
|
fs-object
|
|
select-list
|
|
plugin
|
|
ncurses
|
|
tty-debug)
|
|
(files browse-directory-list))
|
|
|
|
;;; terminal buffer
|
|
|
|
(define-interface terminal-buffer-interface
|
|
(export make-terminal-buffer
|
|
terminal-buffer?
|
|
terminal-buffer-add-char
|
|
curses-paint-terminal-buffer
|
|
curses-paint-terminal-buffer/complete))
|
|
|
|
(define-structure terminal-buffer terminal-buffer-interface
|
|
(open scheme-with-scsh
|
|
srfi-1
|
|
define-record-types
|
|
signals
|
|
|
|
ncurses
|
|
tty-debug)
|
|
(files termbuf))
|
|
|
|
;;; standard command plugin
|
|
|
|
(define-structure standard-command-plugin
|
|
(export standard-command-plugin show-shell-screen)
|
|
(open let-opt
|
|
signals
|
|
srfi-1
|
|
srfi-13
|
|
srfi-37
|
|
sorting
|
|
|
|
joblist
|
|
jobs
|
|
layout
|
|
fs-object
|
|
pps
|
|
nuit-eval
|
|
ncurses
|
|
tty-debug
|
|
plugin)
|
|
(files std-command))
|
|
|
|
(define-structure standard-viewer
|
|
(export make-standard-viewer)
|
|
(open scheme
|
|
srfi-23
|
|
|
|
tty-debug
|
|
objects
|
|
layout)
|
|
(files std-viewer))
|
|
|
|
;;; fs-objects
|
|
|
|
(define-interface fs-object-interface
|
|
(export make-fs-object
|
|
fs-object?
|
|
fs-object-name
|
|
fs-object-path
|
|
fs-object-info
|
|
fs-object-complete-path
|
|
combine-path
|
|
file-name->fs-object))
|
|
|
|
(define-structure fs-object fs-object-interface
|
|
(open scheme-with-scsh
|
|
formats
|
|
handle-fatal-error
|
|
define-record-types)
|
|
(files fs-object))
|
|
|
|
;;; browse list stuff
|
|
|
|
(define-interface select-list-interface
|
|
(export make-select-list
|
|
select-list?
|
|
|
|
make-unmarked-element
|
|
make-marked-element
|
|
element?
|
|
|
|
select-list-handle-key-press
|
|
unmark-current-line
|
|
mark-current-line
|
|
move-cursor-up
|
|
move-cursor-down
|
|
paint-selection-list
|
|
paint-selection-list-at
|
|
select-list-get-selection
|
|
select-list-selected-entry
|
|
|
|
select-list-navigation-key?
|
|
select-list-marking-key?
|
|
|
|
make-get-selection-as-ref-method))
|
|
|
|
(define-structure select-list select-list-interface
|
|
(open scheme
|
|
srfi-1
|
|
(subset srfi-13 (string-join))
|
|
define-record-types
|
|
signals
|
|
|
|
(subset focus-table (make-focus-object-reference))
|
|
tty-debug
|
|
plugin
|
|
layout
|
|
ncurses)
|
|
(files select-list))
|
|
|
|
;;; joblist viewer
|
|
|
|
(define-structure joblist-viewer
|
|
(export)
|
|
(open scheme-with-scsh
|
|
srfi-1
|
|
srfi-6
|
|
(subset srfi-13 (string-join))
|
|
signals
|
|
|
|
objects
|
|
console
|
|
jobs
|
|
ncurses
|
|
focus-table
|
|
select-list
|
|
tty-debug
|
|
plugin
|
|
layout)
|
|
(files job-viewer))
|
|
|
|
;;; inspector
|
|
|
|
(define-interface nuit-inspector-interface
|
|
(export inspect-value))
|
|
|
|
(define-structure nuit-inspector-plugin nuit-inspector-interface
|
|
(open scheme
|
|
inspector-internal
|
|
continuations
|
|
formats
|
|
define-record-types
|
|
srfi-1
|
|
srfi-6
|
|
display-conditions
|
|
signals
|
|
(subset srfi-13 (string-join))
|
|
debug-data
|
|
(subset disclosers (template-debug-data))
|
|
|
|
focus-table
|
|
ncurses
|
|
layout
|
|
select-list
|
|
tty-debug
|
|
plugin)
|
|
(files inspector))
|
|
|
|
;;; nuit evaluates the expressions entered into command buffer in this
|
|
;;; package
|
|
|
|
(define-structures
|
|
((nuit-eval (compound-interface
|
|
(interface-of scheme-with-scsh)
|
|
(export focus-value-ref)
|
|
run-jobs-interface))
|
|
(nuit-eval/focus-table (export focus-table)))
|
|
(open
|
|
(modify scheme-with-scsh
|
|
(rename (directory-files scsh-directory-files)))
|
|
let-opt
|
|
srfi-1
|
|
|
|
terminal-buffer
|
|
jobs
|
|
run-jobs
|
|
focus-table
|
|
fs-object
|
|
pps)
|
|
(files eval))
|
|
|
|
;;; nuit plug-in registration
|
|
|
|
(define-interface plugin-interface
|
|
(export make-view-plugin
|
|
view-plugin?
|
|
view-plugin-constructor
|
|
view-plugin-type-predicate
|
|
|
|
make-command-plugin
|
|
command-plugin?
|
|
command-plugin-command
|
|
command-plugin-completer
|
|
command-plugin-evaluater
|
|
|
|
register-plugin!))
|
|
|
|
(define-interface plugin-host-interface
|
|
(export command-plugin-list
|
|
view-plugin-list
|
|
command-completions))
|
|
|
|
(define-structures
|
|
((plugin plugin-interface)
|
|
(plugin-host plugin-host-interface))
|
|
(open scheme
|
|
define-record-types
|
|
let-opt
|
|
signals
|
|
|
|
completion-sets)
|
|
(files plugins))
|
|
|
|
;;; objects
|
|
|
|
(define-interface objects-interface
|
|
(export send))
|
|
|
|
(define-structure objects objects-interface
|
|
(open scheme
|
|
signals)
|
|
(files objects))
|
|
|
|
;;; focus table
|
|
|
|
(define-interface focus-table-interface
|
|
(export make-empty-focus-table
|
|
add-focus-object
|
|
get-focus-object
|
|
make-focus-object-reference))
|
|
|
|
(define-structure focus-table focus-table-interface
|
|
(open scheme
|
|
define-record-types
|
|
tables)
|
|
(files focus))
|
|
|
|
;;; completion-sets
|
|
|
|
(define-interface completion-set-interface
|
|
(export make-empty-completion-set
|
|
make-completion-set
|
|
adjoin-completion-set
|
|
make-completion-set-for-executables
|
|
completions-for
|
|
completions-for-executables))
|
|
|
|
(define-structure completion-sets completion-set-interface
|
|
(open scheme-with-scsh
|
|
define-record-types
|
|
srfi-1
|
|
thread-fluids)
|
|
(files complete))
|
|
|
|
;;; console
|
|
|
|
(define-interface console-interface
|
|
(export
|
|
make-console
|
|
make-console-viewer
|
|
console?
|
|
view-console
|
|
pause-console-output
|
|
resume-console-output))
|
|
|
|
(define-structure console console-interface
|
|
(open (modify scheme-with-scsh
|
|
(hide receive select))
|
|
define-record-types
|
|
threads
|
|
rendezvous
|
|
rendezvous-channels
|
|
|
|
ncurses
|
|
plugin
|
|
tty-debug
|
|
result-buffer-changes
|
|
terminal-buffer)
|
|
(files console))
|
|
|
|
;;; jobs and joblist
|
|
|
|
(define-interface job-interface
|
|
(export make-job-with-console
|
|
make-job-sans-console
|
|
job-status
|
|
job-status-rv
|
|
|
|
job?
|
|
job-with-console?
|
|
job-sans-console?
|
|
|
|
job-running?
|
|
job-ready?
|
|
job-waiting-for-input?
|
|
job-has-new-output?
|
|
job-stopped?
|
|
job-start-time
|
|
job-end-time
|
|
job-proc
|
|
job-name
|
|
job-run-status
|
|
job-console
|
|
|
|
running-jobs
|
|
ready-jobs
|
|
stopped-jobs
|
|
clear-ready-jobs!
|
|
jobs-with-new-output
|
|
jobs-waiting-for-input
|
|
|
|
continue-job-in-foreground
|
|
|
|
signal-job
|
|
stop-job
|
|
continue-job))
|
|
|
|
(define-interface run-jobs-interface
|
|
(export
|
|
(run/console :syntax)
|
|
(run/fg :syntax)
|
|
(run/bg :syntax)))
|
|
|
|
(define-interface joblist-interface
|
|
(export running-jobs
|
|
ready-jobs
|
|
jobs-with-new-output
|
|
jobs-waiting-for-input
|
|
spawn-joblist-surveillant
|
|
initial-job-statistics))
|
|
|
|
(define-structures ((jobs job-interface)
|
|
(run-jobs run-jobs-interface)
|
|
(joblist joblist-interface))
|
|
(open (modify scheme-with-scsh
|
|
(hide receive select))
|
|
define-record-types
|
|
threads
|
|
srfi-1
|
|
signals
|
|
locks
|
|
|
|
rendezvous
|
|
rendezvous-channels
|
|
rendezvous-placeholders
|
|
|
|
initial-tty
|
|
ncurses
|
|
terminal-buffer
|
|
nuit-windows
|
|
app-windows
|
|
layout
|
|
tty-debug
|
|
console)
|
|
(files job))
|
|
|
|
;;; nuit
|
|
|
|
(define-interface nuit-interface
|
|
(export nuit))
|
|
|
|
(define-structure nuit nuit-interface
|
|
(open (modify scheme-with-scsh (hide receive))
|
|
external-calls
|
|
define-record-types
|
|
conditions
|
|
threads
|
|
locks
|
|
signals
|
|
handle
|
|
rt-modules
|
|
(modify ncurses (hide filter))
|
|
srfi-1
|
|
srfi-6
|
|
srfi-13
|
|
debugging
|
|
inspect-exception
|
|
rt-modules
|
|
tty-debug
|
|
threads
|
|
rendezvous
|
|
(modify rendezvous-channels
|
|
(rename
|
|
(send cml-send)
|
|
(receive cml-receive)))
|
|
let-opt
|
|
|
|
app-windows
|
|
initial-tty
|
|
nuit-windows
|
|
|
|
focus-table
|
|
result-buffer-changes
|
|
nuit-eval/focus-table
|
|
fs-object
|
|
objects
|
|
plugin
|
|
plugin-host
|
|
layout
|
|
pps
|
|
history
|
|
handle-fatal-error
|
|
completion-sets
|
|
select-list
|
|
jobs
|
|
joblist
|
|
;; the following modules are plugins
|
|
joblist-viewer
|
|
dirlist-view-plugin
|
|
user-group-info-plugin
|
|
afs-plugin
|
|
process-viewer
|
|
standard-command-plugin
|
|
standard-viewer
|
|
nuit-inspector-plugin)
|
|
(files nuit-engine))
|
|
|