commander-s/scheme/nuit-packages.scm

;;; 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
          paste-selection))

(define-structure utils utils-interface
  (open scheme
        srfi-6
        (subset srfi-13 (string-join))
        formats)
  (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
          app-window-init-curses-win!
          delete-app-window!))

(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

        modal-window
        app-windows
        objects
        configuration
	focus-table
	ncurses
	pps
	plugin
	layout
        utils
	select-list
        select-line
        select-element
	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 lset-difference))
        srfi-37
        
        dirlist-view-plugin
        fs-object
        plugin
        utils
        layout
        select-list
        select-element
        (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
        select-element
	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
        sorting

        configuration
	focus-table
	objects
	layout
        utils
	fs-object
	select-list
        select-line
        select-element
	plugin
	ncurses
	tty-debug)
  (files browse-directory-list))

;;; network viewer

(define-structure network-viewer (export)
  (open scheme-with-scsh
        (subset srfi-13 (string-join))

        plugin
        layout
        formats
        utils
        select-element
        select-list)
  (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
        eval-environment
	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?
	  
	  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-has-marks?
	  select-list-selected-entry

	  select-list-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

        select-element
	(subset focus-table (make-focus-object-reference))
        layout
	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
          select-line-key?))

(define-structure select-line select-line-interface
  (open scheme
	define-record-types
	signals
        
        select-element
        layout
	tty-debug
	ncurses)
  (files select-line))

(define-interface select-element-interface
  (export
   make-element
   make-unmarked-element
   make-marked-element
   make-unmarked-text-element
   make-marked-text-element
   element? element-markable? element-marked?
   element-value element-painter))

(define-structure select-element select-element-interface
  (open scheme
        define-record-types
        
        ncurses)
  (files select-element))

;;; 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
        select-element
	tty-debug
	plugin
	layout)
  (files job-viewer))

;;; inspector

(define-interface inspection-objects-interface
  (export with-inspector-handler
          make-inspection-object
          inspection-object?))

(define-structures 
  ((nuit-inspector-plugin (export))
   (inspection-objects inspection-objects-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))
        inspect-exception

        focus-table
	ncurses
        layout
        utils
        select-list
        select-element
        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

        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
        (subset scsh (exit))
        srfi-8
        srfi-13
        srfi-23
        environments
        package-commands-internal
        package-mutation
        ensures-loaded
        (subset packages (structure-package))
        (subset packages-internal 
                (package-unstable?
                 set-package-loaded?!))
        
        inspection-objects
        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
   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))

;;; modal window

(define-interface modal-window-interface
  (export
   maybe-modal-window
   set-modal-window!
   close-modal-window!))

(define-structure modal-window modal-window-interface
  (open scheme
        signals)
  (files modal-window))

;;; 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
        inspection-objects
        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 
        modal-window
        inspect-exception

	configuration
	command-line-parser
	command-line-compiler
	utils
	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
        select-element
	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))