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:
parent
04455cd104
commit
6aeb922953
|
@ -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
|
||||
))
|
||||
))
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
Loading…
Reference in New Issue