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:
parent
a00af6e57b
commit
54907fe26e
|
@ -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)
|
(define (make-service-info-select-list si num-lines)
|
||||||
(make-select-list
|
(make-select-list
|
||||||
|
@ -26,47 +68,8 @@
|
||||||
(service-info:aliases si)))
|
(service-info:aliases si)))
|
||||||
num-lines))
|
num-lines))
|
||||||
|
|
||||||
(define (make-service-info-viewer si buffer)
|
(define make-service-info-viewer
|
||||||
(let ((si si)
|
(make-info-viewer make-service-info-select-list))
|
||||||
(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))))))
|
|
||||||
|
|
||||||
(register-plugin!
|
(register-plugin!
|
||||||
(make-view-plugin make-service-info-viewer service-info?))
|
(make-view-plugin make-service-info-viewer service-info?))
|
||||||
|
@ -93,47 +96,8 @@
|
||||||
(protocol-info:aliases pi)))
|
(protocol-info:aliases pi)))
|
||||||
num-lines))
|
num-lines))
|
||||||
|
|
||||||
(define (make-protocol-info-viewer pi buffer)
|
(define make-protocol-info-viewer
|
||||||
(let ((pi pi)
|
(make-info-viewer make-protocol-info-select-list))
|
||||||
(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))))))
|
|
||||||
|
|
||||||
(register-plugin!
|
(register-plugin!
|
||||||
(make-view-plugin make-protocol-info-viewer protocol-info?))
|
(make-view-plugin make-protocol-info-viewer protocol-info?))
|
Loading…
Reference in New Issue