129 lines
3.8 KiB
Scheme
129 lines
3.8 KiB
Scheme
(define *command-plugins* '())
|
|
|
|
(define *view-plugins* '())
|
|
|
|
(define *command-completions*
|
|
(make-empty-completion-set))
|
|
|
|
(define (command-plugin-list)
|
|
*command-plugins*)
|
|
|
|
(define (view-plugin-list)
|
|
*view-plugins*)
|
|
|
|
(define (command-completions)
|
|
*command-completions*)
|
|
|
|
(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*))
|
|
(set! *command-completions*
|
|
(adjoin-completion-set *command-completions*
|
|
(command-plugin-command plugin))))
|
|
((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 buffer)
|
|
init-with-result-message?
|
|
(result init-with-result-message-result)
|
|
(buffer init-with-result-message-buffer))
|
|
|
|
;;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)
|
|
(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))
|