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)
 | 
			
		||||
  (make-select-list
 | 
			
		||||
| 
						 | 
				
			
			@ -26,47 +68,8 @@
 | 
			
		|||
         (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)
 | 
			
		||||
      (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))))))
 | 
			
		||||
(define make-service-info-viewer
 | 
			
		||||
  (make-info-viewer make-service-info-select-list))
 | 
			
		||||
 | 
			
		||||
(register-plugin!
 | 
			
		||||
 (make-view-plugin make-service-info-viewer service-info?))
 | 
			
		||||
| 
						 | 
				
			
			@ -93,47 +96,8 @@
 | 
			
		|||
         (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))))))
 | 
			
		||||
(define make-protocol-info-viewer
 | 
			
		||||
  (make-info-viewer make-protocol-info-select-list))
 | 
			
		||||
 | 
			
		||||
(register-plugin!
 | 
			
		||||
 (make-view-plugin make-protocol-info-viewer protocol-info?))
 | 
			
		||||
		Loading…
	
		Reference in New Issue