-(defun banner (title output &key (blank-line-p t))
- (format output "~&/*----- ~A ~A*/~%"
- title
- (make-string (- 77 2 5 1 (length title) 1 2)
- :initial-element #\-))
- (when blank-line-p
- (terpri output)))
-
-(defun guard-name (filename)
- "Return a sensible inclusion guard name for FILENAME."
- (with-output-to-string (guard)
- (let* ((pathname (make-pathname :name (pathname-name filename)
- :type (pathname-type filename)))
- (name (namestring pathname))
- (uscore t))
- (dotimes (i (length name))
- (let ((ch (char name i)))
- (cond ((alphanumericp ch)
- (write-char (char-upcase ch) guard)
- (setf uscore nil))
- ((not uscore)
- (write-char #\_ guard)
- (setf uscore t))))))))
-
-;;;--------------------------------------------------------------------------
-;;; Driving output.
-
-(defun guess-output-file (module type)
- (merge-pathnames (make-pathname :type type :case :common)
- (module-name module)))
-
-(defun output-module (module reason stream)
- (let ((sequencer (make-instance 'sequencer))
- (stream (if (typep stream 'position-aware-output-stream)
- stream
- (make-instance 'position-aware-output-stream
- :stream stream
- :file (or (stream-pathname stream)
- #p"<unnamed>")))))
- (add-output-hooks module reason sequencer)
- (invoke-sequencer-items sequencer stream)))
-