[clfswm-cvs] r274 - in clfswm: . src

Philippe Brochard pbrochard at common-lisp.net
Tue Apr 13 21:44:15 UTC 2010


Author: pbrochard
Date: Tue Apr 13 17:44:14 2010
New Revision: 274

Log:
run-other-window-manager: Add the ability to launch an other window manager and to return to clfswm.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-layout.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/clfswm.lisp
   clfswm/src/menu-def.lisp
   clfswm/src/package.lisp
   clfswm/src/tools.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Tue Apr 13 17:44:14 2010
@@ -1,3 +1,13 @@
+2010-04-11  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-util.lisp (run-other-window-manager): Add the ability
+	to launch an other window manager and to return to clfswm.
+
+2010-03-18  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-layout.lisp (set-tile-space-layout): Set default
+	to 1%.
+
 2009-12-15  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm.lisp (main-loop): Add a *loop-hook* parameter and a

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Tue Apr 13 17:44:14 2010
@@ -313,7 +313,7 @@
 
 (defun set-tile-space-layout ()
   "Tile Space: tile child in its frame leaving spaces between them"
-  (layout-ask-size "Space size in percent (%)" :tile-space-size 10)
+  (layout-ask-size "Space size in percent (%)" :tile-space-size 0.01)
   (set-layout #'tile-space-layout))
 
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Tue Apr 13 17:44:14 2010
@@ -1277,3 +1277,60 @@
 	 `(,(format nil "Focus window: None")
 	    (#\u unhide-all-windows-in-current-child))))))
 
+
+
+;;; Other window manager functions
+(defun get-proc-list ()
+  (let ((proc (do-shell "ps x -o pid=" nil nil))
+	(proc-list nil))
+    (sleep 0.5)
+    (loop for line = (read-line proc nil nil)
+       while line
+       do (push line proc-list))
+    (dbg proc-list)
+    proc-list))
+
+(defun run-other-window-manager ()
+  (let ((proc-start (get-proc-list)))
+    (do-shell *other-window-manager* nil t)
+    (let* ((proc-end (get-proc-list))
+	   (proc-diff (set-difference proc-end proc-start :test #'equal)))
+      (dbg proc-diff)
+      (dolist (proc proc-diff)
+	(dbg 'killing-sigterm proc)
+	(do-shell (format nil "kill ~A 2> /dev/null" proc) nil t))
+      (sleep 0.5)
+      (dolist (proc proc-diff)
+	(dbg 'killing-sigkill proc)
+	(do-shell (format nil "kill -9 ~A 2> /dev/null" proc) nil t)))
+    (setf *other-window-manager* nil)))
+
+
+(defun do-run-other-window-manager (window-manager)
+  (setf *other-window-manager* window-manager)
+  (throw 'exit-main-loop nil))
+
+(defmacro def-run-other-window-manager (name &optional definition)
+  (let ((definition (or definition name)))
+    `(defun ,(create-symbol "run-" name) ()
+       ,(format nil "Run ~A" definition)
+       (do-run-other-window-manager ,(format nil "~A" name)))))
+
+(def-run-other-window-manager "xterm")
+(def-run-other-window-manager "icewm")
+(def-run-other-window-manager "twm")
+(def-run-other-window-manager "gnome-session" "Gnome")
+(def-run-other-window-manager "startkde" "KDE")
+(def-run-other-window-manager "xfce4-session" "XFCE")
+
+(defun run-lxde ()
+  "Run LXDE"
+  (do-run-other-window-manager "lxsession; xterm -e \"echo '  /----------------------------------\\' ; echo '  |  CLFSWM Note:                    |' ; echo '  |    Close this window when done.  |' ; echo '  \\----------------------------------/'; echo; echo; $SHELL\""))
+
+
+(defun run-prompt-wm ()
+  "Prompt for an other window manager"
+  (let ((wm (query-string "Run an other window manager:" "icewm")))
+    (do-run-other-window-manager wm)))
+
+

Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp	(original)
+++ clfswm/src/clfswm.lisp	Tue Apr 13 17:44:14 2010
@@ -329,7 +329,6 @@
     (xlib:close-display *display*)))
 
 
-
 (defun main (&key (display (or (getenv "DISPLAY") ":0")) protocol
 	     (base-dir (directory-namestring (or *load-truename* "")))
 	     (read-conf-file-p t)
@@ -338,10 +337,12 @@
     (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)
+	     (if *other-window-manager*
+		 (run-other-window-manager)
+		 (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)))
 	       (format t "~&~A~%Reinitializing...~%" msg)

Modified: clfswm/src/menu-def.lisp
==============================================================================
--- clfswm/src/menu-def.lisp	(original)
+++ clfswm/src/menu-def.lisp	Tue Apr 13 17:44:14 2010
@@ -202,6 +202,16 @@
 (add-menu-key 'utility-menu "i" 'identify-key)
 (add-menu-key 'utility-menu "colon" 'eval-from-query-string)
 (add-menu-key 'utility-menu "exclam" 'run-program-from-query-string)
+(add-sub-menu 'utility-menu "o" 'other-window-manager-menu "Other window manager menu")
+
+(add-menu-key 'other-window-manager-menu "x" 'run-xterm)
+(add-menu-key 'other-window-manager-menu "t" 'run-twm)
+(add-menu-key 'other-window-manager-menu "i" 'run-icewm)
+(add-menu-key 'other-window-manager-menu "g" 'run-gnome-session)
+(add-menu-key 'other-window-manager-menu "k" 'run-startkde)
+(add-menu-key 'other-window-manager-menu "c" 'run-xfce4-session)
+(add-menu-key 'other-window-manager-menu "l" 'run-lxde)
+(add-menu-key 'other-window-manager-menu "p" 'run-prompt-wm)
 
 
 (add-menu-key 'clfswm-menu "r" 'reset-clfswm)

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Tue Apr 13 17:44:14 2010
@@ -163,6 +163,9 @@
 (defparameter *circulate-keys-release* nil)
 
 
+(defparameter *other-window-manager* nil)
+
+
 (defstruct menu name item doc)
 (defstruct menu-item key value)
 

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Tue Apr 13 17:44:14 2010
@@ -422,12 +422,19 @@
              (make-two-way-stream
               (ext:process-output proc)
               (ext:process-input proc)))
-    #+:clisp (let ((proc (ext:run-program program :arguments args
-						  :input :stream :output
-						  :stream :wait (or wt t))))
-	       (unless proc
-		 (error "Cannot create process."))
-	       proc)
+    ;;    #+:clisp (let ((proc (ext:run-program program :arguments args
+    ;;						  :input :stream :output :stream :wait (or wt t))))
+    ;;	       (unless proc
+    ;;		 (error "Cannot create process."))
+    ;;	       proc)
+    #+:clisp (if wt
+		 (ext:run-program program :arguments args
+				  :input :terminal :output :terminal :wait t)
+		 (let ((proc (ext:run-program program :arguments args
+					      :input :stream :output :stream :wait wt)))
+		   (unless proc
+		     (error "Cannot create process."))
+		   proc))
     #+:sbcl (let ((proc (sb-ext:run-program program args :input
 							 :stream :output
 							 :stream :wait wt)))




More information about the clfswm-cvs mailing list