commander-s/scheme/plugins.scm

(define *command-plugins* '())

(define *view-plugins* '())

(define (command-plugin-list)
  *command-plugins*)

(define (view-plugin-list)
  *view-plugins*)

(define-record-type view-plugin :view-plugin
  (make-view-plugin fun type-predicate)
  view-plugin?
  (fun view-plugin-fun)
  (type-predicate view-plugin-type-predicate))

(define-record-type command-plugin :command-plugin
  (make-command-plugin command completer evaluater)
  command-plugin?
  (command command-plugin-command)
  (completer command-plugin-completer)
  (evaluater command-plugin-evaluater))

(define (register-plugin! plugin)
  (cond
   ((command-plugin? plugin)
    (set! *command-plugins* (cons plugin *command-plugins*)))
   ((view-plugin? plugin)
    (set! *view-plugins* (cons plugin *view-plugins*)))
   (error "unknown plugin type" plugin)))

;; 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
			    result-buffer
			    key prefix-key)
  key-pressed-message?
  (command-string key-pressed-command-string)
  (result-object key-pressed-message-result-object)
  (result-buffer key-pressed-message-result-buffer)
  (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))