907 lines
17 KiB
Scheme
907 lines
17 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))
|
|
|
|
(define-interface utils-interface
|
|
(export display-to-string
|
|
write-to-string
|
|
on/off-option-processor))
|
|
|
|
(define-structure utils utils-interface
|
|
(open scheme
|
|
srfi-6)
|
|
(files utils))
|
|
|
|
;;; 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
|
|
sublist
|
|
|
|
fill-up-string
|
|
right-align-string
|
|
left-align-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
|
|
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-with-scsh
|
|
define-record-types
|
|
srfi-1
|
|
srfi-13
|
|
formats
|
|
signals
|
|
ascii
|
|
sorting
|
|
srfi-8
|
|
srfi-26
|
|
|
|
configuration
|
|
focus-table
|
|
ncurses
|
|
pps
|
|
plugin
|
|
layout
|
|
utils
|
|
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?))
|
|
(subset srfi-13 (string-join))
|
|
(subset srfi-1 (partition))
|
|
srfi-37
|
|
|
|
dirlist-view-plugin
|
|
fs-object
|
|
plugin
|
|
utils
|
|
layout
|
|
select-list
|
|
(subset focus-table (make-focus-object-reference))
|
|
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
|
|
utils
|
|
fs-object
|
|
select-list
|
|
plugin
|
|
ncurses
|
|
tty-debug)
|
|
(files browse-directory-list))
|
|
|
|
;;; network viewer
|
|
|
|
(define-structure network-viewer (export)
|
|
(open scheme-with-scsh
|
|
|
|
plugin
|
|
select-line)
|
|
(files network-viewer))
|
|
|
|
;;; 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
|
|
handle
|
|
conditions
|
|
srfi-1
|
|
srfi-13
|
|
srfi-37
|
|
sorting
|
|
|
|
command-line-lexer
|
|
command-line-parser
|
|
command-line-absyn
|
|
command-line-compiler
|
|
completion-sets
|
|
completion-utilities
|
|
joblist
|
|
jobs
|
|
run-jobs-internals
|
|
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
|
|
utils
|
|
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-text-element
|
|
make-marked-text-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-get-marked
|
|
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
|
|
utils
|
|
ncurses)
|
|
(files select-list))
|
|
|
|
(define-interface select-line-interface
|
|
(export make-select-line
|
|
select-line-handle-key-press!
|
|
paint-select-line
|
|
paint-select-line-at
|
|
select-line-selected-entry))
|
|
|
|
(define-structure select-line select-line-interface
|
|
(open scheme
|
|
define-record-types
|
|
signals
|
|
|
|
tty-debug
|
|
ncurses)
|
|
(files select-line))
|
|
|
|
;;; 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
|
|
utils
|
|
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
|
|
run-jobs
|
|
run-jobs-internals
|
|
jobs
|
|
focus-table
|
|
fs-object
|
|
pps)
|
|
(files eval))
|
|
|
|
;;; evaluation of Scheme expressions
|
|
|
|
(define-interface eval-environment-interface
|
|
(export
|
|
set-evaluation-package!
|
|
evaluation-environment
|
|
eval-string
|
|
eval-s-expr))
|
|
|
|
(define-structure eval-environment eval-environment-interface
|
|
(open scheme
|
|
srfi-6
|
|
|
|
inspect-exception
|
|
rt-modules)
|
|
(files eval-environment))
|
|
|
|
(define-interface scheme-commands-interface
|
|
(export scheme-command-line?
|
|
split-scheme-command-line
|
|
eval-scheme-command))
|
|
|
|
(define-structure scheme-commands scheme-commands-interface
|
|
(open scheme
|
|
srfi-8
|
|
srfi-13
|
|
srfi-23
|
|
environments
|
|
package-commands-internal
|
|
package-mutation
|
|
|
|
eval-environment)
|
|
(files scheme-commands))
|
|
|
|
;;; 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
|
|
|
|
tty-debug
|
|
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))
|
|
|
|
;;; utility functions for implementing completion
|
|
|
|
(define-interface completion-utilities-interface
|
|
(export files-in-dir
|
|
complete-path
|
|
file-exists-and-is-directory?
|
|
complete-with-filesystem-objects
|
|
make-completer-for-file-with-extension
|
|
complete-executables/path
|
|
|
|
find-completions-for-arg
|
|
find-completions-for-redir))
|
|
|
|
(define-structure completion-utilities completion-utilities-interface
|
|
(open scheme
|
|
(subset scsh
|
|
(file-name-directory glob with-cwd cwd
|
|
file-name-extension
|
|
file-name-as-directory
|
|
file-name-directory?
|
|
absolute-file-name expand-file-name
|
|
file-exists? file-directory? file-executable?
|
|
directory-files getenv))
|
|
(subset srfi-1 (filter-map))
|
|
srfi-13
|
|
srfi-14
|
|
signals
|
|
conditions
|
|
handle
|
|
|
|
tty-debug
|
|
command-line-absyn
|
|
completion-sets)
|
|
(files complete-util))
|
|
|
|
;;; standard completion mechanism
|
|
|
|
(define-interface completer-interface
|
|
(export complete
|
|
init-executables-completion-set!))
|
|
|
|
(define-structure completer completer-interface
|
|
(open scheme
|
|
(subset scsh (getenv cwd expand-file-name))
|
|
signals
|
|
conditions
|
|
handle
|
|
conditions
|
|
destructuring
|
|
let-opt
|
|
(subset srfi-1 (find))
|
|
srfi-13
|
|
srfi-14
|
|
threads
|
|
locks
|
|
|
|
tty-debug
|
|
completion-utilities
|
|
completion-sets
|
|
plugin
|
|
plugin-host
|
|
command-line-lexer
|
|
command-line-parser
|
|
command-line-absyn)
|
|
(files completer))
|
|
|
|
;;; 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
|
|
continue-job-in-background
|
|
|
|
signal-job
|
|
stop-job
|
|
continue-job))
|
|
|
|
(define-interface run-jobs-interface
|
|
(export
|
|
(run/console :syntax)
|
|
(run/fg :syntax)
|
|
(run/bg :syntax)))
|
|
|
|
(define-interface run-jobs-internals-interface
|
|
(export
|
|
eval-string
|
|
eval-s-expr
|
|
run/console*
|
|
run/fg*
|
|
run/bg*))
|
|
|
|
(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)
|
|
(run-jobs-internals run-jobs-internals-interface)
|
|
(joblist joblist-interface))
|
|
(open (modify scheme-with-scsh
|
|
(hide receive select))
|
|
define-record-types
|
|
threads
|
|
srfi-1
|
|
; srfi-6
|
|
signals
|
|
locks
|
|
let-opt
|
|
|
|
rendezvous
|
|
rendezvous-channels
|
|
rendezvous-placeholders
|
|
|
|
eval-environment
|
|
initial-tty
|
|
ncurses
|
|
terminal-buffer
|
|
nuit-windows
|
|
app-windows
|
|
layout
|
|
tty-debug
|
|
console)
|
|
(files job))
|
|
|
|
;;; command line parser
|
|
|
|
(define-interface command-line-lexer-tokens-interface
|
|
(export
|
|
token? token-token token-type token-cursor-pos
|
|
string-token?
|
|
s-expr-token?
|
|
operator-token?))
|
|
|
|
(define-interface command-line-lexer-interface
|
|
(export lex-command-line))
|
|
|
|
(define-interface command-line-absyn-interface
|
|
(export
|
|
command-line?
|
|
command-line-first-cmd
|
|
command-line-combinator/cmds
|
|
command-line-job-ctrl
|
|
|
|
command?
|
|
command-executable
|
|
command-args
|
|
command-redirections
|
|
|
|
redirection?
|
|
redirection-op
|
|
redirection-dest
|
|
|
|
to-complete?
|
|
to-complete-prefix
|
|
to-complete-without-prefix?
|
|
to-complete-pos))
|
|
|
|
(define-interface command-line-absyn-constructors-interface
|
|
(export
|
|
make-command-line
|
|
make-command
|
|
make-redirection))
|
|
|
|
(define-interface command-line-parser-interface
|
|
(export parse-command-line
|
|
unparse-command-line
|
|
|
|
parser-error?
|
|
parser-syntax-error?
|
|
parser-unexpected-eof?
|
|
|
|
lex/parse-partial-command-line))
|
|
|
|
(define-structures
|
|
((command-line-lexer (compound-interface
|
|
command-line-lexer-tokens-interface
|
|
command-line-lexer-interface))
|
|
(command-line-parser (compound-interface
|
|
command-line-absyn-interface
|
|
command-line-parser-interface))
|
|
(command-line-absyn (compound-interface
|
|
command-line-absyn-interface
|
|
command-line-absyn-constructors-interface)))
|
|
(open scheme
|
|
(subset scsh (with-current-output-port))
|
|
extended-ports
|
|
define-record-types
|
|
(subset srfi-1 (filter drop-right))
|
|
srfi-8
|
|
(subset srfi-13 (string-join))
|
|
srfi-14
|
|
let-opt
|
|
cells
|
|
silly
|
|
conditions
|
|
signals
|
|
handle)
|
|
(files cmdline))
|
|
|
|
;;; command line compiler
|
|
|
|
(define-interface command-line-compiler-interface
|
|
(export compile-command-line))
|
|
|
|
(define-structure command-line-compiler
|
|
command-line-compiler-interface
|
|
(open scheme
|
|
signals
|
|
|
|
command-line-lexer
|
|
command-line-parser
|
|
command-line-absyn)
|
|
(files comp-cmd))
|
|
|
|
;;; config
|
|
|
|
(define-interface configuration-interface
|
|
(export read-config-file!
|
|
define-option
|
|
config))
|
|
|
|
(define-structure configuration configuration-interface
|
|
(open scheme-with-scsh
|
|
signals
|
|
handle-fatal-error)
|
|
(files config))
|
|
|
|
;;; 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
|
|
srfi-1
|
|
srfi-6
|
|
srfi-8
|
|
srfi-13
|
|
debugging
|
|
inspect-exception
|
|
tty-debug
|
|
threads
|
|
rendezvous
|
|
(modify rendezvous-channels
|
|
(rename
|
|
(send cml-send)
|
|
(receive cml-receive)))
|
|
let-opt
|
|
destructuring
|
|
|
|
(modify ncurses (hide filter))
|
|
app-windows
|
|
initial-tty
|
|
nuit-windows
|
|
|
|
configuration
|
|
command-line-parser
|
|
focus-table
|
|
result-buffer-changes
|
|
nuit-eval/focus-table
|
|
fs-object
|
|
objects
|
|
plugin
|
|
plugin-host
|
|
layout
|
|
pps
|
|
history
|
|
handle-fatal-error
|
|
completion-sets
|
|
completer
|
|
select-list
|
|
jobs
|
|
run-jobs
|
|
run-jobs-internals
|
|
joblist
|
|
eval-environment
|
|
scheme-commands
|
|
;; the following modules are plugins
|
|
joblist-viewer
|
|
dirlist-view-plugin
|
|
user-group-info-plugin
|
|
;afs-plugin
|
|
process-viewer
|
|
standard-command-plugin
|
|
standard-viewer
|
|
network-viewer
|
|
nuit-inspector-plugin)
|
|
(files nuit-engine))
|
|
|