scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Clean up code releated for handling messages. Add a new plugin for 

pps (portable ps)
This commit is contained in:
eknauel 2005-05-20 15:20:34 +00:00
parent 1e8cb9369c
commit 725e58f2a1
9 changed files with 133 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
scheme/browse-directory-list.scm
View File

@ -176,7 +176,7 @@
browse-obj))))
((print-message? message)
(let* ((model (print-message-object message))
(let* ((model (message-result-object message))
(pos-y (browse-dir-list-res-obj-pos-y model))
(pos-x (browse-dir-list-res-obj-pos-x model))
(text (browse-dir-list-res-obj-result-text model))
@ -186,7 +186,7 @@
(make-print-object pos-y pos-x text (list pos-y) marked-pos)))
((key-pressed-message? message)
(let* ((model (key-pressed-message-result-model message))
(let* ((model (message-result-object message))
(key (key-pressed-message-key message))
(c-x-pressed (browse-dir-list-res-obj-c-x-pressed model)))
@ -344,12 +344,12 @@
((restore-message? message)
(let* ((model (restore-message-object message))
(let* ((model (message-result-object message))
(initial-wd (browse-dir-list-res-obj-initial-wd model)))
(chdir initial-wd)))
((selection-message? message)
(let* ((model (selection-message-object message))
(let* ((model (message-result-object message))
(marked-items (browse-dir-list-res-obj-res-marked-items model)))
(string-append "'" (exp->string marked-items)))))))

6
scheme/browse-list.scm
View File

@ -152,7 +152,7 @@
browse-obj))))))
((print-message? message)
(let* ((model (print-message-object message))
(let* ((model (message-result-object message))
(pos-y (browse-list-res-obj-pos-y model))
(pos-x (browse-list-res-obj-pos-x model))
(text (browse-list-res-obj-result-text model))
@ -169,7 +169,7 @@
(make-print-object pos-y pos-x text highlighted real-marked-pos)))
((key-pressed-message? message)
(let* ((model (key-pressed-message-result-model message))
(let* ((model (message-result-object message))
(key (key-pressed-message-key message))
(c-x-pressed (browse-list-res-obj-c-x-pressed model)))
@ -331,7 +331,7 @@
((selection-message? message)
(let* ((model (selection-message-object message))
(let* ((model (message-result-object message))
(marked-items (browse-list-res-obj-marked-items model)))
(string-append "'" (exp->string marked-items))))

8
scheme/cd.scm
View File

@ -47,7 +47,7 @@
(make-cd-res-obj (browse-dir-list-receiver
browse-next-command-message)))))))))
((print-message? message)
(let* ((model (print-message-object message))
(let* ((model (message-result-object message))
(width (print-message-width message))
(browser (cd-res-obj-browse-obj model))
(browse-print-message
@ -56,7 +56,7 @@
width)))
(browse-dir-list-receiver browse-print-message)))
((key-pressed-message? message)
(let* ((model (key-pressed-message-result-model message))
(let* ((model (message-result-object message))
(key (key-pressed-message-key message))
(browser (cd-res-obj-browse-obj model))
(browse-key-message
@ -67,12 +67,12 @@
browse-key-message))))
((restore-message? message)
(let* ((model (restore-message-object message))
(let* ((model (message-result-object message))
(browser (cd-res-obj-browse-obj model))
(wd (browse-dir-list-res-obj-working-directory browser)))
(chdir wd)))
((selection-message? message)
(let* ((model (selection-message-object message))
(let* ((model (message-result-object message))
(browser (cd-res-obj-browse-obj model))
(browse-sel-message
(make-selection-message "browse-dir-list"

8
scheme/directory-files.scm
View File

@ -26,7 +26,7 @@
(make-dirfiles-res-obj (browse-dir-list-receiver
browse-next-command-message))))
((print-message? message)
(let* ((model (print-message-object message))
(let* ((model (message-result-object message))
(width (print-message-width message))
(browser (dirfiles-res-obj-browse-obj model))
(browse-print-message
@ -35,7 +35,7 @@
width)))
(browse-dir-list-receiver browse-print-message)))
((key-pressed-message? message)
(let* ((model (key-pressed-message-result-model message))
(let* ((model (message-result-object message))
(key (key-pressed-message-key message))
(browser (dirfiles-res-obj-browse-obj model))
(browse-key-message
@ -46,14 +46,14 @@
browse-key-message))))
((restore-message? message)
(let* ((model (restore-message-object message))
(let* ((model (message-result-object message))
(browser (dirfiles-res-obj-browse-obj model))
(browse-restore-message
(make-restore-message "browse-dir-list"
browser)))
(browse-dir-list-receiver browse-restore-message)))
((selection-message? message)
(let* ((model (selection-message-object message))
(let* ((model (message-result-object message))
(browser (dirfiles-res-obj-browse-obj model))
(browse-sel-message
(make-selection-message "browse-dir-list"

8
scheme/find.scm
View File

@ -45,7 +45,7 @@
(make-find-res-obj (browse-list-receiver
browse-next-command-message))))))
((print-message? message)
(let* ((model (print-message-object message))
(let* ((model (message-result-object message))
(width (print-message-width message))
(browser (find-res-obj-browse-obj model))
(browse-print-message
@ -54,7 +54,7 @@
width)))
(browse-list-receiver browse-print-message)))
((key-pressed-message? message)
(let* ((model (key-pressed-message-result-model message))
(let* ((model (message-result-object message))
(key (key-pressed-message-key message))
(browser (find-res-obj-browse-obj model))
(browse-key-message
@ -65,14 +65,14 @@
browse-key-message))))
((restore-message? message)
(let* ((model (restore-message-object message))
(let* ((model (message-result-object message))
(browser (find-res-obj-browse-obj model))
(browse-restore-message
(make-restore-message "browse-ist"
browser)))
(browse-list-receiver browse-restore-message)))
((selection-message? message)
(let* ((model (selection-message-object message))
(let* ((model (message-result-object message))
(browser (find-res-obj-browse-obj model))
(browse-sel-message
(make-selection-message "browse-list"

7
scheme/go
View File

@ -1,4 +1,5 @@
#!/bin/sh
args="-lel module-system/load.scm -lel interaction/load.scm -lm debug-packages.scm -lel scsh-ncurses-0.2/load.scm -lm nuit-packages.scm -o nuit"
echo "Starting scsh with options: $args"
exec scsh $args
args="-lel pps/load.scm -lel module-system/load.scm -lel interaction/load.scm -lm debug-packages.scm -lel scsh-ncurses-0.2/load.scm -lm nuit-packages.scm -o nuit"
echo "Starting scsh with options: $args"
exec scsh $args
#-c "(nuit)"

128
scheme/nuit-engine.scm
View File

@ -144,7 +144,7 @@
;;---------------------
;;A new command was entered
;;->create a new "object"
(define-record-type next-command-message next-command-message
(define-record-type next-command-message :next-command-message
(make-next-command-message command-string
parameters
width)
@ -156,27 +156,27 @@
;;key pressed
;;The object and the key are send to the user-code, who returns the
;;changed object.
(define-record-type key-pressed-message key-pressed-message
(define-record-type key-pressed-message :key-pressed-message
(make-key-pressed-message command-string
result-model
result-object
key)
key-pressed-message?
(command-string key-pressed-command-string)
(result-model key-pressed-message-result-model)
(result-object key-pressed-message-result-object)
(key key-pressed-message-key))
;;print
(define-record-type print-message print-message
(define-record-type print-message :print-message
(make-print-message command-string
object
result-object
width)
print-message?
(command-string print-message-command-string)
(object print-message-object)
(result-object print-message-result-object)
(width print-message-width))
;;->this sort of data-type is returned by a print-message
(define-record-type print-object print-object
(define-record-type print-object :print-object
(make-print-object pos-y
pos-x
text
@ -189,25 +189,56 @@
(marked-lines print-object-marked-lines))
;;restore (when side-effects occur)
(define-record-type restore-message restore-message
(define-record-type restore-message :restore-message
(make-restore-message command-string
object)
result-object)
restore-message?
(command-string restore-message-command-string)
(object restore-message-object))
(result-object restore-message-result-object))
;;request the selection
(define-record-type selection-message selection-message
(define-record-type selection-message :selection-message
(make-selection-message command-string
object)
result-object)
selection-message?
(command-string selection-message-command-string)
(object selection-message-object))
(result-object selection-message-result-object))
(define (message-result-object message)
((cond
((key-pressed-message? message)
key-pressed-message-result-object)
((print-message? message)
print-message-result-object)
((restore-message? message)
restore-message-result-object)
((selection-message? message)
selection-message-result-object message)
(else
(error "This message-type has no field for result-objects"
message)))
message))
(define (message-command-string message)
((cond
((next-command-message? message)
next-command-string)
((key-pressed-message? message)
key-pressed-command-string)
((print-message? message)
print-message-command-string)
((restore-message? message)
restore-message-command-string)
((selection-message? message)
selection-message-command-string)
(else
(error "This message-type has no command field" message)))
message))
;;The "user" (who extends the functionality of NUIT) has to inform NUIT
;;about which function is meant to be the receiver, when a certain
;;command is active
(define-record-type receiver receiver
(define-record-type receiver :receiver
(make-receiver command rec)
receiver?
(command receiver-command)
@ -330,7 +361,10 @@
(text (sublist (buffer-text command-buffer) 0
(- (length (buffer-text command-buffer)) 1))))
(begin
(switch restore-message)
;; is this correct?
(switch (make-restore-message
command-string
current-result-object))
(set-buffer-text! (append text (list command-string)))
(execute-command)
(set-buffer-history-pos! command-buffer
@ -633,33 +667,17 @@
;;Message-Passing
;;switch manages that the messages are delivered in the correct way
(define (switch message)
(let ((command ""))
(cond
((next-command-message? message)
(set! command (next-command-string message)))
((key-pressed-message? message)
(set! command (key-pressed-command-string message)))
((print-message? message)
(set! command (print-message-command-string message)))
((restore-message? message)
(set! command (restore-message-command-string message)))
((selection-message? message)
(set! command (selection-message-command-string message))))
(let ((receiver (get-receiver command)))
(if receiver
(receiver message)
(standard-receiver message)))))
(cond
((get-receiver (message-command-string message))
=> (lambda (receiver)
((receiver-rec receiver) message)))
(else
(standard-receiver message))))
(define (get-receiver command)
(let loop ((recs receivers))
(if (= 0 (length recs))
#f
(let* ((act-rec (car recs))
(act-com (receiver-command act-rec))
(act-rec-proc (receiver-rec act-rec)))
(if (equal? command act-com)
act-rec-proc
(loop (cdr recs)))))))
(find (lambda (r)
(string=? (receiver-command r) command))
receivers))
;;Management of the upper buffer
;;add a char to the buffer
@ -821,7 +839,7 @@
;;move cursor to the corrct position
(define (move-cursor buffer)
(if (focus-on-command-buffer?)
(cursor-right-pos (app-window-curses-win command-window)
(cursor-right-pos (app-window-curses-win command-window)
buffer)
(begin
(compute-y-x)
@ -832,22 +850,10 @@
;;compue pos-x and pos-y
(define (compute-y-x)
(if (focus-on-command-buffer?)
(begin
(if (>= (buffer-pos-fin-ln command-buffer)
(buffer-num-lines command-buffer))
(set-buffer-pos-y! command-buffer
(buffer-num-lines command-buffer))
(set-buffer-pos-y! command-buffer
(buffer-pos-fin-ln command-buffer)))
(let ((posx (modulo (buffer-pos-col command-buffer)
(buffer-num-cols command-buffer))))
(set-buffer-pos-x! command-buffer posx)))
(begin
(if (>= pos-result result-lines)
(set! result-buffer-pos-y result-lines)
(set! result-buffer-pos-y pos-result))
(set! result-buffer-pos-x pos-result-col))))
(if (>= pos-result result-lines)
(set! result-buffer-pos-y result-lines)
(set! result-buffer-pos-y pos-result))
(set! result-buffer-pos-x pos-result-col))
; ;;index of shortcuts at the bottom
@ -965,7 +971,7 @@
((print-message? message)
(make-print-object 1 1 shortcuts '() '()))
((key-pressed-message? message)
(key-pressed-message-result-model message))
(message-result-object message))
((restore-message? message)
(values))
((selection-message? message)
@ -1012,7 +1018,7 @@
(make-standard-result-obj 1 1 text result)))
std-obj)))
((print-message? message)
(let* ((model (print-message-object message))
(let* ((model (message-result-object message))
(pos-y (standard-result-obj-cur-pos-y model))
(pos-x (standard-result-obj-cur-pos-x model))
(width (print-message-width message))
@ -1021,7 +1027,7 @@
result width)))
(make-print-object pos-y pos-x text '() '())))
((key-pressed-message? message)
(key-pressed-message-result-model message))
(message-result-object message))
((restore-message? message)
(values))
((selection-message? message)

9
scheme/nuit-packages.scm
View File

@ -9,15 +9,20 @@
signals
handle
ncurses
srfi-1
srfi-6
srfi-13
debugging
inspect-exception
rt-modules
tty-debug)
tty-debug
pps)
(files nuit-engine
handle-fatal-error
directory-files
find
cd
browse-directory-list
browse-list))
browse-list
process))

36
scheme/process.scm Normal file
View File

@ -0,0 +1,36 @@
(define (print-processes processes)
(map (lambda (pi)
(apply format
(append
(list #f
"~A ~A ~A ~A '~A ~A'~%")
(map (lambda (s) (s pi))
(list process-info-pid
process-info-ppid
process-info-real-uid
process-info-%cpu
process-info-executable
process-info-command-line)))))
processes))
(define (pps-receiver message)
(cond
((next-command-message? message)
(pps))
((print-message? message)
(let ((processes (message-result-object message)))
(make-print-object 1 1 (print-processes processes)
'() '())))
((key-pressed-message? message)
(pps))
((restore-message? message)
(values))
((selection-message? message)
"'()")))
(set! receivers (cons (make-receiver "ps" pps-receiver)
receivers))