144 lines
4.6 KiB
Scheme
144 lines
4.6 KiB
Scheme
(define (ip-address-32->dotted-string address)
|
|
(let ((extract (lambda (shift)
|
|
(number->string
|
|
(bitwise-and (arithmetic-shift address (- shift))
|
|
255)))))
|
|
(string-append
|
|
(extract 24) "." (extract 16) "."
|
|
(extract 8) "." (extract 0))))
|
|
|
|
(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
|
|
(ip-address-32->dotted-string 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?))
|