X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=console.lisp;fp=console.lisp;h=3e81b23e056f95b1f578445267fcb3fedd75f3eb;hp=0000000000000000000000000000000000000000;hb=29aa484de6bd54a2a38792057a2d9f72b534a42c;hpb=8a34334f88041c6043d8e154c91aae115293ec66

diff --git a/console.lisp b/console.lisp
new file mode 100644
index 0000000..3e81b23
--- /dev/null
+++ b/console.lisp
@@ -0,0 +1,51 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          console.lisp
+;;;; Purpose:       Console interactiion
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Dec 2002
+;;;;
+;;;; $Id: console.lisp,v 1.1 2002/12/13 21:59:57 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; and by onShore Development, Inc.
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :kmrcl)
+
+(defvar *console-msgs* t)
+
+(defvar *console-msgs-types* nil)
+
+(defun cmsg (template &rest args)
+  "Format output to console"
+  (when *console-msgs*
+    (setq template (concatenate 'string "~&;; " template "~%"))
+    (apply #'format t template args))
+  (values))
+
+(defun cmsg-c (condition template &rest args)
+  "Push CONDITION keywords into *console-msgs-types* to print console msgs
+   for that CONDITION.  TEMPLATE and ARGS function identically to
+   (format t TEMPLATE ARGS) "
+  (when (or (member :verbose *console-msgs-types*)
+            (member condition *console-msgs-types*))
+    (apply #'cmsg template args)))
+
+(defun cmsg-add (condition)
+  (pushnew condition *console-msgs-types*))
+
+(defun cmsg-remove (condition)
+  (setf *console-msgs-types* (remove condition *console-msgs-types*)))
+
+(defun fixme (template &rest args)
+  "Format output to console"
+  (setq template (concatenate 'string "~&;; ** FIXME ** " template "~%"))
+  (apply #'format t template args)
+  (values))