Pasting for service-info
part of darcs patch Thu Sep 22 00:44:15 EEST 2005 Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
parent
af369b2d3a
commit
2fe9ca9f66
|
@ -1,24 +1,68 @@
|
||||||
|
|
||||||
(define (make-service-info-viewer service-info buffer)
|
(define (make-service-info-select-list si num-lines)
|
||||||
(let ((service-info service-info)
|
(make-select-list
|
||||||
(select-line (make-select-line
|
(append
|
||||||
(list
|
(list
|
||||||
(service-info:name service-info)
|
(make-unmarked-text-element
|
||||||
;;(service-info:aliases service-info)
|
(cons 'name (service-info:name si))
|
||||||
(number->string (service-info:port service-info))
|
#t
|
||||||
(service-info:protocol service-info)))))
|
(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 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)
|
(lambda (message)
|
||||||
(case message
|
(case message
|
||||||
((paint)
|
((paint)
|
||||||
(lambda (self win buffer have-focus?)
|
(lambda (self win buffer have-focus?)
|
||||||
(paint-select-line-at select-line 5 5 win)))
|
(paint-selection-list-at select-list 1 1 win
|
||||||
|
(result-buffer-num-cols buffer)
|
||||||
|
have-focus?)))
|
||||||
((key-press)
|
((key-press)
|
||||||
(lambda (self key control-x-pressed?)
|
(lambda (self key control-x-pressed?)
|
||||||
(select-line-handle-key-press! select-line key)
|
(set! select-list
|
||||||
|
(select-list-handle-key-press select-list key))
|
||||||
self))
|
self))
|
||||||
((get-select-as-text)
|
((get-selection-as-text)
|
||||||
(lambda (self for-scheme-mode? focus-object-table)
|
get-selection-as-text)
|
||||||
(select-line-selected-entry select-line)))
|
|
||||||
((get-selection-as-ref)
|
((get-selection-as-ref)
|
||||||
"UII get-selection-as-ref")
|
"UII get-selection-as-ref")
|
||||||
(else
|
(else
|
||||||
|
|
|
@ -248,7 +248,11 @@
|
||||||
(subset srfi-13 (string-join))
|
(subset srfi-13 (string-join))
|
||||||
|
|
||||||
plugin
|
plugin
|
||||||
select-line)
|
layout
|
||||||
|
formats
|
||||||
|
utils
|
||||||
|
select-element
|
||||||
|
select-list)
|
||||||
(files network-viewer))
|
(files network-viewer))
|
||||||
|
|
||||||
;;; terminal buffer
|
;;; terminal buffer
|
||||||
|
|
Loading…
Reference in New Issue