temporary version
This commit is contained in:
demattia
parent
72c3682d0e
commit
9e9653e404
|
|
@ -37,13 +37,12 @@
|
|||
;;----------------------------
|
||||
|
||||
;;Text
|
||||
(define text-result (list "Start entering commands."
|
||||
"Ctrl-h for help."))
|
||||
(define text-result (list "Start entering commands."))
|
||||
|
||||
;;gibt an, in welcher Zeile des Result-Buffers man sich befindet
|
||||
(define pos-result 2)
|
||||
(define pos-result 1)
|
||||
;;in welcher Spalte
|
||||
(define pos-result-col 17)
|
||||
(define pos-result-col 25)
|
||||
|
||||
;;gibt an, in welcher Zeile des Buffers man sich befindet
|
||||
(define result-buffer-pos-y 2)
|
||||
|
|
@ -63,6 +62,32 @@
|
|||
;;entweder 1...oben oder 2...unten
|
||||
(define active-buffer 1)
|
||||
|
||||
;;History
|
||||
(define history '())
|
||||
|
||||
;;Position in der History
|
||||
(define history-pos 0)
|
||||
|
||||
;;aktiver Befehl
|
||||
(define active-command "")
|
||||
|
||||
|
||||
;;Record für Angaben zu Erweiterungen
|
||||
(define-record-type command-addition command-addition
|
||||
(make-command-addition command-string
|
||||
layout-procedure
|
||||
selected-procedure
|
||||
restore-procedure)
|
||||
command-addition?
|
||||
(command-string command-add-command-string)
|
||||
(layout-procedure command-add-layout-proc)
|
||||
(selected-procedure command-add-selected-proc)
|
||||
(restore-procedure command-add-restore-proc))
|
||||
|
||||
|
||||
;;Diese Liste beinhaltet die Informationen dazu, was bei bestimmten
|
||||
;;Benutzereingaben zu tun ist:
|
||||
(define command-additions '() )
|
||||
|
||||
;;*************************************************************************
|
||||
;;Verhalten
|
||||
|
|
@ -75,15 +100,23 @@
|
|||
|
||||
;;Beenden
|
||||
((= ch key-f1)
|
||||
#t)
|
||||
(begin
|
||||
(addition-function command-add-restore-proc)
|
||||
#t))
|
||||
|
||||
;;Enter
|
||||
((= ch 10)
|
||||
(if (= active-buffer 1)
|
||||
(begin
|
||||
;;Es wird die restore-Prozedur aufgerufen
|
||||
((addition-function command-add-restore-proc))
|
||||
(execute-command)
|
||||
(loop (paint)))
|
||||
(loop (paint))))
|
||||
;; es wird die passende Prozedur aufgerufen
|
||||
(let ((sel-proc (addition-function command-add-selected-proc)))
|
||||
(begin
|
||||
(sel-proc pos-result result-cols)
|
||||
(loop (paint))))))
|
||||
|
||||
;;Backspace
|
||||
((= ch key-backspace)
|
||||
|
|
@ -176,6 +209,23 @@
|
|||
(set! pos-result-col (+ pos-result-col 1))
|
||||
(loop (paint)))))))
|
||||
|
||||
;;Ctrl+p -> History zurück
|
||||
((= ch 16)
|
||||
(if (= active-buffer 1)
|
||||
(begin
|
||||
(history-back)
|
||||
(loop (paint)))
|
||||
(loop(paint))))
|
||||
|
||||
;;Ctrl+n -> History vor
|
||||
((= ch 14)
|
||||
(if (= active-buffer 1)
|
||||
(begin
|
||||
(history-forward)
|
||||
(loop (paint)))
|
||||
(loop(paint))))
|
||||
|
||||
|
||||
;;Ctrl+b -> Buffer wechseln
|
||||
((= ch 2)
|
||||
(begin
|
||||
|
|
@ -267,6 +317,7 @@
|
|||
(cursor-right-pos command-win result-win comwin-h reswin-h)
|
||||
(noecho)
|
||||
(keypad bar1 #t)
|
||||
|
||||
(let ((ch (wgetch bar1)))
|
||||
(wclear bar1)
|
||||
(wclear bar2)
|
||||
|
|
@ -282,22 +333,32 @@
|
|||
;;Eingabe wurde durch Benutzer bestätigt -> Kommando ausfuehren
|
||||
(define execute-command
|
||||
(lambda ()
|
||||
(let* ((command (list-ref text-command (- (length text-command) 1)))
|
||||
(command-port (open-input-string command))
|
||||
(tmp-env (scheme-report-environment 5))
|
||||
(let* ((command (list-ref text-command (- (length text-command) 1)))
|
||||
(result (evaluate command))
|
||||
(result-string (exp->string result)))
|
||||
(begin
|
||||
(set! active-command command)
|
||||
(layout-result command result-string result result-cols)
|
||||
(set! history (append history
|
||||
(list (cons command
|
||||
(cons result result-string)))))
|
||||
(set! history-pos (length history))
|
||||
(set! text-command (append text-command (list "")))
|
||||
(scroll-command-buffer)))))
|
||||
|
||||
;;Auswerten eines Ausdrucks in Form eines String
|
||||
(define evaluate
|
||||
(lambda (exp)
|
||||
(let* ((command-port (open-input-string exp))
|
||||
(handler (lambda (condition more)
|
||||
(cons 'Error: condition)))
|
||||
(cons 'Error: condition)))
|
||||
(structure (reify-structure 'scheme-with-scsh))
|
||||
(s (load-structure structure))
|
||||
(env (rt-structure->environment structure))
|
||||
(result (with-fatal-error-handler
|
||||
handler
|
||||
(eval (read command-port) tmp-env)))
|
||||
(result-port (open-output-string)))
|
||||
(begin
|
||||
(write result result-port)
|
||||
(let ((result-string (get-output-string result-port)))
|
||||
(begin
|
||||
(layout-result command result-string result-cols)
|
||||
(set! text-command (append text-command (list "")))
|
||||
(scroll-command-buffer)))))))
|
||||
(eval (read command-port) env))))
|
||||
result)))
|
||||
|
||||
;;Nach einer Eingabe kann es sein, dass die aktive Buffer_Zeile verschoben
|
||||
;;werden muss.
|
||||
|
|
@ -311,16 +372,20 @@
|
|||
;;Der Benutzer muss sich darum kümmern, dass das Ergebnis sinnvoll
|
||||
;;dargestellt wird.
|
||||
(define layout-result
|
||||
(lambda (command result width)
|
||||
;;standard (else -> keine spezielle Darstellung vorgesehen)
|
||||
(layout-result-standard result width)))
|
||||
; (begin
|
||||
; (let ((com (if (> (string-length command) (- width 22))
|
||||
; (string-append (substring command 0 (- width 22)) "...")
|
||||
; command)))
|
||||
; (set! text-result (cons (string-append "command unknown: " com) '()))
|
||||
; (set! pos-result-col (+ 18 (string-length com)))
|
||||
; (set! pos-result 1)))))
|
||||
(lambda (command result-str result width)
|
||||
(let ((fun (addition-function command-add-layout-proc)))
|
||||
(fun result-str result width))))
|
||||
; (let loop ((pos 0))
|
||||
; (if (> pos (- (length command-additions) 1))
|
||||
; ;;standard (else -> keine spezielle Darstellung vorgesehen)
|
||||
; (layout-result-standard result-str width)
|
||||
; (let* ((el (list-ref command-additions pos))
|
||||
; (el-str (command-add-command-string el))
|
||||
; (el-layout-proc (command-add-layout-proc el)))
|
||||
; (if (equal? el-str command)
|
||||
; (el-layout-proc result-str result width)
|
||||
; (loop (+ pos 1))))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -529,6 +594,66 @@
|
|||
;;standard-Fall
|
||||
(sublist l (- pos height) height)))))
|
||||
|
||||
;; Ein Schritt zurück in der History. Im unteren Buffer wird jeweils das
|
||||
;; Ergebnis angezeigt
|
||||
(define history-back
|
||||
(lambda ()
|
||||
(if (<= history-pos 0)
|
||||
values
|
||||
(let* ((hist-entry (list-ref history (- history-pos 1)))
|
||||
(entry-com (car hist-entry))
|
||||
(entry-res (cdr hist-entry))
|
||||
(res (car entry-res))
|
||||
(res-str (cdr entry-res)))
|
||||
(begin
|
||||
(set! text-command (append
|
||||
(sublist text-command 0
|
||||
(- (length text-command) 1))
|
||||
(list entry-com)))
|
||||
(set! active-command entry-com)
|
||||
(layout-result entry-com res-str res result-cols)
|
||||
(set! history-pos (- history-pos 1)))))))
|
||||
|
||||
;;Ein Schritt nach vorne in der History. Analog zu history-back
|
||||
(define history-forward
|
||||
(lambda ()
|
||||
(if (= history-pos (- (length history) 1))
|
||||
(set! text-command (append
|
||||
(sublist text-command 0
|
||||
(- (length text-command) 1))
|
||||
(list "")))
|
||||
(if (> history-pos (- (length history) 1))
|
||||
values
|
||||
(let* ((hist-entry (list-ref history (+ history-pos 1)))
|
||||
(entry-com (car hist-entry))
|
||||
(entry-res (cdr hist-entry))
|
||||
(res (car entry-res))
|
||||
(res-str (cdr entry-res)))
|
||||
(begin
|
||||
(set! text-command (append
|
||||
(sublist text-command 0
|
||||
(- (length text-command) 1))
|
||||
(list entry-com)))
|
||||
(set! active-command entry-com)
|
||||
(layout-result entry-com res-str res result-cols)
|
||||
(set! history-pos (+ history-pos 1))))))))
|
||||
|
||||
|
||||
;;Es wird die richtige Funktion ausgewählt:
|
||||
(define addition-function
|
||||
(lambda (type)
|
||||
(let loop ((pos 0))
|
||||
(if (> pos (- (length command-additions) 1))
|
||||
(type standard-command)
|
||||
(let* ((el (list-ref command-additions pos))
|
||||
(el-str (command-add-command-string el))
|
||||
(el-proc (type el)))
|
||||
(if (equal? el-str active-command)
|
||||
el-proc
|
||||
(loop (+ pos 1))))))))
|
||||
|
||||
|
||||
|
||||
;;Teilliste
|
||||
(define sublist
|
||||
(lambda (l pos k)
|
||||
|
|
@ -542,11 +667,116 @@
|
|||
|
||||
;;Im Standardfall wird einfach als Ergebnis die Rückgabe der scsh ausgegeben.
|
||||
(define layout-result-standard
|
||||
(lambda (result width)
|
||||
(set! text-result (reverse (seperate-line result width)))))
|
||||
(lambda (result-str result width)
|
||||
(set! text-result
|
||||
(reverse (seperate-line result-str width)))))
|
||||
|
||||
(define standard-command
|
||||
(make-command-addition
|
||||
"standard"
|
||||
layout-result-standard
|
||||
values
|
||||
values))
|
||||
|
||||
|
||||
;;directory-files
|
||||
|
||||
;;speichert das working-directory zur Zeit des Aufrufs
|
||||
(define initial-working-directory (cwd))
|
||||
|
||||
;;speichert die aktuelle Anzeige
|
||||
(define printed-files '())
|
||||
|
||||
;;Darstellung, falls die Eingabe ist: "(directory-files)"
|
||||
(define layout-result-dirfiles
|
||||
(lambda (result-str result width)
|
||||
(begin
|
||||
;(set! initial-working-directory (cwd))
|
||||
(let ((printed-file-list (print-file-list result)))
|
||||
(begin
|
||||
(set! printed-files printed-file-list)
|
||||
(set! text-result
|
||||
(append
|
||||
(reverse (seperate-line
|
||||
(string-append "Directory-Content of "
|
||||
(cwd) " :") width))
|
||||
(list "<-")
|
||||
printed-file-list))
|
||||
(set! pos-result 2))))))
|
||||
|
||||
;;Eine Datei pro Zeile
|
||||
;;Falls es sich um ein Verzeichnis handelt wird "/" hinzugefügt
|
||||
(define print-file-list
|
||||
(lambda (file-list)
|
||||
(let loop ((old file-list)
|
||||
(new '()))
|
||||
(if (equal? '() old)
|
||||
new
|
||||
(let ((hd (list-ref old 0))
|
||||
(tl (cdr old)))
|
||||
(if (file-directory? hd)
|
||||
(let ((new-str (string-append hd "/")))
|
||||
(loop tl (append new (list new-str))))
|
||||
(loop tl (append new (list hd)))))))))
|
||||
|
||||
;;Auswahl->absteigen
|
||||
(define selected-dirfiles
|
||||
(lambda (ln width)
|
||||
(if (or (>= ln (+ (length printed-files) 3))
|
||||
(<= ln 1))
|
||||
values
|
||||
(if (= ln 2)
|
||||
(if (not (equal? "/" (cwd)))
|
||||
(begin
|
||||
(chdir "..")
|
||||
(let ((new-result (evaluate "(directory-files)")))
|
||||
(layout-result-dirfiles (exp->string new-result)
|
||||
new-result width)))
|
||||
values)
|
||||
(let* ((ent (list-ref printed-files (- ln 3)))
|
||||
(len (string-length ent))
|
||||
(last-char (substring ent (- len 1) len))
|
||||
(rest (substring ent 0 (- len 1))))
|
||||
(if (equal? last-char "/")
|
||||
(begin
|
||||
(chdir rest)
|
||||
(let ((new-result (evaluate "(directory-files)")))
|
||||
(layout-result-dirfiles (exp->string new-result)
|
||||
new-result width))
|
||||
values)))))))
|
||||
|
||||
;;Zurücksetzen, wenn das nächste Kommando kommt.
|
||||
(define restore-dirfiles
|
||||
(lambda ()
|
||||
(begin
|
||||
(chdir initial-working-directory)
|
||||
(set! printed-files '())
|
||||
;(set! printed-files '())
|
||||
)))
|
||||
|
||||
|
||||
|
||||
(define new-com-add (make-command-addition
|
||||
"(directory-files)"
|
||||
layout-result-dirfiles
|
||||
selected-dirfiles
|
||||
restore-dirfiles))
|
||||
(set! command-additions (cons new-com-add command-additions))
|
||||
|
||||
|
||||
;;nützliche Hilfsfunktionen:
|
||||
|
||||
;;Ein Ausdruck als String
|
||||
(define exp->string
|
||||
(lambda (exp)
|
||||
(let ((exp-port (open-output-string)))
|
||||
(begin
|
||||
(write exp exp-port)
|
||||
(get-output-string exp-port)))))
|
||||
|
||||
|
||||
|
||||
|
||||
;;Ein Statement wird in Stücke zerlegt, so dass dann jedes Stück in eine
|
||||
;;Zeile passt.
|
||||
(define seperate-line
|
||||
|
|
|
|||
Loading…
Reference in New Issue