[beirc-cvs] CVS beirc

[afuchs]

Update of /project/beirc/cvsroot/beirc
In directory clnet:/tmp/cvs-serv9898

Modified Files:
	application.lisp 
Log Message:
Add an option to defun beirc to not start a new process.

Required if you want to start beirc in a toplevel function


--- /project/beirc/cvsroot/beirc/application.lisp	2006/03/27 13:46:47	1.70
+++ /project/beirc/cvsroot/beirc/application.lisp	2006/03/27 21:38:43	1.71
@@ -295,23 +295,27 @@
 
 ;;;
 
-(defun beirc ()
+(defun beirc (&key (new-process t))
   (let* ((syms '(*package* *trace-output*))
-         (vals (mapcar #'symbol-value syms)))
-    (setf *gui-process*
-          (clim-sys:make-process
-           (lambda ()
-             (progv syms vals
-               (let* ((frame (make-application-frame 'beirc))
-                      (ticker-process (clim-sys:make-process (lambda () (ticker frame))
-                                                             :name "Beirc Ticker")))
-                 (setf *beirc-frame* frame)
-                 (load-user-init-file)
-                 (run-frame-top-level frame)
-                 (clim-sys:destroy-process ticker-process)
-	     (disconnect-all frame "Client Quit"))))
-       ;; added process name for easier debug...
-       :name "BEIRC GUI process"))))
+         (vals (mapcar #'symbol-value syms))
+         (program (lambda ()
+                    (progv syms vals
+                      (let* ((frame (make-application-frame 'beirc))
+                             (ticker-process (clim-sys:make-process (lambda () (ticker frame))
+                                                                    :name "Beirc Ticker")))
+                        (setf *beirc-frame* frame)
+                        (load-user-init-file)
+                        (run-frame-top-level frame)
+                        (clim-sys:destroy-process ticker-process)
+                        (disconnect-all frame "Client Quit"))))))
+    (cond
+      (new-process
+        (setf *gui-process*
+              (clim-sys:make-process program
+                                     ;; added process name for easier debug...
+                                     :name "BEIRC GUI process")))
+      (t (setf *gui-process* (clim-sys:current-process))
+         (funcall program)))))
 
 
 (defun message-directed-to-me-p (message)