Skip to content
Snippets Groups Projects
Commit de18844e authored by ram's avatar ram
Browse files

Defined new parameterized PRINT-HERALD, exported *HERALD-ITEMS*.

parent c5fc6a27
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.14 1992/03/29 21:54:27 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.15 1992/05/25 21:37:20 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
(in-package "LISP") (in-package "LISP")
(in-package "EXTENSIONS") (in-package "EXTENSIONS")
(export '(print-herald save-lisp *before-save-initializations* (export '(print-herald *herald-items* save-lisp *before-save-initializations*
*after-save-initializations* *environment-list* *editor-lisp-p*)) *after-save-initializations* *environment-list* *editor-lisp-p*))
(in-package "LISP") (in-package "LISP")
...@@ -181,24 +181,51 @@ ...@@ -181,24 +181,51 @@
(funcall init-function))) (funcall init-function)))
(defun print-herald () (defvar *herald-items* ()
(macrolet ((frob (variable) "Determines what PRINT-HERALD prints (the system startup banner.) This is a
`(if (boundp ',variable) database which can be augmented by each loaded system. The format is a
,variable property list which maps from subsystem names to the banner information for
"<not loaded>"))) that system. This list can be manipulated with GETF -- entries are printed
(write-string "CMU Common Lisp ") in, reverse order, so the newest entry is printed last. Usually the system
(write-string (lisp-implementation-version)) feature keyword is used as the system name. A given banner is a list of
(write-string ", running on ") strings and functions (or function names). Strings are printed, and
(write-line (machine-instance)) functions are called with an output stream argument.")
(write-string "Hemlock ")
(write-string (frob *hemlock-version*)) (setf (getf *herald-items* :common-lisp)
(write-string ", Python ") `("CMU Common Lisp "
(write-string (frob compiler-version)) ,#'(lambda (stream)
(when (boundp 'c:*backend*) (write-string (lisp-implementation-version) stream))
(write-string ", target ") ", running on "
(write-string (c:backend-version c:*backend*))) ,#'(lambda (stream) (write-string (machine-instance) stream))))
(terpri)
(write-line "Send bug reports and questions to cmucl-bugs@cs.cmu.edu.")) (setf (getf *herald-items* :bugs)
'("Send bug reports and questions to cmucl-bugs@cs.cmu.edu."
terpri
"Loaded subsystems:"))
;;; PRINT-HERALD -- Public
;;;
(defun print-herald (&optional (stream *standard-output*))
"Print some descriptive information about the Lisp system version and
configuration."
(let ((res ()))
(do ((item *herald-items* (cddr item)))
((null item))
(push (second item) res))
(fresh-line stream)
(dolist (item res)
(dolist (thing item)
(typecase thing
(string
(write-string thing stream))
(function (funcall thing stream))
((or symbol cons)
(funcall (fdefinition thing) stream))
(t
(error "Unrecognized *HERALD-ITEMS* entry: ~S." thing))))
(fresh-line stream)))
(values)) (values))
......
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