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

[Philippe Brochard]

Author: pbrochard
Date: Sun Aug 29 17:04:41 2010
New Revision: 308

Log:
run-other-window-manager: Update for clisp compatibility.

Modified:
   clfswm/ChangeLog
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/tools.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sun Aug 29 17:04:41 2010
@@ -1,5 +1,11 @@
 2010-08-29  Philippe Brochard  <pbrochard at common-lisp.net>
 
+	* src/clfswm-util.lisp (run-other-window-manager): Update for
+	clisp compatibility.
+
+	* src/tools.lisp (do-execute): New parameter io to change the
+	input/output method.
+
 	* src/clfswm-util.lisp (hide-current-child): Prevent from removing
 	the current root.
 

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Sun Aug 29 17:04:41 2010
@@ -537,6 +537,7 @@
 			  collect line)))))
 
 
+
 (defun show-cpu-proc ()
   "Show current processes sorted by CPU usage"
   (info-on-shell "Current processes sorted by CPU usage:"

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sun Aug 29 17:04:41 2010
@@ -1282,9 +1282,8 @@
 
 ;;; Other window manager functions
 (defun get-proc-list ()
-  (let ((proc (do-shell "ps x -o pid=" nil nil))
+  (let ((proc (do-shell "ps x -o pid=" nil t))
 	(proc-list nil))
-    (sleep 0.5)
     (loop for line = (read-line proc nil nil)
        while line
        do (push line proc-list))
@@ -1293,17 +1292,14 @@
 
 (defun run-other-window-manager ()
   (let ((proc-start (get-proc-list)))
-    (do-shell *other-window-manager* nil t)
+    (do-shell *other-window-manager* nil t :terminal)
     (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)))
+      (dbg 'killing-sigterm proc-diff)
+      (do-shell (format nil "kill ~{ ~A ~}  2> /dev/null" proc-diff) nil t :terminal)
+      (dbg 'killing-sigkill proc-diff)
+      (do-shell (format nil "kill -9 ~{ ~A ~} 2> /dev/null" proc-diff) nil t :terminal)
+      (sleep 1))
     (setf *other-window-manager* nil)))
 
 
@@ -1326,7 +1322,11 @@
 
 (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\""))
+  (do-run-other-window-manager "( lxsession & ); xterm -e \"echo '  /----------------------------------\\' ; echo '  |  CLFSWM Note:                    |' ; echo '  |    Close this window when done.  |' ; echo '  \\----------------------------------/'; echo; echo; $SHELL\""))
+
+(defun run-xfce4 ()
+  "Run LXDE (xterm)"
+  (do-run-other-window-manager "( xfce4-session &) ; xterm -e \"echo '  /----------------------------------\\' ; echo '  |  CLFSWM Note:                    |' ; echo '  |    Close this window when done.  |' ; echo '  \\----------------------------------/'; echo; echo; $SHELL\""))
 
 
 (defun run-prompt-wm ()

Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp	(original)
+++ clfswm/src/tools.lisp	Sun Aug 29 17:04:41 2010
@@ -434,37 +434,23 @@
 
 
 ;;; Shell part (taken from ltk)
-(defun do-execute (program args &optional (wt nil))
+(defun do-execute (program args &optional (wt nil) (io :stream))
   "execute program with args a list containing the arguments passed to
 the program   if wt is non-nil, the function will wait for the execution
 of the program to return.
    returns a two way stream connected to stdin/stdout of the program"
+  #-CLISP (declare (ignore io))
   (let ((fullstring program))
     (dolist (a args)
       (setf fullstring (concatenate 'string fullstring " " a)))
-    #+:cmu (let ((proc (ext:run-program program args :input :stream
-							    :output :stream :wait wt)))
+    #+:cmu (let ((proc (ext:run-program program args :input :stream :output :stream :wait wt)))
              (unless proc
                (error "Cannot create process."))
              (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 (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)))
+    #+:clisp (ext:run-program program :arguments args :input io :output io :wait wt)
+    #+:sbcl (let ((proc (sb-ext:run-program program args :input :stream :output :stream :wait wt)))
 	      (unless proc
 		(error "Cannot create process."))
 	      (make-two-way-stream
@@ -488,9 +474,8 @@
 		  (ccl:external-process-output-stream proc)
 		  (ccl:external-process-input-stream proc)))))
 
-(defun do-shell (program &optional args (wt nil))
-  (do-execute "/bin/sh" `("-c" ,program , at args) wt))
-
+(defun do-shell (program &optional args (wait nil) (io :stream))
+  (do-execute "/bin/sh" `("-c" ,program , at args) wait io))