temporary version

scheme/nuit-engine.scm

@@ -37,13 +37,12 @@
 ;;----------------------------
 
 ;;Text
-(define text-result (list "Start entering commands."
+(define text-result (list "Start entering commands."))
-			  "Ctrl-h for help."))
 
 ;;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)))
+   (let* ((command (list-ref text-command (- (length text-command) 1)))
-	   (command-port (open-input-string command))
+	  (result (evaluate command))
-	   (tmp-env (scheme-report-environment 5))
+	  (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)))
+		    (eval (read command-port) env))))
-	   (result-port (open-output-string)))
+      result)))
-      (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)))))))
 
 ;;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)
+  (lambda (command result-str result width)
-    ;;standard (else -> keine spezielle Darstellung vorgesehen)
+    (let ((fun (addition-function command-add-layout-proc)))
-    (layout-result-standard result width)))
+      (fun result-str result width))))
-;    (begin
+;    (let loop ((pos 0))
-;      (let ((com (if (> (string-length command) (- width 22)) 
+;      (if (> pos (- (length command-additions) 1))
-;		     (string-append (substring command 0 (- width 22)) "...")
+;	  ;;standard (else -> keine spezielle Darstellung vorgesehen)
-;		     command)))
+;	  (layout-result-standard result-str width)
-;	(set! text-result (cons (string-append "command unknown: " com) '()))
+;	  (let* ((el (list-ref command-additions pos))
-;	(set! pos-result-col (+ 18 (string-length com)))
+;		 (el-str (command-add-command-string el))
-;	(set! pos-result 1)))))
+;		 (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)
+  (lambda (result-str result width)
-    (set! text-result (reverse (seperate-line 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