debian update
[kmrcl.git] / console.lisp
1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
4 ;;;;
5 ;;;; Name:          console.lisp
6 ;;;; Purpose:       Console interactiion
7 ;;;; Programmer:    Kevin M. Rosenberg
8 ;;;; Date Started:  Dec 2002
9 ;;;;
10 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
11 ;;;; and by onShore Development, Inc.
12 ;;;;
13 ;;;; KMRCL users are granted the rights to distribute and use this software
14 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
15 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
16 ;;;; *************************************************************************
17
18 (in-package #:kmrcl)
19
20 (defvar *console-msgs* t)
21
22 (defvar *console-msgs-types* nil)
23
24 (defun cmsg (template &rest args)
25   "Format output to console"
26   (when *console-msgs*
27     (setq template (concatenate 'string "~&;; " template "~%"))
28     (apply #'format t template args)))
29
30 (defun cmsg-c (condition template &rest args)
31   "Push CONDITION keywords into *console-msgs-types* to print console msgs
32    for that CONDITION.  TEMPLATE and ARGS function identically to
33    (format t TEMPLATE ARGS) "
34   (when (or (member :verbose *console-msgs-types*)
35             (member condition *console-msgs-types*))
36     (apply #'cmsg template args)))
37
38 (defun cmsg-add (condition)
39   (pushnew condition *console-msgs-types*))
40
41 (defun cmsg-remove (condition)
42   (setf *console-msgs-types* (remove condition *console-msgs-types*)))
43
44 (defun fixme (template &rest args)
45   "Format output to console"
46   (setq template (concatenate 'string "~&;; ** FIXME ** " template "~%"))
47   (apply #'format t template args)
48   (values))