commander-s/scheme/nuit-engine.scm

;;  ,load /home/demattia/studium/studienarbeit/scsh-nuit/scheme/nuit-engine.scm

(define-syntax when
  (syntax-rules ()
    ((_ ?test ?do-this ...)
     (if ?test 
	 (begin ?do-this ... (values))
	 (values)))))

;;This is the "heart" of NUIT.
;;In a central loop the program waits for input (with wgetch).
;;In the upper buffer simply the functionalities of scsh-ncurses:
;;input-buffer are used.
;;The lower window is meant to be used more flexible. Depending on
;;the active command the key-inputs are routed to the correct receiver,
;;where one can specify how to react.

;;*************************************************************************
;;State

(define-record-type app-window :app-window
  (make-app-window x y width height curses-win)
  app-window?
  (x app-window-x)
  (y app-window-y)
  (width app-window-width)
  (height app-window-height)
  (curses-win app-window-curses-win set-app-window-curses-win!))

(define-record-discloser :app-window
  (lambda (rec)
    `(app-window 
      (x ,(app-window-x rec)) (y ,(app-window-y rec))
      (w ,(app-window-width rec)) (h ,(app-window-height rec)))))

(define bar-1 #f)
(define active-command-window #f)

(define command-frame-window #f)
(define command-window #f)

(define result-window #f)
(define result-frame-window #f)

(define key-control-x 24)
(define key-o 111)
		    
;;state of the upper window (Command-Window)
(define command-buffer 
  (make-buffer '("Welcome to the scsh-ncurses-ui!" "")
	       2 2 2 1 1
	       0 0
	       #t 1))

;;state of the lower window (Result-Window)
;;----------------------------
;;Text
(define text-result (list "Type 'shortcuts' for help"))

;;line of the result-window
(define pos-result 0)

;;column
(define pos-result-col 0)

;;y-coordinate of the cursor in the result-buffer
(define result-buffer-pos-y 0)

;;x-coordinate of the cursor in the result-buffer
(define result-buffer-pos-x 0)

;;lines of the lower window
(define result-lines 0)

;;columns in the lower window
(define result-cols 0)

;;lines to be highlighted
(define highlighted-lines '())

;;lines to be marked
(define marked-lines '())

;;miscelaneous state
;;-------------------

(define *focus-buffer* 'command-buffer)

(define (focus-on-command-buffer?)
  (eq? *focus-buffer* 'command-buffer))

(define (focus-command-buffer!)
  (set! *focus-buffer* 'command-buffer))

(define (focus-on-result-buffer?)
  (eq? *focus-buffer* 'result-buffer))

(define (focus-result-buffer!)
  (set! *focus-buffer* 'result-buffer))

;; mode of the command buffer
(define *command-buffer-mode* 'scheme)

(define (command-buffer-in-scheme-mode?)
  (eq? *command-buffer-mode* 'scheme))

(define (command-buffer-in-command-mode?)
  (eq? *command-buffer-mode* 'command))

(define (enter-scheme-mode!)
  (set! *command-buffer-mode* 'scheme))

(define (enter-command-mode!)
  (set! *command-buffer-mode* 'command))

;; History

(define history-pos 0)
(define the-history (make-empty-history))

(define (history) the-history)

(define *current-history-item* #f)

(define (current-history-item)
  *current-history-item*)

(define-record-type history-entry :history-entry
  (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!)
  (plugin history-entry-plugin))

(define (current-history-entry-selector-maker selector)
  (lambda ()
    (cond
     ((current-history-item)
      => (lambda (entry)
	   (selector (entry-data entry))))
     (else #f))))

(define active-command
  (current-history-entry-selector-maker history-entry-command))

(define active-command-arguments
  (current-history-entry-selector-maker history-entry-args))

(define current-result
  (current-history-entry-selector-maker history-entry-result))

(define (update-current-result! new-value)
  (cond
   ((current-history-item)
    => (lambda (entry)
	 (set-history-entry-result! (entry-data entry) new-value)))
   (else (values))))

(define (append-to-history! history-entry)
  (append-history-item! the-history history-entry)
  (set! *current-history-item* 
	(history-last-entry the-history)))

;;  one step back in the history
(define (history-back!)
  (cond
   ((and (current-history-item)
	 (history-prev-entry (current-history-item)))
    => (lambda (prev)
	 (set! *current-history-item* prev)))
   (else (values))))

;; one step forward
(define (history-forward!)
  (cond
   ((and *current-history-item*
	 (history-next-entry *current-history-item*))
    => (lambda (next)
	 (set! *current-history-item* next)))
   (else (values))))

;;active keyboard-interrupt:
;;after each input this is set to #f.
;;If a keyboard-interrupt occurs this can be checked by looking-up this box
(define active-keyboard-interrupt #f)

   
;;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

;;*************************************************************************
;;Actions
      
;;start the whole thing
(define (nuit)
  (let ((tty-name (init-tty-debug-output!)))
    (display "Debug messages will be on ")
    (display tty-name)
    (newline))
  (with-inspecting-handler
   8888
   (lambda (condition)
     (with-current-output-port*
      (error-output-port)
      (lambda ()
	(display "starting remote handler for condition") 
	(display condition)
	(newline)
	(display "Please connect to port 8888")
	(newline)
	#t)))
   run))

(define (toggle-buffer-focus)
  (cond
   ((focus-on-command-buffer?)
    (focus-result-buffer!)
    (refresh-result-window))
   (else
    (focus-command-buffer!)
    (move-cursor command-buffer)
    (refresh-command-window))))

(define (toggle-command/scheme-mode)
  (cond 
   ((command-buffer-in-command-mode?)
    (enter-scheme-mode!))
   ((command-buffer-in-scheme-mode?)
    (enter-command-mode!)))
  (paint-command-frame-window)
  (paint-command-window-contents)
  (move-cursor command-buffer)
  (refresh-command-window))

;; handle input
(define (run)

  (init-windows!)
  '(set-interrupt-handler interrupt/keyboard 
			  (lambda a 
			    (set! active-keyboard-interrupt a)))
      
  ;;Loop
  (paint)
  (let loop ((ch (wait-for-input)) (c-x-pressed? #f))
    (cond

     ;; Ctrl-x -> wait for next input
     ((= ch key-control-x)
      (loop (wait-for-input) #t))

     ;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
     ((= ch key-f7)
      (toggle-command/scheme-mode)
      (loop (wait-for-input) #f))

     ;; C-x o --- toggle buffer focus
     ((and c-x-pressed? (= ch key-o))
      (toggle-buffer-focus)
      (loop (wait-for-input) #f))

     ((and c-x-pressed? (focus-on-result-buffer?))
      (let ((key-message
	     (make-key-pressed-message
	      (active-command) (current-result)
	      ch key-control-x)))
	(update-current-result!
	 (post-message
	  (history-entry-plugin (entry-data (current-history-item)))
	  key-message))
	(loop (wait-for-input) #f)))

     ;; C-x r --- redo
     ((and c-x-pressed? (focus-on-command-buffer?)
	   (= ch 114))
      (debug-message "Eric should re-implement redo..."))

     ((= ch key-f1)
      (endwin))
     
     ((= ch key-f2)
      (paint)
      (loop (wait-for-input) c-x-pressed?))

     ;; forward in result history
     ((= ch key-npage)
      (history-forward!)
      (when (current-history-item)
	(paint-active-command-window)
	(paint-result-window (entry-data (current-history-item))))
      (refresh-result-window)
      (loop (wait-for-input) c-x-pressed?))
     
     ;; back in result history
     ((= ch key-ppage)
      (history-back!)
      (when (current-history-item)
	(paint-active-command-window)
	(paint-result-window (entry-data (current-history-item))))
      (refresh-result-window)
      (loop (wait-for-input) c-x-pressed?))

     ((= ch 10)
      (let ((command (last (buffer-text command-buffer))))
	(if (not (string=? command ""))
	    (call-with-values 
		(lambda ()
		  (execute-command command))
	      (lambda (result plugin)
		(let ((new-entry
		       (make-history-entry command '() 
					   result plugin)))
		  (append-to-history! new-entry)
		  (buffer-text-append-new-line! command-buffer)
		  (paint-result-window new-entry)
		  (paint-active-command-window)
		  (scroll-command-buffer)
		  (paint-command-window-contents)
		  (move-cursor command-buffer)
		  (refresh-result-window)
		  (refresh-command-window)
		  (loop (wait-for-input) c-x-pressed?))))
	    (loop (wait-for-input) #f))))

     (else 
      (cond
       ((focus-on-result-buffer?)
	(when (current-history-item)
	  (update-current-result!
	   (post-message
	    (history-entry-plugin (entry-data (current-history-item)))
	    (make-key-pressed-message 
	     (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!
   window
   (newwin (app-window-height window) (app-window-width window)
	   (app-window-y window) (app-window-x window))))

(define (make-inlying-app-window outer-window)
  (make-app-window (+ (app-window-x outer-window) 1)
		   (+ (app-window-y outer-window) 1)
		   (- (app-window-width outer-window) 2)
		   (- (app-window-height outer-window) 2)
		   #f))

(define (init-windows!)
  (init-screen)
  (set! bar-1
	(make-app-window 1 1 
			 (- (COLS) 2) 2 
			 #f))
  (set! active-command-window
	(make-app-window 1 (+ (round (/ (LINES) 3)) 2)
			 (- (COLS) 2) 3
			 #f))
  (set! command-frame-window
	(make-app-window 1 2
			 (- (COLS) 2) (- (app-window-y active-command-window) 2)
			 #f))
  (set! command-window 
	(make-inlying-app-window command-frame-window))
  (set! result-frame-window
	(make-app-window 1 (+ (app-window-y active-command-window) 3)
			 (- (COLS) 2)
			 (- (- (LINES) 6) (app-window-height command-frame-window))
			 #f))
  (set! result-window
	(make-inlying-app-window result-frame-window))

  (let ((all-windows (list bar-1 active-command-window
			   command-frame-window command-window
			   result-frame-window result-window)))
    (for-each window-init-curses-win! all-windows)
  
    (debug-message "init-windows!: bar-1 " bar-1 
		   " active-command-window " active-command-window
		   " command-frame-window " command-frame-window
		   " command-window " command-window
		   " result-frame-window " result-frame-window
		   " result-window " result-window)
    (for-each wclear 
	      (map app-window-curses-win all-windows))
    (clear)))

(define (paint-bar-1)
  (mvwaddstr (app-window-curses-win bar-1) 0 1 "SCSH-NUIT")
  (wrefresh (app-window-curses-win bar-1)))

(define (paint-command-buffer-mode-indicator)
  (let ((mode-string 
	 (string-append
	  "[ "
	  (if (command-buffer-in-command-mode?)
	      "Command"
	      "Scheme")
	  " ]")))
    (mvwaddstr 
     (app-window-curses-win command-frame-window)
     0 
     (- (- (app-window-width command-frame-window)
	   (string-length mode-string)) 
	2)
     mode-string)))
  
(define (paint-command-frame-window)
  (box (app-window-curses-win command-frame-window)
       (ascii->char 0) (ascii->char 0))
  (paint-command-buffer-mode-indicator)
  (wrefresh (app-window-curses-win command-frame-window)))

(define (paint-command-window-contents)
  (set-buffer-num-lines! command-buffer
 			 (- (app-window-height command-window) 2))
  (set-buffer-num-cols! command-buffer
 			(- (app-window-width command-window) 3))
  (werase (app-window-curses-win command-window))
  (print-command-buffer (app-window-curses-win command-window)
			command-buffer))

(define (refresh-command-window)
  (wrefresh (app-window-curses-win command-window)))

(define (paint-result-frame-window)
  (let ((win (app-window-curses-win result-frame-window)))
    (wclear win)
    (box win (ascii->char 0) (ascii->char 0))
    ;;; EK: wtf is going on here?
    (set! result-lines (- (app-window-height result-window) 2))
    (set! result-cols (- (app-window-width result-window) 3))
    (wrefresh win)))

(define (paint-result-window entry)
  (wclear (app-window-curses-win result-window))
  (paint-result-buffer
   (post-message
    (history-entry-plugin entry)
    (make-print-message (history-entry-command entry)
			(history-entry-result entry)
			(buffer-num-cols command-buffer)))))

(define (refresh-result-window)
  (wrefresh (app-window-curses-win result-window)))

(define (paint)
  (debug-message "paint")
  (paint-bar-1)
  (paint-command-frame-window)
  (paint-command-window-contents)
  (paint-active-command-window)
  (paint-result-frame-window)
  ;(paint-result-window)
  (move-cursor command-buffer)
  (refresh-command-window)
  (refresh-result-window))

(define (wait-for-input)
  (noecho)
  (keypad (app-window-curses-win bar-1) #t)
  (set! active-keyboard-interrupt #f)
  (let ((ch (wgetch (app-window-curses-win bar-1))))
    (echo)
    ch))

(define (execute-command command)
  (let ((result (evaluate command)))
    (cond
     ((determine-plugin-by-type result)
      => (lambda (plugin)
	   (values 
	    (post-message plugin
			  (make-init-with-result-message
			   result (buffer-num-cols command-buffer)))
	    plugin)))
     (else 
      (values 
       (post-message standard-view-plugin
		     (make-next-command-message
		      command '() (buffer-num-cols command-buffer)))
       standard-view-plugin)))))

;;Extracts the name of the function and its parameters
(define extract-com-and-par
  (lambda (com)
    (if (<= (string-length com) 0)
	(cons "" '())
	(if (equal? #\( (string-ref com 0))
	    (cons com '())
	    (let* ((fst-word (get-next-word com))
		  (command (car fst-word))
		  (rest (cdr fst-word)))
	      (let loop ((param-str rest)
			 (param-list '()))
		(let* ((word (get-next-word param-str))
		       (param (car word))
		       (more (cdr word)))
		  (if (equal? "" param)
		      (cons command param-list)
		      (loop more (append param-list (list param))))))))))) 

;;gets the next word from a string
(define (get-next-word str)
  (let loop ((old str)
	     (new ""))
    (if (= 0 (string-length old))
	(cons new old)
	(if (char=? #\space (string-ref old 0))
	    (if (= 1 (string-length old))
		(cons new "")
		(cons new (substring old 1 (string-length old))))
	    (if (char=? #\( (string-ref old 0))
		(let* ((nw (get-next-word-braces 
			    (substring old 1 
				       (string-length old))))
		       (nw-new (car nw))
		       (nw-old (cdr nw)))
		  (loop nw-old (string-append new "(" nw-new)))
		(loop (substring old 1 (string-length old))
		      (string-append new (string (string-ref old 0)))))))))

(define (get-next-word-braces str)
  (let loop ((old str)
	     (new ""))
    (if (= 0 (string-length old))
	(cons new old)
	(if (char=? #\( (string-ref old 0))
	    (let* ((nw (get-next-word-braces 
			(substring old 1 
				   (string-length old))))
		   (nw-new (car nw))
		   (nw-old (cdr nw)))
	      (loop nw-old (string-append new "(" nw-new)))
	    (if (char=? #\) (string-ref old 0))
		(cons (string-append new ")")
		      (substring old 1 (string-length old)))
		(loop (substring old 1 (string-length old))
		      (string-append new (string (string-ref old 0)))))))))

;;scroll buffer after one command was entered
(define (scroll-command-buffer)
  (set-buffer-pos-line! command-buffer 
			(+ (buffer-pos-line command-buffer) 1))
  (set-buffer-pos-col! command-buffer 2))

(define (init-evaluation-environment package)
  (let ((structure (reify-structure package)))
    (load-structure structure)
    (rt-structure->environment structure)))

(define (read-sexp-from-string string)
  (let ((string-port (open-input-string string)))
    (read string-port)))

(define evaluate 
  (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 plugin message)
  (cond
   ((view-plugin? plugin)
    ((view-plugin-fun plugin) message))
   (else 
    (error "don't know how to talk to this plugin type"
	   plugin))))

(define (determine-plugin-by-type result)
  (find (lambda (r)
	  ((view-plugin-type-predicate r) result))
	(view-plugin-list)))
  
;;Management of the upper buffer
;;add a char to the buffer
(define (add-to-command-buffer ch)
  (let* ((text (buffer-text command-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 
			       (max 0 (- (buffer-pos-col command-buffer) 2))))
	 (after-ch (substring old-last-el 
			      (max 0 (- (buffer-pos-col command-buffer) 2))
			      (string-length old-last-el)))
	 (new-last-el (string-append  before-ch
				      (string (ascii->char ch))
				      after-ch)))
    (set-buffer-text! command-buffer
		     (append old-rest (list new-last-el)))
    (set-buffer-pos-col! command-buffer
			 (+ (buffer-pos-col command-buffer) 1))))

;;add a string to the buffer
(define (add-string-to-command-buffer string)
  (let loop ((str string))
    (if (string=? str "")
	(values)
	(let ((first-ch (string-ref str 0)))
	  (add-to-command-buffer (char->ascii first-ch))
	  (loop (substring str 1 (string-length str)))))))

;;selection of the visible area of the buffer
(define (prepare-lines l height pos)
  (if (< (length l) height)
      (let loop ((tmp-list l))
	(if (= height (length tmp-list))
	    tmp-list
	    (loop (append tmp-list (list "")))))
      (if (<  pos height)
	  (sublist l 0 height)
	  (sublist l (- pos height) height))))

;;; FIXME: I guess s48 knows a better way to do this (see ,inspect)
(define (maybe-shorten-string string width)
  (if (> (string-length string) width)
      (string-append (substring string 0 (- width 3))
		     "...")
      string))

(define (paint-active-command-window) 
  (let ((win (app-window-curses-win active-command-window))
	(width (app-window-width active-command-window)))
    (wclear win)
    (box win (ascii->char 0) (ascii->char 0))
    (cond
     ((current-history-item)
      => (lambda (entry)
	   (mvwaddstr win 1 2 
		      (maybe-shorten-string 
		       (history-entry-command (entry-data entry)) width)))))
    (wrefresh win)))

(define (paint-result-buffer print-object)
  (let* ((window (app-window-curses-win result-window))
	 (text (print-object-text print-object))
	 (pos-y (print-object-pos-y print-object))
	 (pos-x (print-object-pos-x print-object))
	 (highlighted-lns (print-object-highlighted-lines print-object))
	 (marked-lns (print-object-marked-lines print-object)))
    (set! text-result text)
    (set! pos-result pos-y)
    (set! pos-result-col pos-x)
    (set! highlighted-lines highlighted-lns)
    (set! marked-lines marked-lns)
    (right-highlighted-lines)
    (right-marked-lines)
    (let ((lines (get-right-result-lines)))
      (let loop ((pos 1))
	(if (> pos result-lines)
	    (values)
	    (let ((line (list-ref lines (- pos 1))))
	      (begin
		(if (not (standard-result-obj? (current-result)))
		    (set! line 
			  (if (> (string-length line) result-cols)
			      (let ((start-line 
				     (substring line 0
						(- (ceiling (/ result-cols 2))
						   3)))
				    (end-line
				     (substring line 
						(- (string-length line)
						   (ceiling 
						    (/ result-cols 2)))
						(string-length line))))
				(string-append start-line "..." end-line))
			      line)))
		(if (and (member pos highlighted-lines)
			 (focus-on-result-buffer?))
		    (begin
		      (wattron window (A-REVERSE))
		      (mvwaddstr window pos 1 line)
		      (wattrset window (A-NORMAL))
		      ;(wrefresh window)
		      (loop (+ pos 1)))
		    (if (member pos marked-lines)
			(begin
			  (wattron window (A-BOLD))
			  (mvwaddstr window pos 1 line)
			  (wattrset window (A-NORMAL))
			  ;(wrefresh window)
			  (loop (+ pos 1)))
			(begin
			  (mvwaddstr window pos 1 line)
			  ;(wrefresh window)
			  (loop (+ pos 1))))))))))))
  
;;visible lines
(define (get-right-result-lines)
  (prepare-lines text-result result-lines pos-result))
	  
;;marked and highlighted lines
(define (right-highlighted-lines)
  (let loop ((old highlighted-lines)
	     (new '()))
    (if (null? old)
	(set! highlighted-lines new)
	(let ((el (car old)))
	  (if (<= pos-result result-lines)
	      ;;auf der ersten Seite
	      (loop (cdr old)
		    (append new (list el)))
	      (let* ((offset (- pos-result result-lines))
		     (new-el (- el offset )))
		(loop (cdr old)
		      (append new (list new-el)))))))))

(define (right-marked-lines)
  (let loop ((old marked-lines)
	     (new '()))
    (if (null? old)
	(set! marked-lines new)
	(let ((el (car old)))
	  (if (<= pos-result result-lines)
	      ;;auf der ersten Seite
	      (loop (cdr old)
		    (append new (list el)))
	      (let* ((offset (- pos-result result-lines))
		     (new-el (- el offset )))
		(loop (cdr old)
		      (append new (list new-el)))))))))

;;Cursor
;;move cursor to the corrct position
(define (move-cursor buffer)
  (if (focus-on-command-buffer?)
      (cursor-right-pos (app-window-curses-win command-window)
			buffer)
      (begin
	(compute-y-x)
	(wmove (app-window-curses-win result-window) 
	       result-buffer-pos-y result-buffer-pos-x)
	(wrefresh (app-window-curses-win result-window))
	buffer)))

;;compue pos-x and pos-y
(define (compute-y-x)
  (if (>= pos-result result-lines)
      (set! result-buffer-pos-y result-lines)
      (set! result-buffer-pos-y pos-result))
  (set! result-buffer-pos-x pos-result-col))

(define (sublist l pos k)
  (let ((tmp (list-tail l pos)))
    (reverse (list-tail (reverse tmp) 
			(- (length tmp) k)))))

;;When NUIT is closed the state has to be restored, in order to let the
;;user start again from scratch 
(define (restore-state)
  (set! text-result (list "Start entering commands."))
  (set! pos-result 0)
  (set! pos-result-col 0)
  (set! result-buffer-pos-y 0)
  (set! result-buffer-pos-x 0)
  (set! result-lines 0)
  (set! result-cols 0)
  (set! highlighted-lines '())
  (set! marked-lines '())
  (set! history '())
  (set! history-pos 0)
  (set! active-keyboard-interrupt #f))

(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))))))

(define-record-type standard-result-obj standard-result-obj
  (make-standard-result-obj cursor-pos-y
			    cursor-pos-x
			    result-text
			    result)
  standard-result-obj?
  (cursor-pos-y standard-result-obj-cur-pos-y)
  (cursor-pos-x standard-result-obj-cur-pos-x)
  (result-text standard-result-obj-result-text)
  (result standard-result-obj-result))

(define init-std-res (make-standard-result-obj 1 1 text-result 
					       (car text-result)))

;;Standard-Receiver:
(define (standard-receiver-rec message)
  (cond 
   ((next-command-message? message)
    (let* ((result (evaluate (message-command-string message)))
	   (result-string (exp->string result))
	   (width (next-command-message-width message))
	   (text (layout-result-standard result-string result width))
	   (std-obj (make-standard-result-obj 1 1 text result)))
      std-obj))
   ((print-message? message)
    (let* ((model (message-result-object message))
	   (pos-y (standard-result-obj-cur-pos-y model))
	   (pos-x (standard-result-obj-cur-pos-x model))
	   (width (print-message-width message))
	   (result (standard-result-obj-result model))
	   (text (layout-result-standard (exp->string result)
					 result width))) 
      (make-print-object pos-y pos-x text '() '())))
   ((key-pressed-message? message)
    (message-result-object message))
   ((restore-message? message)
    (values))
   ((selection-message? message)
    "")))

(define standard-view-plugin
  (make-view-plugin standard-receiver-rec 
		    (lambda (val) #t)))