diff --git a/src/config.scm b/src/config.scm new file mode 100644 index 0000000..835b97a --- /dev/null +++ b/src/config.scm @@ -0,0 +1,110 @@ +;; *** 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))))) + (cons (manager-type-name (wm:type wm)) + (cons (get-options-diff (wm:options wm)) + (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)) + (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 ?! + (def-opt + (get-option-value + (root-wm:options root-wm) + (cond + ((eq? 'split type) 'default-split-options) + ((eq? 'switch type) 'default-switch-options) + ((eq? 'move type) 'default-move-options)))) + + (wm (create-new-manager root-wm type2 + (append options def-opt) + 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)))) + (if (file-exists? fn) + (call-with-input-file fn + (lambda (p) + (create-root-layout root-wm + (port->sexp-list p)))) + '()))) + +;; *** 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) + (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 + (append (list (cons 'default-split-options + split-options) + (cons 'default-switch-options + switch-options) + (cons 'default-move-options + move-options)) + root-options)) )) + (eval 'root-options (interaction-environment))) + '()))) diff --git a/src/main.scm b/src/main.scm index 5c1b439..8badb84 100644 --- a/src/main.scm +++ b/src/main.scm @@ -6,16 +6,24 @@ (synchronize dpy #t) (init-sync-x-events dpy) ;; for debugging: - (spawn (lambda () - (let loop ((se (most-recent-sync-x-event))) - (let ((e (sync-x-event-event se))) - (if (not (eq? e 'no-event)) - (display-event e)) - (loop (next-sync-x-event se (lambda (e) #t))))))) +; (spawn (lambda () +; (let loop ((se (most-recent-sync-x-event))) +; (let ((e (sync-x-event-event se))) +; (if (not (eq? e 'no-event)) +; (display-event e)) +; (loop (next-sync-x-event se (lambda (e) #t))))))) - (let ((root-manager (create-root-wm dpy '()))) ;; TODO: options + (let* ((initial-windows (window-children dpy (default-root-window dpy))) + (root-options (load-configuration dpy)) + (root-manager (create-root-wm dpy root-options))) + (restore-layout root-manager) + (for-each (lambda (window) + (root-wm-manage-window root-manager window)) + initial-windows) + (map-window dpy (wm:window (root-wm:initial-manager root-manager))) + (wait-for-root-wm root-manager) + (backup-layout root-manager) (display "Orion-wm finished\n")))) (define (display-event e) - ;;(mdisplay "event: " (any-event-type e) " " (any-event-window e) "\n")) - #t) + (mdisplay "event: " (any-event-type e) " " (any-event-window e) "\n"))