(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 (append (list (make-unmarked-text-element (cons 'name (service-info:name si)) #t (format #f "Name: ~a" (service-info:name si))) (make-unmarked-text-element (cons 'port (service-info:port si)) #t (format #f "Port: ~a" (number->string (service-info:port si)))) (make-unmarked-text-element (cons 'protocol (service-info:protocol si)) #t (format #f "Protocol: ~a" (service-info:protocol si))) (make-unmarked-text-element (cons 'text "") #f "Aliases:")) (map (lambda (alias) (make-unmarked-text-element (cons 'alias alias) #t (format #f " ~a" alias))) (service-info:aliases si))) num-lines)) (define make-service-info-viewer (make-info-viewer make-service-info-select-list)) (register-plugin! (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 (make-info-viewer make-protocol-info-select-list)) (register-plugin! (make-view-plugin make-protocol-info-viewer protocol-info?)) (define (make-host-info-select-list hi num-lines) (make-select-list (append (list (make-unmarked-text-element (cons 'name (host-info:name hi)) #t (format #f "Name: ~a" (host-info:name hi))) (make-unmarked-text-element (cons 'text "") #f "Aliases:")) (map (lambda (alias) (make-unmarked-text-element (cons 'alias alias) #t (format #f " ~a" alias))) (host-info:aliases hi)) (list (make-unmarked-text-element (cons 'text "") #f "Addresses:")) (map (lambda (address) (make-unmarked-text-element (cons 'address address) #t (format #f " ~a" address))) (host-info:addresses hi))) num-lines)) (define make-host-info-viewer (make-info-viewer make-host-info-select-list)) (register-plugin! (make-view-plugin make-host-info-viewer host-info?))