Skip to content
Snippets Groups Projects
Commit 62104ee1 authored by dtc's avatar dtc
Browse files

o Based on suggestions from Martin Cracauer, flush commonly used output

  streams during the processing of command line switches and upon exit.
  This is a convenience for typical usage, and not all output streams
  are flushed, so important streams should still be flushed but user code.

o Add a new function finish-standard-output-streams to finish output on
  the commonly used output streams. Called after the processing
  of each command line switch, and before the %end-of-the-world.

o Extend the eval switch to process multiple forms, flushing the common
  output streams between each.
parent 573309b4
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/commandline.lisp,v 1.6 1996/05/08 02:03:08 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/commandline.lisp,v 1.7 2000/08/24 19:55:29 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -155,7 +155,8 @@ ...@@ -155,7 +155,8 @@
(cond (demon (funcall demon switch)) (cond (demon (funcall demon switch))
((or (member name *legal-cmd-line-switches* :test #'string-equal) ((or (member name *legal-cmd-line-switches* :test #'string-equal)
(not *complain-about-illegal-switches*))) (not *complain-about-illegal-switches*)))
(t (warn "~S is an illegal switch" switch)))))) (t (warn "~S is an illegal switch" switch)))
(lisp::finish-standard-output-streams))))
(defmacro defswitch (name &optional function) (defmacro defswitch (name &optional function)
"Associates function with the switch name in *command-switch-demons*. Name "Associates function with the switch name in *command-switch-demons*. Name
...@@ -175,7 +176,15 @@ ...@@ -175,7 +176,15 @@
(defun eval-switch-demon (switch) (defun eval-switch-demon (switch)
(eval (read-from-string (cmd-switch-arg switch)))) (let ((cmds (cmd-switch-arg switch)))
(do ((length (length cmds))
(start 0))
((>= start length))
(multiple-value-bind (form next)
(read-from-string cmds nil nil :start start)
(eval form)
(lisp::finish-standard-output-streams)
(setf start next)))))
(defswitch "eval" #'eval-switch-demon) (defswitch "eval" #'eval-switch-demon)
(defun load-switch-demon (switch) (defun load-switch-demon (switch)
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.36 1998/06/24 20:30:36 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.37 2000/08/24 19:55:29 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -160,46 +160,51 @@ ...@@ -160,46 +160,51 @@
((restart-lisp () ((restart-lisp ()
(unix:unix-exit (unix:unix-exit
(catch '%end-of-the-world (catch '%end-of-the-world
(with-simple-restart (abort "Skip remaining initializations.") (unwind-protect
(catch 'top-level-catcher (progn
(reinit) (with-simple-restart (abort "Skip remaining initializations.")
(environment-init) (catch 'top-level-catcher
(dolist (f *after-save-initializations*) (funcall f)) (reinit)
(when process-command-line (environment-init)
(ext::process-command-strings)) (dolist (f *after-save-initializations*) (funcall f))
(setf *editor-lisp-p* nil) (when process-command-line
(macrolet ((find-switch (name) (ext::process-command-strings))
`(find ,name *command-line-switches* (setf *editor-lisp-p* nil)
(macrolet ((find-switch (name)
`(find ,name *command-line-switches*
:key #'cmd-switch-name :key #'cmd-switch-name
:test #'(lambda (x y) :test #'(lambda (x y)
(declare (simple-string x y)) (declare (simple-string x y))
(string-equal x y))))) (string-equal x y)))))
(when site-init (when site-init
(load site-init :if-does-not-exist nil :verbose nil)) (load site-init :if-does-not-exist nil :verbose nil))
(when (and process-command-line (find-switch "edit")) (when (and process-command-line (find-switch "edit"))
(setf *editor-lisp-p* t)) (setf *editor-lisp-p* t))
(when (and load-init-file (when (and load-init-file
(not (and process-command-line (not (and process-command-line
(find-switch "noinit")))) (find-switch "noinit"))))
(let* ((cl-switch (find-switch "init")) (let* ((cl-switch (find-switch "init"))
(name (and cl-switch (name (and cl-switch
(or (cmd-switch-value cl-switch) (or (cmd-switch-value cl-switch)
(car (cmd-switch-words (car (cmd-switch-words
cl-switch)))))) cl-switch))))))
(if name (if name
(load (merge-pathnames name #p"home:") (load (merge-pathnames name #p"home:")
:if-does-not-exist nil) :if-does-not-exist nil)
(or (load "home:init" :if-does-not-exist nil) (or (load "home:init" :if-does-not-exist nil)
(load "home:.cmucl-init" (load "home:.cmucl-init"
:if-does-not-exist nil)))))) :if-does-not-exist nil))))))
(when process-command-line (when process-command-line
(ext::invoke-switch-demons *command-line-switches* (ext::invoke-switch-demons *command-line-switches*
*command-switch-demons*)) *command-switch-demons*))
(when print-herald (when print-herald
(print-herald)))) (print-herald))))
(funcall (if (and *batch-mode* (eq init-function #'%top-level)) (funcall (if (and *batch-mode*
#'%handled-top-level (eq init-function #'%top-level))
init-function)))))) #'%handled-top-level
init-function)))
(finish-standard-output-streams))))))
(let ((initial-function (get-lisp-obj-address #'restart-lisp))) (let ((initial-function (get-lisp-obj-address #'restart-lisp)))
(without-gcing (without-gcing
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.43 2000/07/23 14:59:43 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.44 2000/08/24 19:55:29 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1745,3 +1745,16 @@ ...@@ -1745,3 +1745,16 @@
((>= i end) seq) ((>= i end) seq)
(declare (type index i)) (declare (type index i))
(funcall write-function (aref seq i) stream))))))) (funcall write-function (aref seq i) stream)))))))
;;; finish-standard-output-streams -- Public
;;;
;;; Finish output on some of the standard output streams.
;;;
(defun finish-standard-output-streams ()
(dolist (stream '(*standard-output* *error-output* *trace-output*))
(when (boundp stream)
(let ((stream (symbol-value stream)))
(when (and (streamp stream) (open-stream-p stream))
(finish-output stream))))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment