/[cmucl]/src/interface/interface.lisp
ViewVC logotype

Diff of /src/interface/interface.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by garland, Tue Mar 9 13:14:00 1993 UTC revision 1.6 by ram, Fri Feb 11 20:58:14 1994 UTC
# Line 289  Line 289 
289                (eq status :signaled))                (eq status :signaled))
290        (setf *system-motif-server* nil))))        (setf *system-motif-server* nil))))
291    
292    (defvar *server-startup-timeout* 30)
293    
294  (defun verify-system-server-exists ()  (defun verify-system-server-exists ()
295    (when (and (not xt:*default-server-host*)    (when (and (not xt:*default-server-host*)
296               (or (not *system-motif-server*)               (or (not *system-motif-server*)
297                   (and *system-motif-server*                   (and *system-motif-server*
298                        (not (ext:process-alive-p *system-motif-server*)))))                        (not (ext:process-alive-p *system-motif-server*)))))
299      (let ((process (ext:run-program (merge-pathnames *clm-binary-name*      (let ((process (ext:run-program
300                                                       *clm-binary-directory*)                      (merge-pathnames *clm-binary-name*
301                                      '("-nofork" "-local")                                       *clm-binary-directory*)
302                                      :wait nil                      '("-nofork" "-local")
303                                      :status-hook #'system-server-status-hook)))                      :output *error-output*
304                        :error :output
305                        :wait nil
306                        :status-hook #'system-server-status-hook)))
307        (unless (and process (ext:process-alive-p process))        (unless (and process (ext:process-alive-p process))
308          (xti:toolkit-error "Could not start Motif server process."))          (xti:toolkit-error "Could not start Motif server process.~@
309                                Status = ~S, exit code = ~D."
310                               (ext:process-status process)
311                               (ext:process-exit-code process)))
312        ;;        ;;
313        ;; Wait until the server has started up        ;; Wait until the server has started up
314        (loop        (let ((sock-name (format nil "/tmp/.motif_socket-p~D"
315          (when (probe-file (format nil "/tmp/.motif_socket-p~a"                                 (ext:process-pid process)))
316                                    (ext:process-pid process)))              (end-time (+ (get-internal-real-time)
317            (return))                           (* internal-time-units-per-second
318          (sleep 2))                              *server-startup-timeout*))))
319        (setf *system-motif-server* process))))          (loop
320              (when (probe-file sock-name)
321                (return))
322              (system:serve-event 1)
323              (when (> (get-internal-real-time) end-time)
324                (xti:toolkit-error
325                 "Timed out waiting for Motif server to start up.")))
326            (setf *system-motif-server* process)))))
327    
328    
329    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.5