adding user configuration abilities

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)))
+	'())))

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"))