[clfswm-cvs] r270 - in clfswm: . contrib src

[Philippe Brochard]

Author: pbrochard
Date: Sat Dec  5 15:50:32 2009
New Revision: 270

Log:
src/clfswm.lisp (main): Add an alternate configuration filename parameter. load.lisp: Add a debuging code example.

Modified:
   clfswm/ChangeLog
   clfswm/contrib/reboot-halt.lisp
   clfswm/load.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/clfswm.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat Dec  5 15:50:32 2009
@@ -1,3 +1,10 @@
+2009-12-05  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm.lisp (main): Add an alternate configuration filename
+	parameter.
+
+	* load.lisp: Add a debuging code example.
+
 2009-11-14  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-configuration.lisp (create-configuration-menu): New

Modified: clfswm/contrib/reboot-halt.lisp
==============================================================================
--- clfswm/contrib/reboot-halt.lisp	(original)
+++ clfswm/contrib/reboot-halt.lisp	Sat Dec  5 15:50:32 2009
@@ -55,7 +55,7 @@
   (do-with-terminal "sudo halt"))
 
 (unless (find-menu 'reboot-halt-menu)
-  (add-sub-menu 'help-menu "Pause" 'reboot-halt-menu "Suspend/Reboot/Halt menu")
+  (add-sub-menu 'clfswm-menu "Pause" 'reboot-halt-menu "Suspend/Reboot/Halt menu")
   (add-menu-key 'reboot-halt-menu "s" 'do-suspend)
   (add-menu-key 'reboot-halt-menu "r" 'do-reboot)
   (add-menu-key 'reboot-halt-menu "h" 'do-halt))

Modified: clfswm/load.lisp
==============================================================================
--- clfswm/load.lisp	(original)
+++ clfswm/load.lisp	Sat Dec  5 15:50:32 2009
@@ -60,3 +60,13 @@
 ;;(produce-all-docs)
 
 
+;;; For debuging: start Xnest or Zephyr and
+;;; add the lines above in a dot-clfswmrc-debug file
+;;(setf *default-modifiers* '(:mod-2))
+;;
+;;(defun my-add-escape ()
+;;  (define-main-key ("Escape" :mod-2) 'exit-clfswm))
+;;
+;;(add-hook *binding-hook* 'my-add-escape)
+;;
+;;(clfswm:main :display ":1" :alternate-conf #P"/where/is/dot-clfswmrc-debug")

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sat Dec  5 15:50:32 2009
@@ -32,12 +32,17 @@
 					       (getenv "HOME"))
 				   "/")))
 
-(defun conf-file-name ()
-  (let* ((user-conf (probe-file (merge-pathnames (user-homedir-pathname) #p".clfswmrc")))
-	 (etc-conf (probe-file #p"/etc/clfswmrc"))
-	 (config-user-conf (probe-file (make-pathname :directory (append (xdg-config-home) '("clfswm"))
-						      :name "clfswmrc"))))
-    (or config-user-conf user-conf etc-conf)))
+(let ((saved-conf-name nil))
+  (defun conf-file-name (&optional alternate-name)
+    (unless (and saved-conf-name (not alternate-name))
+      (let* ((user-conf (probe-file (merge-pathnames (user-homedir-pathname) #p".clfswmrc")))
+	     (etc-conf (probe-file #p"/etc/clfswmrc"))
+	     (config-user-conf (probe-file (make-pathname :directory (append (xdg-config-home) '("clfswm"))
+							  :name "clfswmrc")))
+	     (alternate-conf (probe-file alternate-name)))
+	(setf saved-conf-name (or alternate-conf config-user-conf user-conf etc-conf))))
+    (print saved-conf-name)
+    saved-conf-name))
 
 
 

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Sat Dec  5 15:50:32 2009
@@ -296,9 +296,10 @@
 
 (defun main-unprotected (&key (display (or (getenv "DISPLAY") ":0")) protocol
 			 (base-dir (directory-namestring (or *load-truename* "")))
-			 (read-conf-file-p t)
+			 (read-conf-file-p t) (alternate-conf nil)
 			 error-msg)
   (setf *contrib-dir* base-dir)
+  (conf-file-name alternate-conf)
   (when read-conf-file-p
     (read-conf-file))
   (handler-case
@@ -330,13 +331,15 @@
 
 (defun main (&key (display (or (getenv "DISPLAY") ":0")) protocol
 	     (base-dir (directory-namestring (or *load-truename* "")))
-	     (read-conf-file-p t))
+	     (read-conf-file-p t)
+	     (alternate-conf nil))
   (let (error-msg)
     (catch 'exit-clfswm
       (loop
 	 (handler-case
 	     (main-unprotected :display display :protocol protocol :base-dir base-dir
 			       :read-conf-file-p read-conf-file-p
+			       :alternate-conf alternate-conf
 			       :error-msg error-msg)
 	   (error (c)
 	     (let ((msg (format nil "CLFSWM Error: ~A." c)))