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)