diff --git a/scheme/network-viewer.scm b/scheme/network-viewer.scm index 093df57..ee7e3e8 100644 --- a/scheme/network-viewer.scm +++ b/scheme/network-viewer.scm @@ -69,4 +69,71 @@ (error "service-info-viewer unknown message" message)))))) (register-plugin! - (make-view-plugin make-service-info-viewer service-info?)) \ No newline at end of file + (make-view-plugin make-service-info-viewer service-info?)) + +(define (make-protocol-info-select-list pi num-lines) + (make-select-list + (append + (list + (make-unmarked-text-element + (cons 'name (protocol-info:name pi)) + #t + (format #f "Name: ~a" (protocol-info:name pi))) + (make-unmarked-text-element + (cons 'number (protocol-info:number pi)) + #t + (format #f "Number: ~a" (number->string + (protocol-info:number pi)))) + (make-unmarked-text-element + (cons 'text "") #f "Aliases:")) + (map (lambda (alias) + (make-unmarked-text-element + (cons 'alias alias) #t + (format #f " ~a" alias))) + (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)))))) + +(register-plugin! + (make-view-plugin make-protocol-info-viewer protocol-info?)) \ No newline at end of file