Introduce a library for configurable options
part of darcs patch: Sat Sep 17 18:35:54 EEST 2005 Eric Knauel <knauel@informatik.uni-tuebingen.de>
This commit is contained in:
		
							parent
							
								
									fbc7cc3929
								
							
						
					
					
						commit
						60fa0e133c
					
				| 
						 | 
				
			
			@ -0,0 +1,53 @@
 | 
			
		|||
(define *configuration* '())
 | 
			
		||||
 | 
			
		||||
(define (init-config config-file)
 | 
			
		||||
  (with-input-file 
 | 
			
		||||
   config-file
 | 
			
		||||
   (set! *configuration* (read))))
 | 
			
		||||
(define (read-config config-file)
 | 
			
		||||
  (call-with-input-file config-file read))
 | 
			
		||||
 | 
			
		||||
(define (config option)
 | 
			
		||||
  (let ((probe (assq option *configuration*)))
 | 
			
		||||
(define (config-file-to-use)
 | 
			
		||||
  (let ((from-env (getenv "CMDRSRC"))
 | 
			
		||||
	(default-location
 | 
			
		||||
	  (string-append (home-dir) "/.cmdrsrc")))
 | 
			
		||||
    (if (and from-env (file-exists? from-env))
 | 
			
		||||
	from-env
 | 
			
		||||
	default-location)))
 | 
			
		||||
 | 
			
		||||
(define (read-config-file!)
 | 
			
		||||
  (with-errno-handler
 | 
			
		||||
   ((errno data)
 | 
			
		||||
    (else #f))
 | 
			
		||||
   (let ((conf-file (config-file-to-use)))
 | 
			
		||||
     (for-each
 | 
			
		||||
      (lambda (option.value)
 | 
			
		||||
	(cond
 | 
			
		||||
	 ((and (pair? option.value)
 | 
			
		||||
	       (pair? (car option.value))
 | 
			
		||||
	       (symbol? (caar option.value))
 | 
			
		||||
	       (symbol? (cdar option.value))
 | 
			
		||||
	       (assoc (car option.value) *configuration*))
 | 
			
		||||
	  => (lambda (p)
 | 
			
		||||
	       (set-cdr! p (cdr option.value))))
 | 
			
		||||
	 (else
 | 
			
		||||
	  (error "Unknown option value or ill-formed option" 
 | 
			
		||||
		 option.value conf-file))))
 | 
			
		||||
      (read-config conf-file)))))
 | 
			
		||||
 | 
			
		||||
(define (config module option)
 | 
			
		||||
  (let ((probe (assoc (cons module option) *configuration*)))
 | 
			
		||||
    (if probe 
 | 
			
		||||
        (cdr probe)
 | 
			
		||||
        (error "unknown configuration option" option))))
 | 
			
		||||
 | 
			
		||||
(define (define-option module option-name default-value)
 | 
			
		||||
  (set! *configuration*
 | 
			
		||||
	(cons (cons (cons module option-name) default-value)
 | 
			
		||||
	      *configuration*)))
 | 
			
		||||
	
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -16,6 +16,18 @@
 | 
			
		|||
	 (release-lock lock)
 | 
			
		||||
	 val)))))
 | 
			
		||||
 | 
			
		||||
;; configurable options
 | 
			
		||||
 | 
			
		||||
(define-option 'main 'switch-command-buffer-mode-key key-f7)
 | 
			
		||||
 | 
			
		||||
;; configurable options
 | 
			
		||||
 | 
			
		||||
(define-option 'main 'switch-command-buffer-mode-key key-f7)
 | 
			
		||||
 | 
			
		||||
;; configurable options
 | 
			
		||||
 | 
			
		||||
(define-option 'main 'switch-command-buffer-mode-key key-f7)
 | 
			
		||||
 | 
			
		||||
;; mode of the command buffer
 | 
			
		||||
(define *command-buffer-mode* initial-command-mode)
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -308,6 +320,8 @@
 | 
			
		|||
 | 
			
		||||
  (init-screen)
 | 
			
		||||
  (init-windows!)
 | 
			
		||||
  (read-config-file!)
 | 
			
		||||
 | 
			
		||||
  (clear)
 | 
			
		||||
 | 
			
		||||
  (if (not (process-group-leader?))
 | 
			
		||||
| 
						 | 
				
			
			@ -365,7 +379,7 @@
 | 
			
		|||
	(loop (wait-for-input) #f maybe-selector)))
 | 
			
		||||
 | 
			
		||||
     ;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
 | 
			
		||||
     ((= ch key-home)
 | 
			
		||||
     ((= ch (config 'main 'switch-command-buffer-mode-key))
 | 
			
		||||
      (toggle-command/scheme-mode)
 | 
			
		||||
      (loop (wait-for-input) #f #f))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -756,6 +756,19 @@
 | 
			
		|||
	command-line-absyn)
 | 
			
		||||
  (files comp-cmd))
 | 
			
		||||
   
 | 
			
		||||
;;; config
 | 
			
		||||
 | 
			
		||||
(define-interface configuration-interface
 | 
			
		||||
  (export read-config-file!
 | 
			
		||||
	  define-option
 | 
			
		||||
	  config))
 | 
			
		||||
 | 
			
		||||
(define-structure configuration configuration-interface
 | 
			
		||||
  (open scheme-with-scsh
 | 
			
		||||
	signals
 | 
			
		||||
	handle-fatal-error)
 | 
			
		||||
  (files config))
 | 
			
		||||
 | 
			
		||||
;;; nuit 
 | 
			
		||||
 | 
			
		||||
(define-interface nuit-interface
 | 
			
		||||
| 
						 | 
				
			
			@ -791,6 +804,7 @@
 | 
			
		|||
	initial-tty
 | 
			
		||||
	nuit-windows 
 | 
			
		||||
 | 
			
		||||
	configuration
 | 
			
		||||
	command-line-parser
 | 
			
		||||
	focus-table
 | 
			
		||||
	result-buffer-changes
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue