From 9e9653e404fc683b527ccc9ee687c1aacf815095 Mon Sep 17 00:00:00 2001 From: demattia Date: Mon, 20 Sep 2004 08:09:54 +0000 Subject: [PATCH] temporary version --- scheme/nuit-engine.scm | 292 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 261 insertions(+), 31 deletions(-) diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index e0f5353..a2e7617 100644 --- a/scheme/nuit-engine.scm +++ b/scheme/nuit-engine.scm @@ -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