From 0fc804b345f9654c42fc80138147a9d3cabfdda8 Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Thu, 19 May 2005 13:58:27 +0000
Subject: [PATCH] revamp code for positioning the cursor, code cleanup

---
 scheme/input-buffer.scm     | 544 +++++++++++++++++-------------------
 scheme/ncurses-packages.scm |   2 +
 2 files changed, 263 insertions(+), 283 deletions(-)

diff --git a/scheme/input-buffer.scm b/scheme/input-buffer.scm
index 40fe0ff..0967ec2 100644
--- a/scheme/input-buffer.scm
+++ b/scheme/input-buffer.scm
@@ -34,13 +34,15 @@
 ;;It is very esential, that you set keypad to true und call noecho!!!
 
 
+(define first-column 2)
+
 ;;record-type buffer
 (define-record-type buffer :buffer
   (make-buffer text
-	       pos-line
+	       pos-line			;; Cursor-Position auf text bezogen 
 	       pos-col
-	       pos-fin-ln
-	       pos-y
+	       pos-fin-ln		;; ???
+	       pos-y			;; Cursor relativ zum Fenster
 	       pos-x
 	       num-lines
 	       num-cols
@@ -67,319 +69,295 @@
 		      (pos-y . ,buffer-pos-y)
 		      (pos-x . ,buffer-pos-x))))))
 
+(define (buffer-text-current-line buffer)
+  (list-ref (buffer-text buffer)
+	    (- (buffer-pos-line buffer) 1)))
+
 ;;handle input
