Introduce utils module, move exp->string and display-to-string to utils
part of darcs patch Sat Sep 17 17:22:33 EEST 2005 Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>
This commit is contained in:
		
							parent
							
								
									39ae30681a
								
							
						
					
					
						commit
						4bdb8da41f
					
				| 
						 | 
				
			
			@ -51,12 +51,6 @@
 | 
			
		|||
		    (append result (list (+ count 3))))
 | 
			
		||||
	      (loop (+ count 1) result))))))
 | 
			
		||||
 | 
			
		||||
;;expression as string
 | 
			
		||||
(define (exp->string exp)
 | 
			
		||||
  (let ((exp-port (open-output-string)))
 | 
			
		||||
    (write exp exp-port)
 | 
			
		||||
    (get-output-string exp-port)))
 | 
			
		||||
 | 
			
		||||
(define (sublist l pos k)
 | 
			
		||||
  (let ((tmp (list-tail l pos)))
 | 
			
		||||
    (reverse (list-tail (reverse tmp) 
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -8,6 +8,15 @@
 | 
			
		|||
  (open scheme conditions handle)
 | 
			
		||||
  (files handle-fatal-error))
 | 
			
		||||
 | 
			
		||||
(define-interface utils-interface
 | 
			
		||||
  (export display-to-string
 | 
			
		||||
          exp->string))
 | 
			
		||||
 | 
			
		||||
(define-structure utils utils-interface
 | 
			
		||||
  (open scheme
 | 
			
		||||
        srfi-6)
 | 
			
		||||
  (files utils))
 | 
			
		||||
 | 
			
		||||
;;; history data structure
 | 
			
		||||
 | 
			
		||||
(define-interface history-interface
 | 
			
		||||
| 
						 | 
				
			
			@ -35,7 +44,6 @@
 | 
			
		|||
	  get-marked-positions-1
 | 
			
		||||
	  get-marked-positions-2
 | 
			
		||||
	  get-marked-positions-3
 | 
			
		||||
	  exp->string
 | 
			
		||||
	  sublist
 | 
			
		||||
 | 
			
		||||
	  fill-up-string
 | 
			
		||||
| 
						 | 
				
			
			@ -70,7 +78,6 @@
 | 
			
		|||
 | 
			
		||||
(define-structure layout layout-interface
 | 
			
		||||
  (open scheme-with-scsh
 | 
			
		||||
	srfi-6			;; basic string ports
 | 
			
		||||
	define-record-types
 | 
			
		||||
	let-opt
 | 
			
		||||
	locks
 | 
			
		||||
| 
						 | 
				
			
			@ -144,6 +151,7 @@
 | 
			
		|||
	pps
 | 
			
		||||
	plugin
 | 
			
		||||
	layout
 | 
			
		||||
        utils
 | 
			
		||||
	select-list
 | 
			
		||||
	tty-debug)
 | 
			
		||||
  (files process))
 | 
			
		||||
| 
						 | 
				
			
			@ -159,6 +167,7 @@
 | 
			
		|||
        dirlist-view-plugin
 | 
			
		||||
        fs-object
 | 
			
		||||
        plugin
 | 
			
		||||
        utils
 | 
			
		||||
        layout
 | 
			
		||||
        select-list
 | 
			
		||||
        (subset focus-table (make-focus-object-reference))
 | 
			
		||||
| 
						 | 
				
			
			@ -198,6 +207,7 @@
 | 
			
		|||
	focus-table
 | 
			
		||||
	objects
 | 
			
		||||
	layout
 | 
			
		||||
        utils
 | 
			
		||||
	fs-object
 | 
			
		||||
	select-list
 | 
			
		||||
	plugin
 | 
			
		||||
| 
						 | 
				
			
			@ -262,6 +272,7 @@
 | 
			
		|||
 | 
			
		||||
        tty-debug
 | 
			
		||||
	objects
 | 
			
		||||
        utils
 | 
			
		||||
	layout)
 | 
			
		||||
  (files std-viewer))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -320,7 +331,7 @@
 | 
			
		|||
	(subset focus-table (make-focus-object-reference))
 | 
			
		||||
	tty-debug
 | 
			
		||||
	plugin
 | 
			
		||||
	layout
 | 
			
		||||
        utils
 | 
			
		||||
	ncurses)
 | 
			
		||||
  (files select-list))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -367,6 +378,7 @@
 | 
			
		|||
        focus-table
 | 
			
		||||
	ncurses
 | 
			
		||||
        layout
 | 
			
		||||
        utils
 | 
			
		||||
        select-list
 | 
			
		||||
        tty-debug
 | 
			
		||||
        plugin)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -246,7 +246,7 @@
 | 
			
		|||
 | 
			
		||||
    (define (prepare-selection-for-command-mode infos)
 | 
			
		||||
      (string-join
 | 
			
		||||
       (map value->string
 | 
			
		||||
       (map display-to-string
 | 
			
		||||
            (map group-info-element->value infos))))
 | 
			
		||||
    
 | 
			
		||||
    (define (prepare-selection-for-scheme-mode infos)
 | 
			
		||||
| 
						 | 
				
			
			@ -307,13 +307,6 @@
 | 
			
		|||
        (else
 | 
			
		||||
         (error "unknown message in make-group-info-browser" message))))))
 | 
			
		||||
 | 
			
		||||
(define (value->string val)
 | 
			
		||||
  (cond ((string? val) val)
 | 
			
		||||
        ((number? val) (number->string val))
 | 
			
		||||
        ((boolean? val) (if val "#t" "#f"))
 | 
			
		||||
        (else
 | 
			
		||||
         (error "unknwon value in value->string" val))))
 | 
			
		||||
 | 
			
		||||
(define (make-user-info-browser ui buffer)
 | 
			
		||||
  (let ((ui ui)
 | 
			
		||||
        (buffer buffer)
 | 
			
		||||
| 
						 | 
				
			
			@ -335,7 +328,7 @@
 | 
			
		|||
 
 | 
			
		||||
    (define (prepare-selection-for-command-mode infos)
 | 
			
		||||
      (string-join
 | 
			
		||||
       (map value->string
 | 
			
		||||
       (map display-to-string
 | 
			
		||||
            (map user-info-element->value infos))))
 | 
			
		||||
    
 | 
			
		||||
    (define (prepare-selection-for-scheme-mode infos)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue