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