added debug-output (using tty-debug), code cleanup, shift window

refreshing to application code

scheme/input-buffer.scm

@@ -35,7 +35,7 @@
 
 
 ;;record-type buffer
-(define-record-type buffer buffer
+(define-record-type buffer :buffer
   (make-buffer text
 	       pos-line
 	       pos-col
@@ -57,6 +57,16 @@
   (can-write buffer-can-write set-buffer-can-write!)
   (history-pos buffer-history-pos set-buffer-history-pos!))
 
+(define-record-discloser :buffer
+  (lambda (rec)
+    `(buffer ,@(map (lambda (p)
+		      (cons (car p) ((cdr p) rec)))
+		    `((pos-line . ,buffer-pos-line)
+		      (pos-col . ,buffer-pos-col)
+		      (pos-fin-ln . ,buffer-pos-fin-ln)
+		      (pos-y . ,buffer-pos-y)
+		      (pos-x . ,buffer-pos-x))))))
+
 ;;handle input
 (define input
   (lambda (buffer ch)
@@ -91,9 +101,10 @@
 		  (set! pos-col (- pos-col 1))))
 	    (values)))
 
+       ;; FIXME
        ;; move cursor to previous line Ctrl-p, keycode 16
        ((= ch 16)
- 	(if (< pos-fin-ln 2)
+	(if (< pos-fin-ln 2)
  	    (values)
  	    (let ((length-prev-line
  		   (string-length
@@ -102,6 +113,7 @@
 	      (set! pos-line (- pos-line 1))
 	      (set! pos-col (+ length-prev-line 2)))))
 
+       ;; FIXME
        ;; move cursor to next line Ctrl-n, keycode 141
         ((= ch 141)
  	(let ((last-pos (length text)))
@@ -179,18 +191,14 @@
 	      (let ((line-length (string-length 
 				  (list-ref text (- (length text) 1)))))
 		(set! pos-col (+ line-length 2))))))
-		    
+
-		  
+       ((and can-write (<= ch 255))
-       
+	(set! text (add-to-command-buffer ch text pos-col))
+	(set! pos-col (+ pos-col 1)))
+
        (else 
-	(if (<= ch 255)
+	(values)))
-	    (if can-write
+
-		(begin
-		  (begin
-		    (set! text (add-to-command-buffer ch text pos-col))
-		    (set! pos-col (+ pos-col 1)))
-		  (values)))
-	    (values))))
       (make-buffer text pos-line  pos-col pos-fin-ln pos-y pos-x
 		   num-lines num-cols can-write history-pos)))))
 
@@ -221,7 +229,7 @@
 		(let ((line (list-ref lines (- pos 1))))
 		  (begin
 		    (mvwaddstr win pos 1 line)
-		    (wrefresh win)
+		    ;(wrefresh win)
 		    (loop (+ pos 1)))))))))))
 
 
@@ -326,18 +334,17 @@
 
 ;;Cursor
 ;;Put Cursor to the right position
-(define cursor-right-pos
+(define (cursor-right-pos win buffer)
-  (lambda (win buffer)
+  (let ((text (buffer-text buffer))
-    (let ((text (buffer-text buffer))
+	(pos-line (buffer-pos-line buffer))
-	  (pos-line (buffer-pos-line buffer))
+	(pos-col (buffer-pos-col buffer))
-	  (pos-col (buffer-pos-col buffer))
+	(pos-fin-ln (buffer-pos-fin-ln buffer))
-	  (pos-fin-ln (buffer-pos-fin-ln buffer))
+	(pos-y (buffer-pos-y buffer))
-	  (pos-y (buffer-pos-y buffer))
+	(pos-x (buffer-pos-x buffer))
-	  (pos-x (buffer-pos-x buffer))
+	(num-lines (buffer-num-lines buffer))
-	  (num-lines (buffer-num-lines buffer))
+	(num-cols (buffer-num-cols buffer))
-	  (num-cols (buffer-num-cols buffer))
+	(can-write (buffer-can-write buffer))
-	  (can-write (buffer-can-write buffer))
+	(history-pos (buffer-history-pos buffer)))
-	  (history-pos (buffer-history-pos buffer)))
     (begin
       ;;zuerst mal y 
       (let* ((line (list-ref text (- pos-line 1)))
@@ -355,9 +362,8 @@
 		(set! pos-x (+ num-cols 1))
 		(set! pos-x posx)))
 	(wmove win pos-y pos-x)
-	(wrefresh win)
 	(make-buffer text pos-line  pos-col pos-fin-ln pos-y pos-x
-		     num-lines num-cols can-write history-pos))))))
+		     num-lines num-cols can-write history-pos)))))
 
 (define lines-from-fin-line
   (lambda (num-cols pos-col line)
@@ -371,26 +377,20 @@
 		(- offset 1)
 		(loop (+ offset 1) (- end num-cols))))))))
 		 
-
+;; add one character to the buffer
-	       
+(define (add-to-command-buffer ch text pos-col)
-
+  (let* ((last-pos (- (length text) 1))
-
+	 (old-last-el (list-ref text last-pos))
-;;Add one character to the buffer
+	 (old-rest (sublist text 0 last-pos))
-(define add-to-command-buffer
+	 (before-ch (substring old-last-el 0 
-  (lambda (ch text pos-col)
+			       (max 0 (- pos-col 2))))
-    (let* ((last-pos (- (length text) 1))
+	 (after-ch (substring old-last-el 
-	   (old-last-el (list-ref text last-pos))
+			      (max 0 (- pos-col 2))
-	   (old-rest (sublist text 0 last-pos))
+			      (string-length old-last-el)))
-	   (before-ch (substring old-last-el 0 
+	 (new-last-el (string-append  before-ch
-				 (max 0 (- pos-col 2))))
+				      (string (ascii->char ch))
-	   (after-ch (substring old-last-el 
+				      after-ch)))
-				(max 0 (- pos-col 2))
+    (append old-rest (list new-last-el))))
-				(string-length old-last-el)))
-	   (new-last-el (string-append  before-ch
-					(string (ascii->char ch))
-					after-ch)))
-      (append old-rest (list new-last-el)))))
-
 
 ;;Remove one character from the line (backspace)
 (define remove-from-command-buffer
@@ -412,11 +412,10 @@
 			    (string-append  before-ch after-ch))))
       (append old-rest (list new-last-el)))))
 
-(define sublist
+(define (sublist l pos k)
-  (lambda (l pos k)
+  (let ((tmp (list-tail l pos)))
-    (let ((tmp (list-tail l pos)))
+    (reverse (list-tail (reverse tmp) 
-      (reverse (list-tail (reverse tmp) 
+			(- (length tmp) k)))))
-			  (- (length tmp) k))))))
 
 ;;Create a fitting buffer for a window with box and a welcome-Message
 ;;If the message is "", the buffer starts in line one

scheme/ncurses-packages.scm

@@ -340,7 +340,6 @@
           key-event
 
 
-	  buffer
 	  buffer-text
 	  set-buffer-text!
 	  buffer-pos-line