Abstraction, abstraction, abstraction

part of darcs patch Thu Sep 22 18:38:05 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
eknauel 2005-09-27 16:33:54 +00:00
parent a00af6e57b
commit 54907fe26e
1 changed files with 46 additions and 82 deletions

View File

@ -1,3 +1,45 @@
(define (make-info-viewer make-info-select-list)
(lambda (info buffer)
(let ((info info)
(select-list
(make-info-select-list
info (result-buffer-num-lines buffer))))
(define (prepare-selection-for-scheme-mode sel)
(format #f "(~a)"
(string-join
(map write-to-string (map cdr sel)))))
(define (prepare-selection-for-command-mode sel)
(string-join (map display-to-string (map cdr sel))))
(define (get-selection-as-text self for-scheme-mode? focus-object-table)
(paste-selection (select-list-get-selection select-list)
(select-list-has-marks? select-list)
for-scheme-mode?
(lambda (se)
(write-to-string (cdr se)))
(lambda (se)
(display-to-string (cdr se)))))
(lambda (message)
(case message
((paint)
(lambda (self win buffer have-focus?)
(paint-selection-list-at select-list 1 1 win
(result-buffer-num-cols buffer)
have-focus?)))
((key-press)
(lambda (self key control-x-pressed?)
(set! select-list
(select-list-handle-key-press select-list key))
self))
((get-selection-as-text)
get-selection-as-text)
((get-selection-as-ref)
"UII get-selection-as-ref")
(else
(error "info-viewer unknown message" message)))))))
(define (make-service-info-select-list si num-lines)
(make-select-list
@ -26,47 +68,8 @@
(service-info:aliases si)))
num-lines))
(define (make-service-info-viewer si buffer)
(let ((si si)
(select-list
(make-service-info-select-list
si (result-buffer-num-lines buffer))))
(define (prepare-selection-for-scheme-mode sel)
(format #f "(~a)"
(string-join
(map write-to-string (map cdr sel)))))
(define (prepare-selection-for-command-mode sel)
(string-join (map display-to-string (map cdr sel))))
(define (get-selection-as-text self for-scheme-mode? focus-object-table)
(paste-selection (select-list-get-selection select-list)
(select-list-has-marks? select-list)
for-scheme-mode?
(lambda (se)
(write-to-string (cdr se)))
(lambda (se)
(display-to-string (cdr se)))))
(lambda (message)
(case message
((paint)
(lambda (self win buffer have-focus?)
(paint-selection-list-at select-list 1 1 win
(result-buffer-num-cols buffer)
have-focus?)))
((key-press)
(lambda (self key control-x-pressed?)
(set! select-list
(select-list-handle-key-press select-list key))
self))
((get-selection-as-text)
get-selection-as-text)
((get-selection-as-ref)
"UII get-selection-as-ref")
(else
(error "service-info-viewer unknown message" message))))))
(define make-service-info-viewer
(make-info-viewer make-service-info-select-list))
(register-plugin!
(make-view-plugin make-service-info-viewer service-info?))
@ -93,47 +96,8 @@
(protocol-info:aliases pi)))
num-lines))
(define (make-protocol-info-viewer pi buffer)
(let ((pi pi)
(select-list
(make-protocol-info-select-list
pi (result-buffer-num-lines buffer))))
(define (prepare-selection-for-scheme-mode sel)
(format #f "(~a)"
(string-join
(map write-to-string (map cdr sel)))))
(define (prepare-selection-for-command-mode sel)
(string-join (map display-to-string (map cdr sel))))
(define (get-selection-as-text self for-scheme-mode? focus-object-table)
(paste-selection (select-list-get-selection select-list)
(select-list-has-marks? select-list)
for-scheme-mode?
(lambda (se)
(write-to-string (cdr se)))
(lambda (se)
(display-to-string (cdr se)))))
(lambda (message)
(case message
((paint)
(lambda (self win buffer have-focus?)
(paint-selection-list-at select-list 1 1 win
(result-buffer-num-cols buffer)
have-focus?)))
((key-press)
(lambda (self key control-x-pressed?)
(set! select-list
(select-list-handle-key-press select-list key))
self))
((get-selection-as-text)
get-selection-as-text)
((get-selection-as-ref)
"UII get-selection-as-ref")
(else
(error "protocol-info-viewer unknown message" message))))))
(define make-protocol-info-viewer
(make-info-viewer make-protocol-info-select-list))
(register-plugin!
(make-view-plugin make-protocol-info-viewer protocol-info?))