126 lines
3.6 KiB
Scheme
126 lines
3.6 KiB
Scheme
(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))
|