111 lines
3.3 KiB
Scheme
111 lines
3.3 KiB
Scheme
;; *** layout ********************************************************
|
|
|
|
(define (get-root-layout root-wm)
|
|
(letrec ((loop (lambda (wm)
|
|
(let ((children
|
|
(filter
|
|
(lambda (x) x)
|
|
(map (lambda (c)
|
|
(get-manager-by-window root-wm
|
|
(client:window c)))
|
|
(wm-clients wm))))
|
|
(diff (if (wm:special-options wm)
|
|
(get-options-diff (wm:special-options wm))
|
|
'())))
|
|
(cons (manager-type-name (wm:type wm))
|
|
(cons diff
|
|
(map loop children)))))))
|
|
(cddr (loop (root-wm:initial-manager root-wm)))))
|
|
|
|
(define (create-root-layout root-wm layout)
|
|
(letrec ((loop (lambda (parent spec)
|
|
(let ((type (car spec))
|
|
(special-options (cadr spec))
|
|
(more (cddr spec)))
|
|
(let* ((type2 (cond
|
|
((eq? 'split type) (manager-type split))
|
|
((eq? 'switch type) (manager-type switch))
|
|
((eq? 'move type) (manager-type move))))
|
|
;; else error ?!
|
|
(options
|
|
((cond
|
|
((eq? 'split type) root-wm:split-options)
|
|
((eq? 'switch type) root-wm:switch-options)
|
|
((eq? 'move type) root-wm:move-options))
|
|
root-wm))
|
|
|
|
(wm (create-new-manager root-wm type2
|
|
options special-options
|
|
parent)))
|
|
(for-each (lambda (spec)
|
|
(loop wm spec))
|
|
more))))))
|
|
(for-each (lambda (spec)
|
|
(loop (root-wm:initial-manager root-wm) spec))
|
|
layout)))
|
|
|
|
(define (layout-filename dpy)
|
|
(let ((dir (resolve-tilde-file-name "~/.orion-wm")))
|
|
(if (not (file-exists? dir))
|
|
(create-directory dir))
|
|
(string-append dir "/layout-" (display:name dpy))))
|
|
|
|
(define (backup-layout root-wm)
|
|
(call-with-output-file (layout-filename (root-wm:dpy root-wm))
|
|
(lambda (p)
|
|
(for-each (lambda (spec)
|
|
(write spec p))
|
|
(get-root-layout root-wm)))))
|
|
|
|
(define (restore-layout root-wm)
|
|
(let* ((fn (layout-filename (root-wm:dpy root-wm)))
|
|
(layout (if (file-exists? fn)
|
|
(call-with-input-file fn
|
|
(lambda (p) (port->sexp-list p)))
|
|
;; if no layout file exists, one switch-wm
|
|
;; workspace is the default
|
|
'((switch ())))))
|
|
(create-root-layout root-wm layout)))
|
|
|
|
;; *** configuration *************************************************
|
|
|
|
(define (config-filename dpy)
|
|
(let ((dir (resolve-tilde-file-name "~/.orion-wm")))
|
|
(if (not (file-exists? dir))
|
|
(create-directory dir))
|
|
(string-append dir "/config-" (display:name dpy))))
|
|
|
|
(define (load-configuration dpy)
|
|
(let ((filename (config-filename dpy)))
|
|
(if (file-exists? filename)
|
|
(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 'split-options
|
|
(get 'split-options))
|
|
(cons 'switch-options
|
|
(get 'switch-options))
|
|
(cons 'move-options
|
|
(get 'move-options)))
|
|
(get 'root-options))))))))
|
|
'())))
|
|
|
|
(define default-config-file
|
|
'(
|
|
(define-structure config-file config-file-interface
|
|
(open scheme xlib config-file-utils)
|
|
(begin
|
|
;; your options here
|
|
))
|
|
))
|