scsh-conservatory
/
orion-wm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
src/config.scm
View File

@ -76,36 +76,34 @@
(define (load-configuration dpy) (define (load-configuration dpy)
(let ((filename (config-filename dpy))) (let ((filename (config-filename dpy)))
(if (file-exists? filename) (if (file-exists? filename)
(begin (call-with-current-continuation
;; exceptions ?? (lambda (return)
(for-each (lambda (exp) (with-handler
(eval exp (interaction-environment))) (lambda (condition punt)
`( (define root-options '()) (mdisplay "error loading configuration file " filename ".\n")
(define split-options '()) (mdisplay "problem is: " condition "\n")
(define switch-options '()) (mdisplay "ignoring it...\n")
(define move-options '()) (return '()))
(define-syntax define-option (lambda ()
(syntax-rules (load-config-file filename)
() (let ((config-file (reify-structure 'config-file)))
((define-option list name value) (load-structure config-file)
(set! list (cons (cons (quote name) value) (let ((get (lambda (n) (rt-structure-binding config-file n))))
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
(append (list (cons 'default-split-options (append (list (cons 'default-split-options
split-options) (get 'split-options))
(cons 'default-switch-options (cons 'default-switch-options
switch-options) (get 'switch-options))
(cons 'default-move-options (cons 'default-move-options
move-options)) (get 'move-options)))
root-options)) )) (get 'root-options))))))))
(eval 'root-options (interaction-environment))) ;; 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
))
))

38
src/packages.scm
View File

@ -150,6 +150,40 @@
utils key-grab) utils key-grab)
(files switch-wm)) (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 ************************************************** ;; *** main package **************************************************
(define-structure scsh-things (define-structure scsh-things
@ -160,8 +194,8 @@
(export backup-layout (export backup-layout
restore-layout restore-layout
load-configuration) load-configuration)
(open scheme list-lib (open scheme list-lib handle
scsh xlib scsh xlib rt-modules
utils manager root-manager) utils manager root-manager)
(files config)) (files config))