-(define input
-  (lambda (buffer ch)
-    (let ((text (buffer-text buffer))
-	  (pos-line (buffer-pos-line buffer))
-	  (pos-col (buffer-pos-col buffer))
-	  (pos-fin-ln (buffer-pos-fin-ln buffer))
-	  (pos-y (buffer-pos-y buffer))
-	  (pos-x (buffer-pos-x buffer))
-	  (num-lines (buffer-num-lines buffer))
-	  (num-cols (buffer-num-cols buffer))
-	  (can-write (buffer-can-write buffer))
-	  (history-pos (buffer-history-pos buffer)))
-    (begin
-      (cond
+(define (input buffer ch)
+  (cond
        
-       ;;Enter
-       ((= ch 10)
-	(begin
-	  (set! text (append text (list "")))
-	  (set! pos-line (+ pos-line 1))
-	  (set! history-pos (- (length text) 1))
-	  (set! pos-col 2)))
+   ;; enter key
+   ((= ch 10)
+    (set-buffer-text! buffer 
+		      (append (buffer-text buffer (list ""))))
+    (set-buffer-pos-line! buffer 
+			  (+ (buffer-pos-line buffer) 1))
+    (set-buffer-pos-col! buffer first-column)
+    (set-buffer-history-pos! buffer
+			     (+ (length (buffer-text buffer)) 1)))
+   ;; backspace
+   ((and (= ch key-backspace)
+	 (buffer-can-write buffer)
+	 (not (< (buffer-pos-col buffer) 3)))
+    (set-buffer-text! buffer
+		      (remove-from-command-buffer
+		       (buffer-text buffer)
+		       (buffer-pos-col buffer)))
+    (regress-buffer-cursor-column! buffer))
 
-       ;;Backspace
-       ((= ch key-backspace)
-	(if can-write
-	    (if (< pos-col 3)
-		(values)
-		(begin
-		  (set! text (remove-from-command-buffer text pos-col))
-		  (set! pos-col (- pos-col 1))))
-	    (values)))
+   ;; FIXME
+   ;; move cursor to previous line Ctrl-p, keycode 16
+;       ((= ch 16)
+;        (if (< pos-fin-ln 2)
+; 	   (values)
+; 	   (let ((length-prev-line
+; 		  (string-length
+; 		   (list-ref text (- pos-line 2)))))
+; 	     (set! can-write #f)
+; 	     (set! pos-line (- pos-line 1))
+; 	     (set! pos-col (+ length-prev-line 2)))))
 
-       ;; FIXME
-       ;; move cursor to previous line Ctrl-p, keycode 16
-       ((= ch 16)
-	(if (< pos-fin-ln 2)
- 	    (values)
- 	    (let ((length-prev-line
- 		   (string-length
- 		    (list-ref text (- pos-line 2)))))
-	      (set! can-write #f)
-	      (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)))
- 	  (if (>= pos-line last-pos)
- 	      (values)
- 	      (let ((length-next-line 
- 		     (string-length 
- 		      (list-ref text pos-line))))
- 		(begin
- 		  (set! pos-col (+ length-next-line 2))
- 		  (set! pos-line (+ pos-line 1))
- 		  (if (= pos-line last-pos)
- 		      (set! can-write #t)))))))
-
-       ((= ch key-left)
-	(if (<= pos-col 2)
-	    (values)
-	    (begin
-	      (set! pos-col (- pos-col 1)))))
-
-       ((= ch key-right)
-	(let ((line-length (string-length 
-			    (list-ref text
-				      (- pos-line 1)))))
-	  (if (>= pos-col (+ line-length 2))
-	      (values)
-	      (begin
-		(set! pos-col (+ pos-col 1))))))
+   ;; FIXME
+   ;; move cursor to next line Ctrl-n, keycode 141
+;       ((= ch 141)
+;        (let ((last-pos (length text)))
+; 	 (if (>= pos-line last-pos)
+; 	     (values)
+; 	     (let ((length-next-line 
+; 		    (string-length 
+; 		     (list-ref text pos-line))))
+; 	       (begin
+; 		 (set! pos-col (+ length-next-line 2))
+; 		 (set! pos-line (+ pos-line 1))
+; 		 (if (= pos-line last-pos)
+; 		     (set! can-write #t)))))))
 
+   ;; CursorLeft
+   ((and (= ch key-left)
+	 (> (buffer-pos-col buffer) first-column))
+    (regress-buffer-cursor-column! buffer))
+     
+   ;; CursorRight
+   ((= ch key-right)
+    (let ((line-length (string-length 
+			(buffer-text-current-line buffer))))
+      (if (< (buffer-pos-col buffer) (+ line-length first-column))
+	  (advance-buffer-cursor-column! buffer))))
        
-       ;;Ctrl+a -> Pos 1
-       ((= ch 1)
-	(begin
-	  (set! pos-col 2)))
+   ;;Ctrl+a -> Pos 1
+   ((= ch 1)
+    (set-buffer-pos-col! buffer first-column))
 
-       ;;Ctrl-e -> End
-       ((= ch 5)
-	(let ((line-length (string-length 
-			    (list-ref text (- pos-line 1)))))
-	  (begin
-	    (set! pos-col (+ line-length 2)))))
+   ;;Ctrl-e -> End
+   ((= ch 5)
+    (let ((line-length (string-length 
+			(buffer-text-current-line buffer))))
+      (set-buffer-pos-col! buffer
+			   (+ line-length first-column))))
 
-       ;;Ctrl+k -> Zeile löschen
-       ((= ch 11)
-	(if can-write
-	    (let ((text-front (sublist text 0 (- (length text) 1))))
-	      (begin
-		(set! text (append text-front '("")))
-		(set! pos-col 2)))))
+   ;; Ctrl+k -> Zeile löschen
+   ((and (= ch 11)
+	 (buffer-can-write buffer))
+    (let ((text-front (sublist (buffer-text buffer) 
+			       0 (- (length (buffer-text buffer)) 1))))
+      (set-buffer-text! buffer (append text-front '("")))
+      (set-buffer-pos-col! buffer first-column)))
 
-       ;; forward in command history -- CursorDown
-       ((= ch key-down)
-	(if can-write
-	    (begin
-	      (if (< history-pos (- (length text) 1))
-		  (set! history-pos (+ history-pos 1)))
-	      (let ((rest (sublist text 0 (- (length text) 1)))
-		    (hist (if (= history-pos (- (length text) 1))
-			      ""
-			      (list-ref text history-pos))))
-		 (set! text (append rest (list hist))))
-	      (let ((line-length (string-length 
-				  (list-ref text (- (length text) 1)))))
-		    (set! pos-col (+ line-length 2))))))
+   ;; forward in command history -- CursorDown
+   ((and (= ch key-down)
+	 (buffer-can-write buffer))
+    (if (< (buffer-history-pos buffer) 
+	   (- (length (buffer-text buffer)) 1))
+	(set-buffer-history-pos! buffer
+				 (+ (buffer-history-pos buffer) 1)))
+    (let ((rest (sublist (buffer-text buffer) 0 
+			 (- (length (buffer-text buffer)) 1)))
+	  (hist (if (= (buffer-history-pos buffer) 
+		       (- (length (buffer-text buffer)) 1))
+		    ""
+		    (list-ref (buffer-text buffer) 
+			      (buffer-history-pos buffer)))))
+      (set-buffer-text! buffer (append rest (list hist)))
+      (let ((line-length 
+	     (string-length 
+	      (list-ref (buffer-text buffer) 
+			(- (length (buffer-text buffer)) 1)))))
+	(set-buffer-pos-col! buffer (+ line-length first-column)))))
 
-       ;; back in command history -- CursorUp
-       ((= ch key-up)
-	(if can-write
-	    (begin
-	      (if (> history-pos 0)
-		  (set! history-pos (- history-pos 1)))
-	      (let ((rest (sublist text 0 (- (length text) 1)))
-		    (hist (list-ref text history-pos)))
-		(set! text (append rest (list hist))))
-	      (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 
-	(values)))
-
-      (make-buffer text pos-line  pos-col pos-fin-ln pos-y pos-x
-		   num-lines num-cols can-write history-pos)))))
+   ;; back in command history -- CursorUp
+   ((and (= ch key-up)
+	 (buffer-can-write buffer))
+    (if (> (buffer-history-pos buffer) 0)
+	(set-buffer-history-pos! (- (buffer-history-pos 1))))
+    (let ((rest (sublist (buffer-text buffer) 0 
+			 (- (length (buffer-text buffer)) 1)))
+	  (hist (list-ref (buffer-text buffer) 
+			  (buffer-history-pos buffer))))
+      (set-buffer-text! buffer
+			(append rest (list hist))))
+    (let ((line-length (string-length 
+			(list-ref (buffer-text buffer) 
+				  (- (length (buffer-text buffer)) 1)))))
+      (set-buffer-pos-col! buffer (+ line-length first-column))))
 
+   ((and (buffer-can-write buffer) (<= ch 255))
+    (append-char-to-buffer! ch buffer)
+    (advance-buffer-cursor-column! buffer))
 
+  (values)))
 
 ;;print content of the buffer into the specified window
-(define print-command-buffer
-  (lambda (win buffer)
-    (let ((text (buffer-text buffer))
-	  (pos-line (buffer-pos-line buffer))
-	  (pos-col (buffer-pos-col buffer))
-	  (pos-fin-ln (buffer-pos-fin-ln buffer))
-	  (pos-y (buffer-pos-y buffer))
-	  (pos-x (buffer-pos-x buffer))
-	  (num-lines (buffer-num-lines buffer))
-	  (num-cols (buffer-num-cols buffer))
-	  (can-write (buffer-can-write buffer))
-	  (history-pos (buffer-history-pos buffer)))
-      (let* ((l (get-right-command-lines text pos-fin-ln num-lines
-					    pos-line num-cols))
-	     (lines (car l)))
-	(begin
-	  (set! pos-fin-ln (cdr l))
-	  (let loop ((pos 1))
-	    (if (> pos num-lines)
-		(make-buffer text pos-line pos-col pos-fin-ln pos-y
-			     pos-x num-lines num-cols can-write history-pos)
-		(let ((line (list-ref lines (- pos 1))))
-		  (begin
-		    (mvwaddstr win pos 1 line)
-		    ;(wrefresh win)
-		    (loop (+ pos 1)))))))))))
-
+(define (print-command-buffer win buffer)
+  (call-with-values
+      (lambda ()
+	(get-right-command-lines buffer))
+    (lambda (lines new-pos-fin-ln)
+      (set-buffer-pos-fin-ln! buffer new-pos-fin-ln)
+      (let lp ((lines lines) (line-count 0))
+	(if (or (null? lines)
+		(> line-count (buffer-num-lines buffer)))
+	    (values)
+	    (begin
+	      (mvwaddstr win line-count 1 (car lines))
+	      (lp (cdr lines) (+ line-count 1))))))))
 
 ;;compute the visible lines
-(define get-right-command-lines
-  (lambda (text pos-fin-ln num-lines pos-line num-cols)
-    (let* ((res (all-commands-seperated text pos-line num-cols
-					pos-fin-ln ))
-	   (all-lines-seperated (car res))
-	   (num-all-lines (length all-lines-seperated)))
-      (begin
-	(set! pos-fin-ln (cdr res))
+(define (get-right-command-lines buffer)
+  (call-with-values 
+      (lambda ()
+	(all-commands-seperated buffer))
+    (lambda (all-lines-seperated new-pos-fin-ln)
+      (let ((num-all-lines (length all-lines-seperated))
+	    (num-lines (buffer-num-lines buffer))
+	    (pos-fin-ln (buffer-pos-fin-ln buffer)))
+	(set! pos-fin-ln new-pos-fin-ln)
 	(if (>= pos-fin-ln num-lines)
 	    ;;aktive Zeile ist die unterste
-	    (cons (sublist all-lines-seperated 
-			   (- pos-fin-ln num-lines) 
-			   num-lines)
-		  pos-fin-ln)
+	    (values (sublist all-lines-seperated 
+			     (- pos-fin-ln num-lines) 
+			     num-lines)
+		    pos-fin-ln)
 	    (if (<= num-all-lines num-lines)
 		;;noch keine ganze Seite im Buffer
-		(cons (prepare-lines all-lines-seperated 
-				     num-lines (- pos-fin-ln 1))
-		      pos-fin-ln)
+		(values (prepare-lines all-lines-seperated 
+				       num-lines (- pos-fin-ln 1))
+			pos-fin-ln)
 		;;scrollen auf der ersten Seite
-		(cons (sublist all-lines-seperated 0 num-lines)
-		      pos-fin-ln)))))))
-
+		(values (sublist all-lines-seperated 0 num-lines)
+			pos-fin-ln)))))))
 
 ;;seperate all statements
-(define all-commands-seperated
-  (lambda (commands pos-line num-cols pos-fin-ln)
-    (let loop ((act-pos 1)
-	       (new '()))
-      (begin
-	(if (= act-pos pos-line)
-	    (let* ((length-new (length new))
-		   (first-el-old (list-ref commands (- act-pos 1)))
-		   (seperated-act (seperate-line-com
-				   first-el-old num-cols))
-		   (length-act (length seperated-act)))
-	      (set! pos-fin-ln (+ length-new length-act))))
-	
-	(if (> act-pos (length commands))
-	    (cons (reverse new) pos-fin-ln)
-	    (let* ((first-el-old (list-ref commands (- act-pos 1)))
-		   (seperated-fst-el-old 
-		    (seperate-line-com first-el-old num-cols)))
-	      (loop (+ act-pos 1) (append seperated-fst-el-old new))))))))
+(define (all-commands-seperated buffer)
+  (let ((num-cols (buffer-num-cols buffer))
+	(pos-fin-ln (buffer-pos-fin-ln buffer))
+	(commands (buffer-text buffer)))
+    (let loop ((act-pos 1) (new '()))
+      (if (= act-pos (buffer-pos-line buffer))
+	  (let* ((length-new (length new))
+		 (first-el-old (list-ref commands (- act-pos 1)))
+		 (seperated-act (seperate-line-com
+				 first-el-old num-cols))
+		 (length-act (length seperated-act)))
+	    (set! pos-fin-ln (+ length-new length-act))))
 
+      (if (> act-pos (length commands))
+	  (values (reverse new) pos-fin-ln)
+	  (let* ((first-el-old (list-ref commands (- act-pos 1)))
+		 (seperated-fst-el-old 
+		  (seperate-line-com first-el-old num-cols)))
+	    (loop (+ act-pos 1) (append seperated-fst-el-old new)))))))
 
 ;;seperate one statement
-(define seperate-line-com
-  (lambda (line width)
-    (let loop ((new '())
-	       (old line))
-      (if (> width (string-length old))
-	  (if (= 0 (string-length old))
-	      (if (equal? new '())
-		  (add-prompts '(""))
-		  (add-prompts  new))
-	      ;new
-	      (add-prompts (append (list old) new)))
-	      ;(append (list old) new))
-	  (let ((next-line (substring old 0 width))
-		(rest-old (substring old width (string-length old))))
-	    (loop (cons next-line new) rest-old))))))
-
+(define (seperate-line-com line width)
+  (let loop ((new '())
+	     (old line))
+    (if (> width (string-length old))
+	(if (= 0 (string-length old))
+	    (if (equal? new '())
+		(add-prompts '(""))
+		(add-prompts  new))
+					;new
+	    (add-prompts (append (list old) new)))
+					;(append (list old) new))
+	(let ((next-line (substring old 0 width))
+	      (rest-old (substring old width (string-length old))))
+	  (loop (cons next-line new) rest-old)))))
 
 ;;add ">"
-(define add-prompts
-  (lambda (l)
-     (let* ((lr (reverse l))
-	    (old-first-el (list-ref lr 0))
-	    (new-first-el (string-append ">" old-first-el))
-	    (old-rest (list-tail lr 1)))
-      (let loop ((old old-rest)
-		 (new (list new-first-el)))
-	(if (> (length old) 0)
-	    (let* ((old-first-el (list-ref old 0))
-		   (new-first-el (string-append " " old-first-el)))
-	      (loop (list-tail old 1) (append new (list new-first-el))))
-	    (reverse new))))))
-
+(define (add-prompts l)
+  (let* ((lr (reverse l))
+	 (old-first-el (list-ref lr 0))
+	 (new-first-el (string-append ">" old-first-el))
+	 (old-rest (list-tail lr 1)))
+    (let loop ((old old-rest)
+	       (new (list new-first-el)))
+      (if (> (length old) 0)
+	  (let* ((old-first-el (list-ref old 0))
+		 (new-first-el (string-append " " old-first-el)))
+	    (loop (list-tail old 1) (append new (list new-first-el))))
+	  (reverse new)))))
 
 ;;Find the lines to print
-(define prepare-lines
-  (lambda (l height pos)
-    (if (< (length l) height)
-	;; Liste zu kurz -> ""s hinzufügen
-	(let loop ((tmp-list l))
-	  (if (= height (length tmp-list))
-	      tmp-list
-	      (loop (append tmp-list (list "")))))
-	;; Teilliste holen
-	(if (<  pos height)
-	    ;;pos nicht ganz unten
-	    (sublist l 0 height)
-	    ;;standard-Fall 
-	    (sublist l (- pos height) height)))))
-
-
+(define (prepare-lines l height pos)
+  (if (< (length l) height)
+      ;; Liste zu kurz -> ""s hinzufügen
+      (let loop ((tmp-list l))
+	(if (= height (length tmp-list))
+	    tmp-list
+	    (loop (append tmp-list (list "")))))
+      ;; Teilliste holen
+      (if (<  pos height)
+	  ;;pos nicht ganz unten
+	  (sublist l 0 height)
+	  ;;standard-Fall 
+	  (sublist l (- pos height) height))))
 
 ;;Cursor
 ;;Put Cursor to the right position
 (define (cursor-right-pos win buffer)
-  (let ((text (buffer-text buffer))
-	(pos-line (buffer-pos-line buffer))
-	(pos-col (buffer-pos-col buffer))
+  (let ((pos-col (buffer-pos-col buffer))
 	(pos-fin-ln (buffer-pos-fin-ln buffer))
-	(pos-y (buffer-pos-y buffer))
 	(pos-x (buffer-pos-x buffer))
 	(num-lines (buffer-num-lines buffer))
-	(num-cols (buffer-num-cols buffer))
-	(can-write (buffer-can-write buffer))
-	(history-pos (buffer-history-pos buffer)))
-    (begin
-      ;;zuerst mal y 
-      (let* ((line (list-ref text (- pos-line 1)))
-	     (offset (lines-from-fin-line num-cols pos-col line)))
-	(if (>= pos-fin-ln num-lines)
-	    ;;unterste Zeile
-	    (set! pos-y (- num-lines offset))
-	    ;;sonst
-	    (set! pos-y (- pos-fin-ln offset))))
-      (let ((posx (modulo pos-col num-cols)))
-	(if (<= posx 1)
-	    (set! pos-x (+ num-cols posx))
-	    (if (and (= posx 2)
-		     (> pos-col num-cols))
-		(set! pos-x (+ num-cols 1))
-		(set! pos-x posx)))
-	(wmove win pos-y pos-x)
-	(make-buffer text pos-line  pos-col pos-fin-ln pos-y pos-x
-		     num-lines num-cols can-write history-pos)))))
+	(num-cols (buffer-num-cols buffer)))
 
-(define lines-from-fin-line
-  (lambda (num-cols pos-col line)
-    (let* ((lines (ceiling (/ (string-length line) num-cols)))
-	   (end-pos (* lines num-cols)))
-      (if (= (string-length line) 0)
-	  0
-	  (let loop ((offset 0)
-		     (end end-pos))
-	    (if (<= (+ end 2) pos-col)
-		(- offset 1)
-		(loop (+ offset 1) (- end num-cols))))))))
+    ;; y position
+    (let* ((item-length (string-length (buffer-text-current-line buffer)))
+	   (no-wrapped-lines (quotient item-length num-cols))
+	   (first-line-offset (quotient (- pos-col first-column) num-cols))
+	   (new-y (- (+ (- pos-fin-ln no-wrapped-lines)
+			first-line-offset)
+		     1)))
+      (debug-message "num-cols "
+		     num-cols
+		     " no-wrapped-lines "
+		     no-wrapped-lines 
+		     " first-line-offset " 
+		     first-line-offset
+		     " new-y " new-y
+		     " length "
+		     item-length
+		     " pos-fin-ln "
+		     pos-fin-ln
+		     " pos-col "
+		     pos-col)
+      (set-buffer-pos-y! buffer new-y))
+
+    ;; x position
+    (let ((posx (modulo pos-col num-cols)))
+      (if (<= posx 1)
+	  (set-buffer-pos-x! buffer (+ num-cols posx))
+	  (if (and (= posx 2)
+		   (> pos-col num-cols))
+	      (set-buffer-pos-x! buffer (+ num-cols 1))
+	      (set-buffer-pos-x! buffer posx))))
+
+    (wmove win (buffer-pos-y buffer) (buffer-pos-x buffer))))
 		 
+(define (advance-buffer-cursor-column! buffer)
+  (set-buffer-pos-col! buffer
+		       (+ 1 (buffer-pos-col buffer))))
+
+(define (regress-buffer-cursor-column! buffer)
+  (set-buffer-pos-col! buffer
+		       (- (buffer-pos-col buffer) 1)))
+
 ;; add one character to the buffer
-(define (add-to-command-buffer ch text pos-col)
-  (let* ((last-pos (- (length text) 1))
+(define (append-char-to-buffer! ch buffer)
+  (let* ((text (buffer-text buffer))
+	 (pos-col (buffer-pos-col buffer))
+	 (last-pos (- (length text) 1))
 	 (old-last-el (list-ref text last-pos))
 	 (old-rest (sublist text 0 last-pos))
 	 (before-ch (substring old-last-el 0 
@@ -390,7 +368,8 @@
 	 (new-last-el (string-append  before-ch
 				      (string (ascii->char ch))
 				      after-ch)))
-    (append old-rest (list new-last-el))))
+    (set-buffer-text! buffer
+		      (append old-rest (list new-last-el)))))
 
 ;;Remove one character from the line (backspace)
 (define remove-from-command-buffer
@@ -419,11 +398,10 @@
 
 ;;Create a fitting buffer for a window with box and a welcome-Message
 ;;If the message is "", the buffer starts in line one
-(define make-buffer-welcome
-  (lambda (height width welcome-message)
-    (if (equal? "" welcome-message)
-	(make-buffer (list "") 1 2 1 1 2 (- height 2) (- width 3) #t 1)
-	(make-buffer (list welcome-message "") 2 2 2 2 2 
-		     (- height 2) (- width 3) #t 1) )))
+(define (make-buffer-welcome height width welcome-message)
+  (if (string=? "" welcome-message)
+      (make-buffer (list "") 1 2 1 1 2 (- height 2) (- width 3) #t 1)
+      (make-buffer (list welcome-message "") 2 2 2 2 2 
+		   (- height 2) (- width 3) #t 1) ))
 
 
diff --git a/scheme/ncurses-packages.scm b/scheme/ncurses-packages.scm
index e0434d8..cb925b3 100644
--- a/scheme/ncurses-packages.scm
+++ b/scheme/ncurses-packages.scm
@@ -368,10 +368,12 @@
 
 (define-structure ncurses ncurses-interface    
   (open scheme-with-scsh
+	srfi-1
 	external-calls
 	define-record-types
 	conditions
 	signals 
+	tty-debug
 	handle)
   (files ncurses
 	 ncurses-constants