changed user configuration file handling. Now the config file needs to

define the structure config-file implementing
config-file-interface. Old config files need to be changed (see
config.scm).
This commit is contained in:
frese 2003-05-07 15:19:37 +00:00
parent 04455cd104
commit 6aeb922953
2 changed files with 66 additions and 34 deletions

View File

@ -76,36 +76,34 @@
(define (load-configuration dpy)
(let ((filename (config-filename dpy)))
(if (file-exists? filename)
(begin
;; exceptions ??
(for-each (lambda (exp)
(eval exp (interaction-environment)))
`( (define root-options '())
(define split-options '())
(define switch-options '())
(define move-options '())
(define-syntax define-option
(syntax-rules
()
((define-option list name value)
(set! list (cons (cons (quote name) value)
list)))))
(define-syntax define-options
(syntax-rules
()
((define-options l (name value) ...)
(set! l (append (list (cons (quote name) value)
...)
l)))))
;; define-options ...
(load ,filename)
(set! root-options
(call-with-current-continuation
(lambda (return)
(with-handler
(lambda (condition punt)
(mdisplay "error loading configuration file " filename ".\n")
(mdisplay "problem is: " condition "\n")
(mdisplay "ignoring it...\n")
(return '()))
(lambda ()
(load-config-file filename)
(let ((config-file (reify-structure 'config-file)))
(load-structure config-file)
(let ((get (lambda (n) (rt-structure-binding config-file n))))
(append (list (cons 'default-split-options
split-options)
(get 'split-options))
(cons 'default-switch-options
switch-options)
(get 'switch-options))
(cons 'default-move-options
move-options))
root-options)) ))
(eval 'root-options (interaction-environment)))
(get 'move-options)))
(get 'root-options))))))))
;; TODO: maybe create a file with default-config-file in it
'())))
(define default-config-file
'(
(define-structure config-file config-file-interface
(open scheme xlib config-file-utils)
(begin
;; your options here
))
))

View File

@ -150,6 +150,40 @@
utils key-grab)
(files switch-wm))
;; *** user's config-file utils **************************************
(define-interface config-file-interface
(export root-options
split-options
switch-options
move-options))
(define-structure config-file-utils
(export root-options
split-options
switch-options
move-options
((define-option define-options) :syntax))
(open scheme)
(begin
(define root-options '())
(define split-options '())
(define switch-options '())
(define move-options '())
(define-syntax define-option
(syntax-rules
()
((define-option list name value)
(set! list (cons (cons (quote name) value)
list)))))
(define-syntax define-options
(syntax-rules
()
((define-options l (name value) ...)
(set! l (append (list (cons (quote name) value)
...)
l)))))))
;; *** main package **************************************************
(define-structure scsh-things
@ -160,8 +194,8 @@
(export backup-layout
restore-layout
load-configuration)
(open scheme list-lib
scsh xlib
(open scheme list-lib handle
scsh xlib rt-modules
utils manager root-manager)
(files config))