A hacked beyond recognition patch: Move plugins to seperate modules,

put plugin api and registration into a module, add a new message-type,
make directory-files plugin work again, delete some hundred lines of
extremly silly code,

scheme/browse-directory-list.scm

@@ -38,42 +38,34 @@
   (res-marked-items browse-dir-list-res-obj-res-marked-items)
   (c-x-pressed browse-dir-list-res-obj-c-x-pressed))
 
-
+(define (layout-dir-list files wdir width)
-;;Layout of the directory-tree-browser
+  (let ((marked-files (mark-special-files wdir files)))
-(define layout-result-browse-dir-list
+    (append
-  (lambda (result-str result width directory)
+     (list
-    (let ((printed-file-list (print-file-list-1 result directory)))
+      (if (<= (string-length wdir) (- width 25))
-      (append
+	  (string-append "Paths relative to " wdir  " :")
-       (list
+	  (let ((dir-string (substring wdir
-        (if (<= (string-length directory) (- width 25))
+                                         (- (string-length wdir) 
-            (string-append "Paths relative to " directory  " :")
-            (let ((dir-string (substring directory 
-                                         (- (string-length directory) 
                                             (- width 25))
-                                         (string-length directory))))
+                                         (string-length wdir))))
-              (string-append "Paths relative to ..."
+	    (string-append "Paths relative to ..."
-                             dir-string))))
+			   dir-string))))
-       printed-file-list))))
+     marked-files)))
-
-
-;;One File per-line
-;;In case the object is a directory "/" is added
-(define print-file-list-1
-  (lambda (file-list dir)
-    (let loop ((old file-list)
-	       (new '()))
-      (if (equal? '() old)
-	  new
-	  (let* ((hd (list-ref old 0))
-		 (hd-path (string-append dir "/" hd))
-		 (tl (cdr old)))
-	    (if (file-exists? hd-path)
-		(if (file-directory? hd-path)
-		    (let ((new-str (string-append " " hd "/")))
-		      (loop tl (append new (list new-str))))
-		    (loop tl (append new (list (string-append " " hd)))))
-		(loop tl new)))))))
 
+(define (mark-special-files dir files)
+  (map (lambda (file)
+	 (let ((complete-name (string-append dir "/" file)))
+	   (cond
+	    ((file-directory? complete-name)
+	     (string-append " " file "/"))
+	    ((file-executable? complete-name)
+	     (string-append "*" file))
+	    ((file-symlink? complete-name)
+	     (string-append "@" file))
+	    (else
+	     (string-append " " file)))))
+       files))
+   
 ;;selection->descend
 (define selected-browse-dir-list
   (lambda (model)
@@ -90,12 +82,10 @@
 			 (if (not (equal? "/" (cwd)))
 			     (begin
 			       (chdir "..")
-			       (let* ((new-result (evaluate "(directory-files)"))
+			       (let* ((new-result (directory-files))
-				      (new-result-string (exp->string new-result))
 				      (width (browse-dir-list-res-obj-width model))
-				      (new-text (layout-result-browse-dir-list 
+				      (new-text (layout-dir-list 
-						 new-result-string 
+						 new-result (cwd) width))
-						 new-result width (cwd)))
 				      (new-model (make-browse-dir-list-res-obj
 						  2
 						  1
@@ -122,12 +112,10 @@
 			       (begin
 				 (chdir wd)
 				 (chdir rest)
-				 (let* ((new-result (evaluate "(directory-files)"))
+				 (let* ((new-result (directory-files))
-					(new-result-string (exp->string new-result))
 					(width (browse-dir-list-res-obj-width model))
-					(new-text (layout-result-browse-dir-list 
+					(new-text (layout-dir-list 
-						   new-result-string new-result width 
+						   new-result (cwd) width))
-						   (cwd)))
 					(new-model (make-browse-dir-list-res-obj
 						    2
 						    1
@@ -145,35 +133,25 @@
 				   new-model))
 			   model)))))))))
 
+(define (init-with-list-of-files files dir width)
+  (make-browse-dir-list-res-obj
+   2 1
+   files (layout-dir-list files dir width) dir
+   width (cwd) '() '() #f))
+
 (define browse-dir-list-receiver
   (lambda (message)
+    (debug-message "browse-dir-list-receiver " message)
     (cond 
+
+     ((init-with-result-message? message)
+      (let ((fs-objects (init-with-result-message-result message)))
+	(init-with-list-of-files
+	 (map fs-object-name fs-objects) (cwd)
+	 (init-with-result-message-width message))))
+
      ((next-command-message? message)
-      (let* ((command (next-command-string message))
+      (init-with-list-of-files (directory-files) (cwd)))
-	     (parameters (next-command-message-parameters message))
-	     (width (next-command-message-width message)))
-	(if (< (length parameters) 2)
-            (let* ((result (list "forgot parameters?"))
-                   (text
-                    (layout-result-standard "forgot parameters?"
-                                            result width))
-                   (browse-obj
-		      (make-browse-dir-list-res-obj 1 1 result text (cwd) 
-						    width (cwd) '() '() #f)))
-              browse-obj)
-	    
-	    (let* ((file-list 
-		    (evaluate (list-ref parameters 0)))
-		   (dir (evaluate (list-ref parameters 1)))
-		   (result-string (exp->string file-list))
-		   (width (next-command-message-width message))
-		   (text 
-		    (layout-result-browse-dir-list result-string
-						   file-list width dir))
-		   (browse-obj 
-		    (make-browse-dir-list-res-obj 2 1 file-list text dir width
-						  (cwd) '() '() #f)))
-	      browse-obj))))
 
      ((print-message? message)
       (let* ((model (message-result-object message))
@@ -353,10 +331,10 @@
 	     (marked-items (browse-dir-list-res-obj-res-marked-items model)))
 	(string-append "'" (exp->string marked-items)))))))
 
-(define browse-dir-list-rec (make-receiver "browse-dir-list" 
+(define (list-of-fs-objects? thing)
-					   browse-dir-list-receiver))
+  (and (proper-list? thing)
-
+       (every fs-object? thing)))
-(set! receivers (cons browse-dir-list-rec receivers))
-
-
 
+(register-plugin! (make-plugin "ls"
+			       browse-dir-list-receiver
+			       list-of-fs-objects?))

scheme/browse-list.scm

@@ -130,8 +130,7 @@
 						    width '() '() #f)))
 		browse-obj))
 
-	    (let ((lst 
+	    (let ((lst (list-ref parameters 0)))
-		   (evaluate (list-ref parameters 0))))
 	      (if (not (null? lst))
 		  (let*
 		      ((result-string (map exp->string lst))
@@ -337,9 +336,4 @@
 
 )))
 
-
+(register-plugin! (make-plugin "browse-list" browse-list-receiver))
-
-(define browse-list-rec (make-receiver "browse-list" 
-					   browse-list-receiver))
-
-(set! receivers (cons browse-list-rec receivers))

scheme/directory-files.scm

@@ -61,15 +61,8 @@
 	(browse-dir-list-receiver browse-sel-message)))
       )))
 
-
+(register-plugin!
-
+ (make-plugin "directory-files"  dir-files-receiver))
-(define dir-files-rec1
-  (make-receiver "directory-files"  dir-files-receiver))
 	   
-(set! receivers (cons dir-files-rec1 receivers))
+(register-plugin!
-
+ (make-plugin "ls" dir-files-receiver))
-(define dir-files-rec2
-  (make-receiver "ls" dir-files-receiver))
-
-(set! receivers (cons dir-files-rec2 receivers))
-

scheme/eval.scm

@@ -0,0 +1,7 @@
+(define (directory-files . optional-args)
+  (let-optionals optional-args
+      ((dir (cwd))
+       (dotfiles? #f))
+    (map (lambda (file)
+	   (make-fs-object file dir))
+	 (scsh-directory-files dir dotfiles?))))

scheme/fs-object.scm

@@ -0,0 +1,9 @@
+(define-record-type fs-object :fs-object
+  (make-fs-object name path)
+  fs-object?
+  (name fs-object-name)
+  (path fs-object-path))
+
+(define-record-discloser :fs-object
+  (lambda (r)
+    `(fs-object ,(fs-object-name r))))

scheme/layout.scm

@@ -0,0 +1,63 @@
+;;seperate a long line into pieces, each fitting into a smaller line.
+(define (seperate-line line width)
+  (let loop ((new '())
+	     (old line))
+    (if (> width (string-length old))
+	(if (= 0 (string-length old))
+	    (if (equal? new '())
+		'("")
+		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)))))
+
+;;the result is the "answer" of scsh
+(define (layout-result-standard result-str result width)
+  (reverse (seperate-line result-str width)))
+
+;useful helpers
+;;; EK: useful for what=
+(define (get-marked-positions-1 all-items marked-items)
+  (let loop ((count 0)
+	     (result '()))
+    (if (>= count (length all-items))
+	result
+	(let ((act-item (list-ref all-items count)))
+	  (if (member act-item marked-items)
+	      (loop (+ count 1)
+		    (append result (list (+ count 1))))
+	      (loop (+ count 1) result))))))
+
+(define (get-marked-positions-2 all-items marked-items)
+  (let loop ((count 0)
+	     (result '()))
+    (if (>= count (length all-items))
+	result
+	(let ((act-item (list-ref all-items count)))
+	  (if (member act-item marked-items)
+	      (loop (+ count 1)
+		    (append result (list (+ count 2))))
+	      (loop (+ count 1) result))))))
+
+(define (get-marked-positions-3 all-items marked-items)
+  (let loop ((count 0)
+	     (result '()))
+    (if (>= count (length all-items))
+	result
+	(let ((act-item (list-ref all-items count)))
+	  (if (member act-item marked-items)
+	      (loop (+ count 1)
+		    (append result (list (+ count 3))))
+	      (loop (+ count 1) result))))))
+
+;;expression as string
+(define (exp->string exp)
+  (let ((exp-port (open-output-string)))
+    (write exp exp-port)
+    (get-output-string exp-port)))
+
+(define (sublist l pos k)
+  (let ((tmp (list-tail l pos)))
+    (reverse (list-tail (reverse tmp) 
+			(- (length tmp) k)))))

scheme/nuit-engine.scm

@@ -42,20 +42,6 @@
 (define result-window #f)
 (define result-frame-window #f)
 
-(define shortcuts '("F1:Exit"
-		    "F2:Repaint (after change of buffer size)"
-		    "Ctrl+x o:Switch Buffer"
-		    "Ctrl+x s:Insert/Select"
-		    "Ctrl+x u:-/Unselect"
-		    "PageUp - previous entry in result history"
-		    "PageDown - next entry in result history"
-		    "Ctrl+x r:Redo (Active Command)"
-		    "CursorUp - previous entry in command history"
-		    "CursorDown - next entry in command history"
-		    "Ctrl+a:First Pos of Line"
-		    "Ctrl+e:End of Line"
-		    "Ctrl+k:Delete Line"))
-
 (define key-control-x 24)
 (define key-o 111)
 		    
@@ -128,12 +114,12 @@
   *current-history-item*)
 
 (define-record-type history-entry :history-entry
-  (make-history-entry command args result receiver)
+  (make-history-entry command args result plugin)
   history-entry?
   (command history-entry-command)
   (args history-entry-args)
   (result history-entry-result set-history-entry-result!)
-  (receiver history-entry-receiver))
+  (plugin history-entry-plugin))
 
 (define (current-history-entry-selector-maker selector)
   (lambda ()
@@ -156,7 +142,7 @@
   (cond
    ((current-history-item)
     => (lambda (entry)
-	 (set-history-entry-result! (entry-data) new-value)))
+	 (set-history-entry-result! (entry-data entry) new-value)))
    (else (values))))
 
 (define (append-to-history! history-entry)
@@ -187,125 +173,10 @@
 ;;If a keyboard-interrupt occurs this can be checked by looking-up this box
 (define active-keyboard-interrupt #f)
 
-;;This indicates if the last input was Ctrl-x
-(define c-x-pressed #f)
-
-
-;;Message-Types
-;;---------------------
-;;A new command was entered
-;;->create a new "object"
-(define-record-type next-command-message :next-command-message
-  (make-next-command-message command-string
-			     parameters
-			     width)
-  next-command-message?
-  (command-string next-command-string)
-  (parameters next-command-message-parameters)
-  (width next-command-message-width))
-
-;;key pressed
-;;The object and the key are send to the user-code, who returns the
-;;changed object.
-(define-record-type key-pressed-message :key-pressed-message
-  (make-key-pressed-message command-string
-			    result-object
-			    key prefix-key)
-  key-pressed-message?
-  (command-string key-pressed-command-string)
-  (result-object key-pressed-message-result-object)
-  (key key-pressed-message-key)
-  (prefix-key key-pressed-message-prefix-key))
-
-;;print
-(define-record-type print-message :print-message
-  (make-print-message command-string
-		      result-object
-		      width)
-  print-message?
-  (command-string print-message-command-string)
-  (result-object print-message-result-object)
-  (width print-message-width))
-
-;;->this sort of data-type is returned by a print-message 
-(define-record-type print-object :print-object
-  (make-print-object pos-y
-		     pos-x
-		     text
-		     highlighted-lines
-		     marked-lines)
-  print-object?
-  (pos-y print-object-pos-y)
-  (pos-x print-object-pos-x)
-  (text print-object-text)
-  (highlighted-lines print-object-highlighted-lines)
-  (marked-lines print-object-marked-lines))
-
-;;restore (when side-effects occur)
-(define-record-type restore-message :restore-message
-  (make-restore-message command-string
-			result-object)
-  restore-message?
-  (command-string restore-message-command-string)
-  (result-object restore-message-result-object))
-
-;;request the selection
-(define-record-type selection-message :selection-message
-  (make-selection-message command-string
-			  result-object)
-  selection-message?
-  (command-string selection-message-command-string)
-  (result-object selection-message-result-object))
-
-(define (message-result-object message)
-  ((cond 
-    ((key-pressed-message? message) 
-     key-pressed-message-result-object)
-    ((print-message? message) 
-     print-message-result-object)
-    ((restore-message? message) 
-     restore-message-result-object)
-    ((selection-message? message) 
-     selection-message-result-object message)
-    (else 
-     (error "This message-type has no field for result-objects"
-	    message)))
-   message))
-
-(define (message-command-string message)
-  ((cond
-    ((next-command-message? message)
-     next-command-string)
-    ((key-pressed-message? message)
-     key-pressed-command-string)
-    ((print-message? message)
-     print-message-command-string)
-    ((restore-message? message)
-     restore-message-command-string)
-    ((selection-message? message)
-     selection-message-command-string)
-    (else
-     (error "This message-type has no command field" message)))
-   message))
    
 ;;The "user" (who extends the functionality of NUIT) has to inform NUIT
 ;;about which function is meant to be the receiver, when a certain
 ;;command is active
-(define-record-type receiver :receiver
-  (really-make-receiver command rec type-predicate)
-  receiver?
-  (command receiver-command)
-  (rec receiver-rec)
-  (type-predicate receiver-type-predicate))
-
-(define (make-receiver command rec . more)
-  (really-make-receiver command rec
-			(if (null? more)
-			    (lambda (v) #f)
-			    (car more))))
-
-;;This list contains all the receivers that have been registered.
-(define receivers '())
 
 ;;*************************************************************************
 ;;Actions
@@ -369,7 +240,7 @@
 	      ch key-control-x)))
 	(update-current-result!
 	 (post-message
-	  (history-entry-receiver (entry-data (current-history-item)))
+	  (history-entry-plugin (entry-data (current-history-item)))
 	  key-message))
 	(loop (wait-for-input) #f)))
 
@@ -405,33 +276,47 @@
 
      ((= ch 10)
       (let ((command (last (buffer-text command-buffer))))
-	(call-with-values 
+	(if (not (string=? command ""))
-	    (lambda ()
+	    (call-with-values 
-	      (execute-command command))
+		(lambda ()
-	  (lambda (result receiver)
+		  (execute-command command))
-	    (let ((new-entry
+	      (lambda (result plugin)
-		   (make-history-entry command '() 
+		(let ((new-entry
-				       result receiver)))
+		       (make-history-entry command '() 
-	      (append-to-history! new-entry)
+					   result plugin)))
-	      (buffer-text-append-new-line! command-buffer)
+		  (append-to-history! new-entry)
-	      (paint-result-window new-entry)
+		  (buffer-text-append-new-line! command-buffer)
-	      (paint-active-command-window)
+		  (paint-result-window new-entry)
-	      (scroll-command-buffer)
+		  (paint-active-command-window)
-	      (paint-command-window-contents)
+		  (scroll-command-buffer)
-	      (move-cursor command-buffer)
+		  (paint-command-window-contents)
-	      (refresh-result-window)
+		  (move-cursor command-buffer)
-	      (refresh-command-window)
+		  (refresh-result-window)
-	      (loop (wait-for-input) c-x-pressed?))))))
+		  (refresh-command-window)
+		  (loop (wait-for-input) c-x-pressed?))))
+	    (loop (wait-for-input) #f))))
 
      (else 
-      (input command-buffer ch)
+      (cond
-      (werase (app-window-curses-win command-window))
+       ((focus-on-result-buffer?)
-      (print-command-buffer (app-window-curses-win command-window) 
+	(when (current-history-item)
-			    command-buffer)
+	  (update-current-result!
-      ;;(debug-message "loop after print-command-buffer " command-buffer)
+	   (post-message
-      (move-cursor command-buffer)
+	    (history-entry-plugin (entry-data (current-history-item)))
-      (refresh-command-window)
+	    (make-key-pressed-message 
-      (loop (wait-for-input) c-x-pressed?)))))
+	     (active-command) (current-result)
+	     ch c-x-pressed?)))
+	  (paint-result-window (entry-data (current-history-item)))
+	  (refresh-result-window))
+	(loop (wait-for-input) #f))
+       (else
+	(input command-buffer ch)
+	(werase (app-window-curses-win command-window))
+	(print-command-buffer (app-window-curses-win command-window) 
+			      command-buffer)
+	(move-cursor command-buffer)
+	(refresh-command-window)
+	(loop (wait-for-input) c-x-pressed?)))))))
 
 (define (window-init-curses-win! window)
   (set-app-window-curses-win!
@@ -519,8 +404,7 @@
   (wclear (app-window-curses-win result-window))
   (paint-result-buffer
    (post-message
-    (or (history-entry-receiver entry)
+    (history-entry-plugin entry)
-	(determine-receiver-by-command (history-entry-command entry)))
     (make-print-message (history-entry-command entry)
 			(history-entry-result entry)
 			(buffer-num-cols command-buffer)))))
@@ -551,64 +435,19 @@
 (define (execute-command command)
   (let ((result (evaluate command)))
     (cond
-     ((determine-receiver-by-type result)
+     ((determine-plugin-by-type result)
-      => (lambda (receiver)
+      => (lambda (plugin)
-	   (values result receiver)))
+	   (values 
+	    (post-message plugin
+			  (make-init-with-result-message
+			   result (buffer-num-cols command-buffer)))
+	    plugin)))
      (else 
       (values 
-       (post-message standard-receiver
+       (post-message standard-plugin
 		     (make-next-command-message
 		      command '() (buffer-num-cols command-buffer)))
-       standard-receiver)))))
+       standard-plugin)))))
-
-'(define (execute-command)
-  (let* ((com (list-ref (buffer-text command-buffer) 
-			(- (length (buffer-text command-buffer)) 1)))
-	 (com-par (extract-com-and-par com))
-	 (command (car com-par))
-	 (parameters (cdr com-par))
-	 ;;todo: parameters
-	 (message (make-next-command-message 
-		   command parameters result-cols))
-	 (model (post-message
-		 (determine-receiver-by-command command)
-		 message)))
-    (debug-message 'execute-command
-		   com " " com-par )
-    (if (not (= history-pos 0))
-	(let ((hist-entry (make-history-entry (active-command)
-					      (active-command-arguments)
-					      (current-result)))
-	      ;; hack of year
-	      (active (make-history-entry command 
-					  (get-param-as-str parameters)
-					  (if (standard-result-obj? model)
-					      (standard-result-obj-result model)
-					      model)
-					  (and (standard-result-obj? model)
-					       (determine-receiver-by-type 
-						(standard-result-obj-result model))))))
-		      
-	  (if (< history-pos (length history))
-	      (set! history (append history (list hist-entry)))
-	      (set! history (append 
-			     (sublist history 0 
-				      (- (length history) 1)) 
-			     (list hist-entry) (list active))))
-	  (set! history-pos (length history)))
-	(let ((hist-entry (make-history-entry 
-			   command 
-			   (get-param-as-str parameters) model)))
-	  (set! history (list hist-entry))
-	  (set! history-pos 1)))
-
-    (set-buffer-text! command-buffer 
-		      (append (buffer-text command-buffer)
-			      (list "")))
-    (set! active-command command)
-    (set! active-parameters (get-param-as-str parameters))
-    (set! (current-result) model)
-    (scroll-command-buffer)))
 
 ;;Extracts the name of the function and its parameters
 (define extract-com-and-par
@@ -683,26 +522,26 @@
     (read string-port)))
 
 (define evaluate 
-  (let ((env (init-evaluation-environment 'nuit-eval-structure)))
+  (let ((env (init-evaluation-environment 'nuit-eval)))
     (lambda (exp)
       (with-fatal-error-handler
        (lambda (condition more)
 	 (cons 'error condition))
        (eval (read-sexp-from-string exp) env)))))
 
-(define (post-message receiver message)
+(define (post-message plugin message)
-  ((receiver-rec receiver) message))
+  ((plugin-fun plugin) message))
 
-(define (determine-receiver-by-command command)
+(define (determine-plugin-by-command command)
   (or (find (lambda (r)
-	      (string=? (receiver-command r) command))
+	      (string=? (plugin-command r) command))
-	    receivers)
+	    (plugin-list))
-      standard-receiver))
+      standard-plugin))
 
-(define (determine-receiver-by-type result)
+(define (determine-plugin-by-type result)
   (find (lambda (r)
-	  ((receiver-type-predicate r) result))
+	  ((plugin-type-predicate r) result))
-	receivers))
+	(plugin-list)))
   
 ;;Management of the upper buffer
 ;;add a char to the buffer
@@ -766,12 +605,11 @@
 
 (define (post-print-message command result-object)
   (post-message
-   (determine-receiver-by-command command)
+   (determine-plugin-by-command command)
    (make-print-message command result-object
 		       (buffer-num-cols command-buffer))))
 
 (define (paint-result-buffer print-object)
-  (debug-message "paint-result-buffer ")
   (let* ((window (app-window-curses-win result-window))
 	 (text (print-object-text print-object))
 	 (pos-y (print-object-pos-y print-object))
@@ -881,53 +719,6 @@
       (set! result-buffer-pos-y pos-result))
   (set! result-buffer-pos-x pos-result-col))
 
-
-; ;;index of shortcuts at the bottom
-; (define print-bar3
-;   (lambda (width)
-;     (let loop ((pos 0)
-; 	       (used-width 0)
-; 	       (act-line 1))
-;       (if (>= pos (length shortcuts))
-; 	  (begin
-; 	    (let* ((num-blanks (+ (- width used-width) 1))
-; 		   (last-string (make-string num-blanks #\space)))
-; 	      (mvwaddstr bar3 act-line (+ used-width 1) last-string))
-; 	    (wrefresh bar3))
-; 	  (let* ((act-string (list-ref shortcuts pos))
-; 		 (act-length (string-length act-string))
-; 		 (rest-width (- width used-width)))
-; 	    (if (= act-line 1)
-; 		(if (<= (+ act-length 3) rest-width)
-; 		    (if (= used-width 0)
-; 			(begin
-; 			  (mvwaddstr bar3 1 (+ used-width 1) act-string)
-; 			  (loop (+ pos 1) (+ used-width act-length) 1))	    
-; 			(begin
-; 			  (mvwaddstr bar3 1 (+ used-width 1)
-; 				     (string-append " | " act-string))
-; 			  (loop (+ pos 1) (+ used-width (+ 3 act-length))
-; 				1)))
-; 		    (begin
-; 		      (let* ((num-blanks (+ rest-width 1))
-; 			     (last-string (make-string num-blanks #\space)))
-; 			(mvwaddstr bar3 1 (+ used-width 1) last-string))       
-; 		      (loop pos 0 2)))
-; 		(if (<= (+ act-length 3) rest-width)
-; 		    (if (= used-width 0)
-; 			(begin
-; 			  (mvwaddstr bar3 2 (+ used-width 1) act-string)
-; 			  (loop (+ pos 1) (+ used-width act-length) 2))
-; 			(begin
-; 			  (mvwaddstr bar3 2 (+ used-width 1)
-; 				     (string-append " | " act-string))
-; 			  (loop (+ pos 1) (+ used-width (+ 3 act-length)) 2)))
-; 		    (begin
-; 		      (let* ((num-blanks (+ rest-width 1) )
-; 			     (last-string (make-string num-blanks #\space)))
-; 			(mvwaddstr bar3 2 (+ used-width 1) last-string))
-; 		      (wrefresh bar3)))))))))
-
 (define (sublist l pos k)
   (let ((tmp (list-tail l pos)))
     (reverse (list-tail (reverse tmp) 
@@ -948,39 +739,15 @@
   (set! history '())
   (set! history-pos 0)
   (set! active-keyboard-interrupt #f))
-    
-;;Shortcuts-receiver:
-;;-------------------
-;;If the user enters the command "shortcuts" a list of the included
-;;shortcuts is displayed
-(define-record-type shortcut-result-obj shortcut-result-obj
-  (make-shortcut-result-obj a)
-  shortcut-result-object?
-  (a shortcut-result-object-a))
 
-(define (shortcut-receiver message)
+(define (get-param-as-str param-lst)
-  (cond
+  (let loop ((lst param-lst)
-   ((next-command-message? message)
+	     (str ""))
-    (make-shortcut-result-obj #t))
+    (if (null? lst)
-   ((print-message? message)
+	str
-    (make-print-object 1 1 shortcuts '() '()))
+	(loop (cdr lst)
-   ((key-pressed-message? message)
+	      (string-append str " " (car lst))))))
-    (message-result-object message))
-   ((restore-message? message)
-    (values))
-   ((selection-message? message)
-    "")))
 
-(define shortcut-rec (make-receiver "shortcuts" shortcut-receiver))
-
-(set! receivers (cons shortcut-rec receivers))
-
-
-
-;;Standard-Receiver
-;;-----------------
-
-;;Datatype representing the "standard-result-objects"
 (define-record-type standard-result-obj standard-result-obj
   (make-standard-result-obj cursor-pos-y
 			    cursor-pos-x
@@ -1021,71 +788,6 @@
    ((selection-message? message)
     "")))
 
-(define standard-receiver
+(define standard-plugin
-  (make-receiver #f standard-receiver-rec))
+  (make-plugin #f standard-receiver-rec))
 
-;;the result is the "answer" of scsh
-(define (layout-result-standard result-str result width)
-  (reverse (seperate-line result-str width)))
-
-;useful helpers
-(define (get-marked-positions-1 all-items marked-items)
-  (let loop ((count 0)
-	     (result '()))
-    (if (>= count (length all-items))
-	result
-	(let ((act-item (list-ref all-items count)))
-	  (if (member act-item marked-items)
-	      (loop (+ count 1)
-		    (append result (list (+ count 1))))
-	      (loop (+ count 1) result))))))
-
-(define (get-marked-positions-2 all-items marked-items)
-  (let loop ((count 0)
-	     (result '()))
-    (if (>= count (length all-items))
-	result
-	(let ((act-item (list-ref all-items count)))
-	  (if (member act-item marked-items)
-	      (loop (+ count 1)
-		    (append result (list (+ count 2))))
-	      (loop (+ count 1) result))))))
-
-(define (get-marked-positions-3 all-items marked-items)
-  (let loop ((count 0)
-	     (result '()))
-    (if (>= count (length all-items))
-	result
-	(let ((act-item (list-ref all-items count)))
-	  (if (member act-item marked-items)
-	      (loop (+ count 1)
-		    (append result (list (+ count 3))))
-	      (loop (+ count 1) result))))))
-
-;;expression as string
-(define (exp->string exp)
-  (let ((exp-port (open-output-string)))
-    (write exp exp-port)
-    (get-output-string exp-port)))
-
-;;seperate a long line into pieces, each fitting into a smaller line.
-(define (seperate-line line width)
-  (let loop ((new '())
-	     (old line))
-    (if (> width (string-length old))
-	(if (= 0 (string-length old))
-	    (if (equal? new '())
-		'("")
-		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 (get-param-as-str param-lst)
-  (let loop ((lst param-lst)
-	     (str ""))
-    (if (null? lst)
-	str
-	(loop (cdr lst)
-	      (string-append str " " (car lst))))))

scheme/nuit-packages.scm

@@ -13,18 +13,156 @@
 	  history-last-entry))
 
 (define-structure history history-interface
-  (open scheme 
+  (open scheme
 	define-record-types)
   (files history))
 
+;;; layout utilities
+
+(define-interface layout-interface
+  (export seperate-line
+	  layout-result-standard
+	  get-marked-positions-1
+	  get-marked-positions-2
+	  get-marked-positions-3
+	  exp->string
+	  sublist))
+
+(define-structure layout layout-interface
+  (open scheme
+	srfi-6			;; basic string ports
+	)
+  (files layout))
+
+;;; process viewer plugin
+
+(define-structure process-view-plugin
+    (export)
+  (open scheme
+	srfi-1
+	formats
+	pps
+	plugin
+	tty-debug)
+  (files process))
+
+;;; file list view plugin
+
+(define-structure dirlist-view-plugin
+    (export)
+  (open scheme-with-scsh
+	define-record-types
+	layout
+	fs-object
+	srfi-1
+	plugin
+	ncurses
+	tty-debug)
+  (files browse-directory-list))
+
+;;; browse-list plugin
+
+(define-structure browse-list-plugin
+    (export)
+  (open scheme
+	define-record-types
+	ncurses
+	plugin
+	layout)
+  (files browse-list))
+
+;;; fs-objects
+
+(define-interface fs-object-interface
+  (export make-fs-object
+	  fs-object?
+	  fs-object-name
+	  fs-object-path))
+
+(define-structure fs-object fs-object-interface
+  (open scheme
+	define-record-types)
+  (files fs-object))
+
 ;;; nuit evaluates the expressions entered into command buffer in this
 ;;; package
 
-(define-structure nuit-eval-structure (export)
+(define-structure nuit-eval
-  (open scheme-with-scsh
+    (export)
-	srfi-1
+  (open 
-	pps)
+   (modify scheme-with-scsh
-  (begin))
+	   (rename (directory-files scsh-directory-files)))
+   let-opt
+   srfi-1
+   fs-object
+   pps)
+  (files eval))
+
+;;; nuit plug-in registration
+
+(define-interface plugin-interface
+  (export make-plugin
+	  plugin?
+	  plugin-command
+	  plugin-fun
+	  plugin-type-predicate
+	  register-plugin!
+
+	  make-print-object
+	  print-object?
+	  print-object-pos-y
+	  print-object-pos-x
+	  print-object-text
+	  print-object-highlighted-lines
+	  print-object-marked-lines
+
+	  next-command-message?
+	  next-command-string
+	  next-command-message-parameters
+	  next-command-message-width
+
+	  init-with-result-message?
+	  init-with-result-message-result
+	  init-with-result-message-width
+
+	  key-pressed-message?
+	  key-pressed-message-result-object
+	  key-pressed-message-key
+	  key-pressed-message-prefix-key
+
+	  print-message?
+	  print-message-command-string
+	  print-message-result-object
+	  print-message-width
+
+	  restore-message?
+	  restore-message-command-string
+	  restore-message-result-object
+
+	  selection-message?
+	  selection-message-command-string
+	  selection-message-result-object
+
+	  message-result-object
+	  message-command-string))
+
+(define-interface plugin-host-interface
+  (export plugin-list
+	  make-next-command-message
+	  make-init-with-result-message
+	  make-key-pressed-message
+	  make-print-message
+	  make-restore-message
+	  make-selection-message))
+
+(define-structures
+  ((plugin plugin-interface)
+   (plugin-host plugin-host-interface))
+  (open scheme
+	define-record-types
+	let-opt
+	signals)
+  (files plugins))
 
 ;;; nuit 
 
@@ -46,17 +184,16 @@
 	inspect-exception
 	rt-modules
 	tty-debug
+	fs-object
+	plugin
+	plugin-host
+	layout
 	pps
-	history)
+	history
+	;; the following modules are plugins
+	browse-list-plugin
+	dirlist-view-plugin
+	process-view-plugin)
   (files nuit-engine
-	 handle-fatal-error
+	 handle-fatal-error))
-	 directory-files
-	 find
-	 cd
-	 browse-directory-list
-	 browse-list
-	 process))
-
-
-
 

scheme/plugins.scm

@@ -0,0 +1,125 @@
+(define *plugins* '())
+
+(define (plugin-list)
+  *plugins*)
+
+(define-record-type plugin :plugin
+  (really-make-plugin command fun type-predicate)
+  plugin?
+  (command plugin-command)
+  (fun plugin-fun)
+  (type-predicate plugin-type-predicate))
+
+(define-record-discloser :plugin
+  (lambda (r)
+    `(plugin ,(plugin-command r) ,(plugin-fun r))))
+
+(define (make-plugin command fun . more)
+  (let-optionals more
+      ((type-predicate (lambda (v) #f)))
+    (really-make-plugin command fun type-predicate)))
+
+(define (register-plugin! plugin)
+  (set! *plugins* (cons plugin *plugins*)))
+
+;; answers
+
+(define-record-type print-object :print-object
+  (make-print-object pos-y
+		     pos-x
+		     text
+		     highlighted-lines
+		     marked-lines)
+  print-object?
+  (pos-y print-object-pos-y)
+  (pos-x print-object-pos-x)
+  (text print-object-text)
+  (highlighted-lines print-object-highlighted-lines)
+  (marked-lines print-object-marked-lines))
+
+;; messages
+
+(define-record-type next-command-message :next-command-message
+  (make-next-command-message command-string
+			     parameters
+			     width)
+  next-command-message?
+  (command-string next-command-string)
+  (parameters next-command-message-parameters)
+  (width next-command-message-width))
+
+(define-record-type init-with-result-message :init-with-result-message
+  (make-init-with-result-message result width)
+  init-with-result-message?
+  (result init-with-result-message-result)
+  (width init-with-result-message-width))
+
+;;key pressed
+;;The object and the key are send to the user-code, who returns the
+;;changed object.
+(define-record-type key-pressed-message :key-pressed-message
+  (make-key-pressed-message command-string
+			    result-object
+			    key prefix-key)
+  key-pressed-message?
+  (command-string key-pressed-command-string)
+  (result-object key-pressed-message-result-object)
+  (key key-pressed-message-key)
+  (prefix-key key-pressed-message-prefix-key))
+
+;;print
+(define-record-type print-message :print-message
+  (make-print-message command-string
+		      result-object
+		      width)
+  print-message?
+  (command-string print-message-command-string)
+  (result-object print-message-result-object)
+  (width print-message-width))
+
+;;restore (when side-effects occur)
+(define-record-type restore-message :restore-message
+  (make-restore-message command-string
+			result-object)
+  restore-message?
+  (command-string restore-message-command-string)
+  (result-object restore-message-result-object))
+
+;;request the selection
+(define-record-type selection-message :selection-message
+  (make-selection-message command-string
+			  result-object)
+  selection-message?
+  (command-string selection-message-command-string)
+  (result-object selection-message-result-object))
+
+(define (message-result-object message)
+  ((cond 
+    ((key-pressed-message? message) 
+     key-pressed-message-result-object)
+    ((print-message? message) 
+     print-message-result-object)
+    ((restore-message? message) 
+     restore-message-result-object)
+    ((selection-message? message) 
+     selection-message-result-object message)
+    (else 
+     (error "This message-type has no field for result-objects"
+	    message)))
+   message))
+
+(define (message-command-string message)
+  ((cond
+    ((next-command-message? message)
+     next-command-string)
+    ((key-pressed-message? message)
+     key-pressed-command-string)
+    ((print-message? message)
+     print-message-command-string)
+    ((restore-message? message)
+     restore-message-command-string)
+    ((selection-message? message)
+     selection-message-command-string)
+    (else
+     (error "This message-type has no command field" message)))
+   message))

scheme/process.scm

@@ -22,6 +22,8 @@
   (cond
    ((next-command-message? message)
     (pps))
+   ((init-with-result-message? message)
+    (init-with-result-message-result message))
    ((print-message? message)
     (let ((processes (message-result-object message)))
       (make-print-object 1 1 (print-processes processes)
@@ -33,7 +35,5 @@
    ((selection-message? message)
     "'()")))
 
-(set! receivers (cons (make-receiver "ps" pps-receiver 
+(register-plugin! 
-				     list-of-processes?)
+ (make-plugin "ps" pps-receiver list-of-processes?))
-		      receivers))
-