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)
|
(release-lock lock)
|
||||||
val)))))
|
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
|
;; mode of the command buffer
|
||||||
(define *command-buffer-mode* initial-command-mode)
|
(define *command-buffer-mode* initial-command-mode)
|
||||||
|
|
||||||
|
@ -308,6 +320,8 @@
|
||||||
|
|
||||||
(init-screen)
|
(init-screen)
|
||||||
(init-windows!)
|
(init-windows!)
|
||||||
|
(read-config-file!)
|
||||||
|
|
||||||
(clear)
|
(clear)
|
||||||
|
|
||||||
(if (not (process-group-leader?))
|
(if (not (process-group-leader?))
|
||||||
|
@ -365,7 +379,7 @@
|
||||||
(loop (wait-for-input) #f maybe-selector)))
|
(loop (wait-for-input) #f maybe-selector)))
|
||||||
|
|
||||||
;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
|
;; 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)
|
(toggle-command/scheme-mode)
|
||||||
(loop (wait-for-input) #f #f))
|
(loop (wait-for-input) #f #f))
|
||||||
|
|
||||||
|
|
|
@ -756,6 +756,19 @@
|
||||||
command-line-absyn)
|
command-line-absyn)
|
||||||
(files comp-cmd))
|
(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
|
;;; nuit
|
||||||
|
|
||||||
(define-interface nuit-interface
|
(define-interface nuit-interface
|
||||||
|
@ -791,6 +804,7 @@
|
||||||
initial-tty
|
initial-tty
|
||||||
nuit-windows
|
nuit-windows
|
||||||
|
|
||||||
|
configuration
|
||||||
command-line-parser
|
command-line-parser
|
||||||
focus-table
|
focus-table
|
||||||
result-buffer-changes
|
result-buffer-changes
|
||||||
|
|
Loading…
Reference in New Issue