From 29ff444f3b568635a2fbcbe7103627fdc73d6c70 Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Tue, 27 Sep 2005 16:18:04 +0000
Subject: [PATCH] added new files / removed a few (actually, that doesn't seem
 to work with the darcs2cvs-sync.scm)

---
 scheme/browse-directory-list.scm | 262 ------------------------
 scheme/browse-list.scm           | 339 -------------------------------
 scheme/eval-environment.scm      |  33 +++
 scheme/find.scm                  |  93 ---------
 scheme/scheme-commands.scm       |  27 +++
 scheme/select-line.scm           |  77 +++++++
 scheme/utils.scm                 |  15 ++
 7 files changed, 152 insertions(+), 694 deletions(-)
 delete mode 100644 scheme/browse-directory-list.scm
 delete mode 100644 scheme/browse-list.scm
 create mode 100644 scheme/eval-environment.scm
 delete mode 100644 scheme/find.scm
 create mode 100644 scheme/scheme-commands.scm
 create mode 100644 scheme/select-line.scm
 create mode 100644 scheme/utils.scm

diff --git a/scheme/browse-directory-list.scm b/scheme/browse-directory-list.scm
deleted file mode 100644
index 546185f..0000000
--- a/scheme/browse-directory-list.scm
+++ /dev/null
@@ -1,262 +0,0 @@
-(define key-m 109)
-(define key-u 117)
-(define key-return 10)
-
-(define (add-marks-to-special-file file-name fs-object)
-  (let ((info (fs-object-info fs-object)))
-    (cond
-     ((not info)
-      (string-append " " file-name ": error during file-info!"))
-     ((file-info-directory? info)
-      (string-append " " file-name "/"))
-     ((file-info-executable? info)
-      (string-append "*" file-name))
-     ((file-info-symlink? info)
-      (string-append "@" file-name))
-     (else
-      (string-append " " file-name)))))
-
-(define (have-permission? mode perm-mask)
-  (not (zero? (bitwise-and mode perm-mask))))
-
-(define (format-permissions mode)
-  (apply string-append
-	 (map (lambda (mask.symbol)
-		(if (have-permission? mode (car mask.symbol))
-		    (cdr mask.symbol)
-		    "-"))
-	      '((#o0400 . "r")   ;; owner read
-		(#o0200 . "w")   ;; owner write
-		(#o0100 . "x")   ;; owner exec
-		(#o0040 . "r")   ;; group read
-		(#o0020 . "w")   ;; group write
-		(#o0010 . "x")   ;; group exec
-		(#o0004 . "r")   ;; others read
-		(#o0002 . "w")   ;; others write
-		(#o0001 . "x")))))   ;; others exec
-
-(define (digits-left-of-comma-as-string float)
-  (string-drop-right 
-   (number->string (truncate float)) 1))
-
-(define (format-size/unit float unit)
-  (string-append (digits-left-of-comma-as-string float) " " unit))
-
-(define (format-size bytes)
-  (let* ((kbyte 1024.0)
-	 (mbyte (* 1024 kbyte))
-	 (gbyte (* 1024 mbyte)))
-    (cond
-     ((>= bytes gbyte)
-      (format-size/unit (/ bytes gbyte) "GB"))
-     ((>= bytes mbyte)
-      (format-size/unit (/ bytes mbyte) "MB"))
-     ((>= bytes kbyte)
-      (format-size/unit (/ bytes kbyte) "KB"))
-     (else
-      (number->string bytes)))))
-
-(define (format-user/group fi)
-  (fill-up-string 17
-   (string-append
-    (cut-to-size 8 (->username (file-info:uid fi)))
-    ":"
-    (cut-to-size 8 (group-info:name
-		    (group-info (file-info:gid fi)))))))
-
-;; leave one line for the heading
-(define (calculate-number-of-lines result-buffer)
-  (- (result-buffer-num-lines result-buffer)
-     1))
-
-(define (layout-fsobject parent-dir-len fsobject num-cols)
-  (let ((file-name (combine-path (string-drop
-                                  (fs-object-path fsobject)
-                                  parent-dir-len)                    
-                                 (fs-object-name fsobject)))
-	(fi (fs-object-info fsobject)))
-    (cut-to-size num-cols
-     (string-append
-      (fill-up-string 
-       30 (add-marks-to-special-file file-name fsobject))
-      " "
-      (fill-up-string
-       7 (format-size (file-info:size fi)))
-      " "
-      (format-user/group fi)
-      " "
-      (format-permissions 
-       (file-info:mode fi))))))
-
-(define (make-file-select-list fsobjects parent-dir num-lines num-cols)
-  (let ((parent-dir-len (string-length parent-dir)))
-    (make-select-list
-     (cons (make-unmarked-element 'parent-dir #f " ..")
-           (map (lambda (fs-object)
-                  (make-unmarked-element 
-                   fs-object #t (layout-fsobject parent-dir-len 
-						 fs-object num-cols)))
-                fsobjects))
-     num-lines)))
-
-;;; lacks some coolness
-(define (abbrev-path path length)
-  (if (< (string-length path) length)
-      path
-      (string-copy path 
-		   (- (string-length path) length))))
-
-(define header-line-path
-  "Paths relative to ")
-
-(define (make-header-line wdir width)
-  (string-append 
-   header-line-path
-   (if wdir
-       (abbrev-path 
-	wdir (- width (string-length header-line-path)))
-       "<unknown>")))
-
-(define (paint-browser select-list wdir win buffer have-focus?)
-  (wattron win (A-BOLD))
-  (mvwaddstr win 0 0
-	     (make-header-line 
-	      wdir (result-buffer-num-cols buffer)))
-  (wattrset win (A-NORMAL))
-  (paint-selection-list-at select-list 1 2 win
-			   buffer have-focus?))
-
-(define (find-common-parent paths)
-  (if (null? paths)
-      ""
-      (let lp ((paths (cdr paths))
-               (common (car paths))
-               (common-len (string-length (car paths))))
-        (if (null? paths)
-            common
-            (let ((prefix-len (string-prefix-length common (car paths))))
-              (cond
-               ((= 0 prefix-len) (error "no prefix??" common (car paths)))
-               ((= 1 prefix-len) "/") ; search ends here
-               ((= prefix-len common-len) ; short cut
-                (lp (cdr paths)
-                    common
-                    common-len))
-               (else
-                (lp (cdr paths)
-                    (substring common
-                               0
-                               prefix-len)
-                    prefix-len))))))))
-
-(define (make-browser-for-dir dir buffer)
-  (with-cwd dir
-    (make-fsobjects-viewer (directory-files)
-                           buffer
-                           (cwd))))
-  
-(define (make-fsobjects-viewer fs-objects buffer . maybe-parent)
-  (let-optionals maybe-parent
-      ((working-dir (find-common-parent
-                     (map fs-object-path fs-objects))))
-    (let ((fs-objects fs-objects)
-          (buffer buffer)
-          (select-list
-           (make-file-select-list 
-	    fs-objects working-dir
-	    ;; we need one line for the header
-	    (- (result-buffer-num-lines buffer) 1)
-	    (result-buffer-num-cols buffer))))
-
-      (define (handle-return-key self selected-entry num-lines)
-	(cond
-	 ((eq? selected-entry 'parent-dir)
-	  (let* ((maybe-parent (file-name-directory working-dir))
-		 (parent (if (string=? maybe-parent "") "/" maybe-parent)))
-	    (make-browser-for-dir parent buffer)))
-	 (else
-	  (let ((fi (fs-object-info selected-entry)))
-	    (if (and fi (file-info-directory? fi))
-		(with-errno-handler 
-		 ((errno packet) 
-		  (else
-		   (display packet)
-		   (newline)
-		   self))
-		 (make-browser-for-dir (fs-object-complete-path selected-entry)
-				       buffer))
-		self)))))
-
-      (define (handle-key-press self key)
-	(cond
-	 ((= key key-return)
-	  (handle-return-key
-	   self (select-list-selected-entry select-list)
-	   (calculate-number-of-lines buffer)))
-	 (else
-	  (set! select-list
-		(select-list-handle-key-press select-list key))
-	  self)))
-
-      (define (prepare-selection-for-scheme-mode file-names)
-	(string-append "'" (write-to-string file-names)))
-
-      ;; FIXME: quote file names containing space etc
-      (define (prepare-selection-for-command-mode file-names)
-	(string-join file-names))
-
-      (define (get-selection-as-text self for-scheme-mode? focus-object-table)
-	(let* ((marked (select-list-get-marked select-list))
-	       (file-names
-		(map fs-object-complete-path
-		     (if (null? marked)
-			 (list (select-list-selected-entry select-list))
-			 marked))))
-	  ((if for-scheme-mode?
-	       prepare-selection-for-scheme-mode
-	       prepare-selection-for-command-mode)
-	   file-names)))
-
-      (define (get-selection-as-ref self focus-object-table)
-	(let ((marked (select-list-get-marked select-list))
-	      (make-reference (lambda (obj)
-				(make-focus-object-reference 
-				 focus-object-table obj))))
-	  (if (null? marked)
-	      (write-to-string 
-	       (make-reference (select-list-selected-entry select-list)))
-	      (string-append
-	       "(list " 
-	       (string-join (map write-to-string (map make-reference marked)))
-	       ")"))))
-
-      (lambda (message)
-	(cond
-	 ((eq? message 'paint)
-	  (lambda (self . args)
-	    (apply paint-browser
-		   (append (list select-list working-dir) args))))
-
-	 ((eq? message 'key-press)
-	  (lambda (self key control-x-pressed?)
-	    (handle-key-press self key)))
-
-	 ((eq? message 'get-selection-as-text)
-	  get-selection-as-text)
-
-	 ((eq? message 'get-selection-as-ref)
-	  get-selection-as-ref)
-       
-	 (else
-	  (error "fsobjects-viewer unknown message" message)))))))
-
-(define (list-of-fs-objects? thing)
-  (and (proper-list? thing)
-       (every fs-object? thing)))
-
-(register-plugin! 
- (make-view-plugin make-fsobjects-viewer
-		   (lambda (thing)
-		     (or (fs-object? thing)
-			 (list-of-fs-objects? thing)))))
-			 
diff --git a/scheme/browse-list.scm b/scheme/browse-list.scm
deleted file mode 100644
index 35a6704..0000000
--- a/scheme/browse-list.scm
+++ /dev/null
@@ -1,339 +0,0 @@
-;;This addition provides the capability of displaying a list.
-;;There is only one list-item per line - if the item is too long for one
-;;single line it's symbolic representation is seperated into more
-;;than one lines.
-;;The user can scroll up and down in the list and he can select the items
-;;and later paste this newly-created list into the upper buffer.
-
-
-;;Result-Object-Data-Type
-(define-record-type browse-list-res-obj browse-list-res-obj
-  (make-browse-list-res-obj pos-y
-			    pos-x
-			    line
-			    col-in-line
-			    list
-			    result-text
-			    width
-			    marked-items
-			    marked-pos
-			    c-x-pressed)
-  browse-list-res-obj?
-  (pos-y browse-list-res-obj-pos-y)
-  (pos-x browse-list-res-obj-pos-x)
-  (line browse-list-res-obj-line)
-  (col-in-line browse-list-res-obj-col-in-line)
-  (list browse-list-res-obj-file-list)
-  (result-text browse-list-res-obj-result-text)
-  (width browse-list-res-obj-width)
-  (marked-items browse-list-res-obj-marked-items)
-  (marked-pos browse-list-res-obj-marked-pos)
-  (c-x-pressed browse-list-res-obj-c-x-pressed))
-
-
-;;The layout-function
-;;All lines are seperated
-(define layout-result-browse-list
-  (lambda (lst width)
-    (let loop ((pos-list 0)
-	       (buffer '()))
-      (if (= pos-list (length lst))
-	  buffer
-	  (loop (+ pos-list 1)
-		(append buffer 
-			(seperated-line (list-ref lst pos-list) width)))))))
-
-;;seperate one line -> return a list of the single lines
-(define seperated-line
-  (lambda (el width)
-    (let loop ((old el)
-	       (new '()))
-      (if (<= (string-length old) 0)
-	  new
-	  (if (>= (string-length old) width)
-	      (let* ((old-cut (substring old width (string-length old)))
-		     (new-app (string-append " " (substring old 0 width))))
-		(loop old-cut (append new (list new-app))))
-	      (append new (list (string-append " " old))))))))
-
-;;compute where the Cursor has to be put.
-;;The cursor is always located in the last line of one item of the list
-(define compute-pos-y
-  (lambda (pos lst width)
-    (let* ((before-pos (sublist lst 0 pos))
-	   (seperated-before (layout-result-browse-list before-pos width))
-	   (pos-before (length seperated-before)))
-      pos-before)))
-	  
-;;Find out which lines of the buffer are to highlight.
-;;Only those lines are highlighted, which contain the active item.
-(define get-highlighted-browse-list
-  (lambda (line lst pos-y width)
-    (let* ((act-line (list-ref lst (- line 1)))
-	   (seperated (seperated-line act-line width))
-	   (length-seperated (length seperated))
-	   (first-pos (- pos-y length-seperated)))
-      (let loop ((count 1)
-		 (res '()))
-	(if (> count length-seperated)
-	    res
-	    (loop (+ count 1)
-		  (append res (list (+ count first-pos)))))))))
-
-;;find out which lines are to be marked. Lines are marked if they have 
-;;recently been selected
-(define get-marked-pos-browse
-  (lambda (marked lst width)
-    (let loop ((m marked)
-	       (new '()))
-      (if (null? m)
-	  new
-	  (let* ((pos (car m)))
-	    (loop (cdr m) 
-		  (append (get-marked-browse-list pos lst width)
-			new )))))))
-
-(define get-marked-browse-list
-  (lambda (pos lst width)
-    (let* ((act-line (list-ref lst (- pos 1)))
-	   (seperated (seperated-line act-line width))
-	   (length-seperated (length seperated))
-	   (before-pos (sublist lst 0 pos))
-	   (seperated-before (layout-result-browse-list before-pos width))
-	   (length-before (- (length seperated-before) length-seperated)))
-      (let loop ((res '())
-		 (count 1))
-	(if (> count length-seperated)
-	    res
-	    (loop (cons (+ length-before count) res)
-		  (+ count 1)))))))
-
-
-;;Receiving-Function, that answers to incomming messages and changes state 
-;;of the passed "browse-list-res-obj"
-(define browse-list-receiver
-  (lambda (message)
-    (cond 
-     ((next-command-message? message)
-      (let* ((command (next-command-string message))
-	     (parameters (next-command-message-parameters message))
-	     (result #f)
-	     (width (next-command-message-width message)))
-	(if (< (length parameters) 1)
-	    (begin
-	      (set! result (list "forgot parameter?"))
-	      (let* ((text
-		      (layout-result-standard "forgot parameters?" 
-					      result width))
-		     (browse-obj
-		      (make-browse-list-res-obj 1 1 1 1 result text  
-						    width '() '() #f)))
-		browse-obj))
-
-	    (let ((lst (list-ref parameters 0)))
-	      (if (not (null? lst))
-		  (let*
-		      ((result-string (map exp->string lst))
-		       (text 
-			(layout-result-browse-list result-string
-						   (- width 1)))
-		       (sep-line-1 (seperated-line 
-				    (exp->string (list-ref lst 0)) width))
-		       (pos-y (length sep-line-1))
-		       (browse-obj 
-			(make-browse-list-res-obj pos-y 1 1 1 lst text width
-						  '() '() #f)))
-		    browse-obj)
-		  (let 
-		      ((browse-obj 
-			(make-browse-list-res-obj 1 1 1 1 '("") '("") width
-						  '() '() #f)))
-		    browse-obj))))))
-
-     ((print-message? message)
-      (let* ((model (message-result-object message))
-	     (pos-y (browse-list-res-obj-pos-y model))
-	     (pos-x (browse-list-res-obj-pos-x model))
-	     (text (browse-list-res-obj-result-text model))
-	     (line (browse-list-res-obj-line model))
-	     (lst (map exp->string (browse-list-res-obj-file-list model)))
-	     (width (browse-list-res-obj-width model))
-	     (marked (browse-list-res-obj-marked-items model))
-	     (marked-pos (browse-list-res-obj-marked-pos model))
-	     (real-marked-pos (get-marked-pos-browse
-			       marked-pos 
-			       lst
-			       width))
-	     (highlighted (get-highlighted-browse-list line lst pos-y width)))
-	(make-print-object pos-y pos-x text highlighted real-marked-pos)))
-
-     ((key-pressed-message? message)
-      (let* ((model (message-result-object message))
-	     (key (key-pressed-message-key message))
-	     (c-x-pressed (browse-list-res-obj-c-x-pressed model)))
-
-
-	(if c-x-pressed
-	    
-	    (cond
-	     ;;Ctrl+x s ->selection
-	     ((= key 115)
-	      (let* ((marked-items (browse-list-res-obj-marked-items model))
-		     (actual-pos (browse-list-res-obj-line model))
-		     (all-items (browse-list-res-obj-file-list model)))
-		(if (< actual-pos 1)
-		    model
-		    (let* ((actual-item (list-ref all-items (- actual-pos 1))))
-		      (begin
-			(if (member actual-item marked-items)
-			    model
-			    (let* 
-				((new-marked-items (append marked-items
-							   (list actual-item)))
-				 (new-marked-pos (append
-						  (list actual-pos)
-						  (browse-list-res-obj-marked-pos
-						   model)))
-				 (new-model (make-browse-list-res-obj
-					     (browse-list-res-obj-pos-y model)
-					     (browse-list-res-obj-pos-x model)
-					     (browse-list-res-obj-line model)
-					     (browse-list-res-obj-col-in-line
-					      model)
-					     (browse-list-res-obj-file-list 
-					      model)
-					     (browse-list-res-obj-result-text 
-					      model)
-					     (browse-list-res-obj-width model)
-					     new-marked-items
-					     new-marked-pos
-					     #f)))
-			      new-model)))))))
-	     
-	     
-	     ;;Ctrl+x u -> unselect
-	     ((= key 117)
-	      (let* ((marked-items (browse-list-res-obj-marked-items model))
-		     (marked-pos (browse-list-res-obj-marked-pos model))
-		     (actual-pos (browse-list-res-obj-line model))
-		     (all-items (browse-list-res-obj-file-list model)))
-		(if (< actual-pos 1)
-		    model
-		    (let* ((actual-item (list-ref all-items (- actual-pos 1)))
-			   (rest (member actual-item marked-items))
-			   (rest-pos (member actual-pos marked-pos)))
-		      (if (not rest)
-			  model
-			  (let* ((after-item (length rest))
-				 (after-marked (length rest-pos))
-				 (all-items (length marked-items))
-				 (all-marked (length marked-pos))
-				 (before-item (sublist marked-items
-						       0 
-						       (- all-items
-							  after-item )))
-				 (before-marked (sublist marked-pos
-							 0 
-							 (- all-marked
-							    after-marked)))
-				 (new-marked-items (append before-item
-							   (list-tail rest 1)))
-				 (new-marked-pos (append before-marked
-							 (list-tail rest-pos 1)))
-				 (new-model (make-browse-list-res-obj
-					     (browse-list-res-obj-pos-y model)
-					     (browse-list-res-obj-pos-x model)
-					     (browse-list-res-obj-line model)
-					     (browse-list-res-obj-col-in-line
-					      model)
-					     (browse-list-res-obj-file-list 
-					      model)
-					     (browse-list-res-obj-result-text 
-					      model)
-					     (browse-list-res-obj-width model)
-					     new-marked-items
-					     new-marked-pos
-					     #f)))
-			    new-model))))))
-	     
-	     (else
-	      (make-browse-list-res-obj
-	       (browse-list-res-obj-pos-y model)
-	       (browse-list-res-obj-pos-x model)
-	       (browse-list-res-obj-line model)
-	       (browse-list-res-obj-col-in-line
-		model)
-	       (browse-list-res-obj-file-list 
-		model)
-	       (browse-list-res-obj-result-text 
-		model)
-	       (browse-list-res-obj-width model)
-	       (browse-list-res-obj-marked-items model)
-	       (browse-list-res-obj-marked-pos model)
-	       #f)))
-    
-	    (cond
-
-	     ;;ctrl+x
-	     ((= key 24)
-	      (make-browse-list-res-obj
-	       (browse-list-res-obj-pos-y model)
-	       (browse-list-res-obj-pos-x model)
-	       (browse-list-res-obj-line model)
-	       (browse-list-res-obj-col-in-line
-		model)
-	       (browse-list-res-obj-file-list 
-		model)
-	       (browse-list-res-obj-result-text 
-		model)
-	       (browse-list-res-obj-width model)
-	       (browse-list-res-obj-marked-items model)
-	       (browse-list-res-obj-marked-pos model)
-	       #t))
-
-	     
-	     ((= key key-up)
-	      (let ((line (browse-list-res-obj-line model))
-		    (lst (map exp->string (browse-list-res-obj-file-list model)))
-		    (width (browse-list-res-obj-width model)))
-		(if (<= line 1)
-		    model
-		    (let* ((new-line (- line 1))
-			   (pos-y (compute-pos-y new-line lst width)))
-		      (make-browse-list-res-obj 
-		       pos-y 1 new-line 1
-		       (browse-list-res-obj-file-list model)
-		       (browse-list-res-obj-result-text model)
-		       (browse-list-res-obj-width model)
-		       (browse-list-res-obj-marked-items model)
-		       (browse-list-res-obj-marked-pos model)
-		       #f)))))
-	     
-	     ((= key key-down)
-	      (let ((line (browse-list-res-obj-line model))
-		    (lst (map exp->string (browse-list-res-obj-file-list model)))
-		    (width (browse-list-res-obj-width model)))
-		(if (>= line (length lst))
-		    model
-		    (let* ((new-line (+ line 1))
-			   (pos-y (compute-pos-y new-line lst width)))
-		      (make-browse-list-res-obj 
-		       pos-y 1 new-line 1
-		       (browse-list-res-obj-file-list model)
-		       (browse-list-res-obj-result-text model)
-		       (browse-list-res-obj-width model)
-		       (browse-list-res-obj-marked-items model)
-		       (browse-list-res-obj-marked-pos model)
-		       #f)))))
-	     
-	     (else model)))))
-	    
-	    
-     ((selection-message? message)
-      (let* ((model (message-result-object message))
-	     (marked-items (browse-list-res-obj-marked-items model)))
-	(string-append "'" (exp->string marked-items))))
-
-)))
-
-;(register-plugin! (make-plugin "browse-list" browse-list-receiver))
diff --git a/scheme/eval-environment.scm b/scheme/eval-environment.scm
new file mode 100644
index 0000000..b63aaf9
--- /dev/null
+++ b/scheme/eval-environment.scm
@@ -0,0 +1,33 @@
+(define (init-evaluation-environment package)
+  (let ((structure (reify-structure package)))
+    (load-structure structure)
+    (rt-structure->environment structure)))
+
+(define *evaluation-environment*)
+
+(define (set-evaluation-package! package-name)
+  (set! *evaluation-environment*
+        (init-evaluation-environment package-name)))
+
+(define (evaluation-environment)
+  *evaluation-environment*)
+
+(define (read-sexp-from-string string)
+  (let ((string-port (open-input-string string)))
+    (read string-port)))
+
+(define (eval-string str)
+  (with-fatal-and-capturing-error-handler
+   (lambda (condition raw-continuation continuation decline)
+     raw-continuation)
+   (lambda ()
+     (eval (read-sexp-from-string str)
+           (evaluation-environment)))))
+
+(define (eval-s-expr s-expr)
+  (with-fatal-and-capturing-error-handler
+   (lambda (condition raw-continuation continuation decline)
+     raw-continuation)
+   (lambda ()
+     (eval s-expr (evaluation-environment)))))
+
diff --git a/scheme/find.scm b/scheme/find.scm
deleted file mode 100644
index a4383c5..0000000
--- a/scheme/find.scm
+++ /dev/null
@@ -1,93 +0,0 @@
-;;find
-;;This extension uses the unix-tool "find". You can only use this command in
-;;if "find" is present in your environment.
-;;This addition uses the capabilities defined in browse-directory-list
-
-
-  
-
-(define-record-type find-res-obj find-res-obj
-  (make-find-res-obj browse-obj)
-  find-res-obj?
-  (browse-obj find-res-obj-browse-obj))
-			 
-  
-
-(define find-receiver
- (lambda (message)
-    (cond 
-     ((next-command-message? message)
-      (let* ((width (next-command-message-width message))
-	     (parameter (next-command-message-parameters message)))
-	
-	(if (null? parameter)
-	    (let* ((result (list "Forgot parameters!"))
-		   (text
-		    (layout-result-standard "Forgot parameters!" 
-					    result width))
-		   (browse-obj
-		    (make-browse-list-res-obj 1 1 1 1 result text 
-					      width '() '() #f)))
-	      (make-find-res-obj browse-obj))
-	    
-	    (let*
-		((parameters (get-param-as-str parameter))
-		 (result (evaluate 
-			  (string-append "(run/sexps (find" parameters "))")))
-		 (result-string  (map exp->string result))
-		 (list-str (string-append "'" (exp->string result-string)))
-		 (browse-next-command-message 
-		  (make-next-command-message "browse-list"
-					     (cons list-str
-						   (list "\"/\""))
-					     width)))
-	      
-	      (make-find-res-obj (browse-list-receiver 
-				  browse-next-command-message))))))
-     ((print-message? message)
-      (let* ((model (message-result-object message))
-	     (width (print-message-width message))
-	     (browser (find-res-obj-browse-obj model))
-	     (browse-print-message 
-	      (make-print-message "browse-list"
-				  browser
-				  width)))
-	(browse-list-receiver browse-print-message)))
-     ((key-pressed-message? message)
-      (let* ((model (message-result-object message))
-	     (key (key-pressed-message-key message))
-	     (browser (find-res-obj-browse-obj model))
-	     (browse-key-message 
-	      (make-key-pressed-message "browse-list"
-					browser
-					key)))
-	(make-find-res-obj (browse-list-receiver
-				browse-key-message))))
-	     
-     ((restore-message? message)
-      (let* ((model (message-result-object message))
-	     (browser (find-res-obj-browse-obj model))
-	     (browse-restore-message
-	      (make-restore-message "browse-ist"
-				    browser)))
-	(browse-list-receiver browse-restore-message)))
-     ((selection-message? message)
-      (let* ((model (message-result-object message))
-	     (browser (find-res-obj-browse-obj model))
-	     (browse-sel-message
-	      (make-selection-message "browse-list"
-				      browser)))
-	(browse-list-receiver browse-sel-message)))
-      )))
-
-
-(define slash-away
-  (lambda (path)
-    (if (> (string-length path) 0)
-	(substring path 1 (string-length path))
-	path)))
-
-
-(define find-rec (make-receiver "find" find-receiver))
-
-(set! receivers (cons find-rec receivers))
\ No newline at end of file
diff --git a/scheme/scheme-commands.scm b/scheme/scheme-commands.scm
new file mode 100644
index 0000000..d0862ad
--- /dev/null
+++ b/scheme/scheme-commands.scm
@@ -0,0 +1,27 @@
+(define command-prefix #\,)
+
+(define (split-scheme-command-line command-line)
+  (let ((tokens (string-tokenize command-line)))
+    (values (string->symbol (string-drop (car tokens) 1))
+            (cdr tokens))))
+
+(define (scheme-command-line? command-line)
+  (char=? (string-ref (string-trim command-line) 0) 
+          command-prefix))
+
+(define (eval-scheme-command command args)
+  (case command
+    ((in) 
+     (set-evaluation-package! (string->symbol (car args)))
+     (string-append "moved to package " (car args)))
+    ((open)
+     (package-open! 
+      (evaluation-environment)
+      (lambda () 
+        (environment-ref
+         (config-package) (string->symbol (car args)))))
+     (string-append "opened package " (car args)))
+    ((user)
+     (set-evaluation-package! 'nuit-eval)
+     "moved to package nuit-eval")
+    (else (error "unknwon scheme command"))))
diff --git a/scheme/select-line.scm b/scheme/select-line.scm
new file mode 100644
index 0000000..afa2c6c
--- /dev/null
+++ b/scheme/select-line.scm
@@ -0,0 +1,77 @@
+;(define-record-type element 
+;  (make-element markable? marked? value text)
+;  element?
+;  (markable? element-markable?)
+;  (marked? element-marked?)
+;  (value element-value)
+;  (text element-text))
+
+;(define-record-discloser :element
+;  (lambda (r)
+;    `(element ,(element-marked? r) ,(element-text r))))
+
+;(define (make-unmarked-element value markable? text)
+;  (make-element markable? #f value text))
+
+;(define (make-marked-element value markable? text)
+;  (make-element markable? #t value text))
+
+(define (element-value x) x)
+(define (element-text x) x)
+
+(define-record-type select-line :select-line
+  (really-make-select-line elements cursor-index num-cols)
+  select-line?
+  (elements select-line-elements)
+  (cursor-index select-line-cursor-index set-select-line-cursor-index!)
+  (num-cols select-line-num-cols))
+
+(define (make-select-line elements)
+  (really-make-select-line elements 0 (length elements)))
+
+(define (select-line-handle-key-press! select-line key)
+  (cond 
+   ((= key key-right)
+    (move-cursor-right! select-line))
+   ((= key key-left)
+    (move-cursor-left! select-line))
+   (else #f)))
+
+(define (move-cursor-left! select-line)
+  (let ((old-col (select-line-cursor-index select-line)))
+    (if (and (> old-col 0)
+             (> (select-line-num-cols select-line) 1))
+        (set-select-line-cursor-index! select-line (- old-col 1)))))
+
+(define (move-cursor-right! select-line)
+  (let ((old-col (select-line-cursor-index select-line)))
+    (if (< old-col (- (select-line-num-cols select-line) 1))
+        (set-select-line-cursor-index! select-line (+ old-col 1)))))
+
+(define (paint-select-line select-line win result-buffer have-focus?)
+  (paint-select-line-at select-line 0 0 win result-buffer have-focus?))
+
+(define (paint-select-line-at select-line x y win result-buffer have-focus?)
+  (let ((cursor-col (select-line-cursor-index select-line)))
+    (let lp ((elts (select-line-elements select-line))
+             (i 0)
+             (x x))
+      (cond ((null? elts)
+             (values))
+            ((= i cursor-col)
+             (let ((text (element-text (car elts))))
+               (wattron win (A-REVERSE))
+               (mvwaddstr win y x text)
+               (wattrset win (A-NORMAL))
+               (lp (cdr elts) (+ i 1) (+ x (string-length text)))))
+            (else
+             (let ((text (element-text (car elts))))
+               (mvwaddstr win y x text)
+               (lp (cdr elts) (+ i 1) (+ x (string-length text)))))))))
+
+(define (select-line-selected-entry select-line)
+  (element-value
+   (list-ref (select-line-elements select-line)
+             (select-line-cursor-index select-line))))
+
+             
diff --git a/scheme/utils.scm b/scheme/utils.scm
new file mode 100644
index 0000000..6191278
--- /dev/null
+++ b/scheme/utils.scm
@@ -0,0 +1,15 @@
+(define (display-to-string val)
+  (let ((exp-port (open-output-string)))
+    (display exp exp-port)
+    (get-output-string exp-port)))
+
+;;expression as string
+(define (write-to-string exp)
+  (let ((exp-port (open-output-string)))
+    (write exp exp-port)
+    (get-output-string exp-port)))
+
+(define (on/off-option-processor name)
+  (lambda (option arg-name arg ops)
+    (cons (cons name #t) ops)))
+