r3623: *** empty log message ***

diff --git a/cl-symbols.lisp b/cl-symbols.lisp
index e8bfc909c879a4eaebe941c2862d602cb2a4f5e7..97a9a92ef3405bf5c031020c6194ce97534d3a5c 100644 (file)
--- a/cl-symbols.lisp
+++ b/cl-symbols.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: cl-symbols.lisp,v 1.3 2002/10/10 16:23:48 kevin Exp $
+;;;; $Id: cl-symbols.lisp,v 1.4 2002/12/13 21:59:57 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -42,3 +42,32 @@
                   (fboundp sym))
          (push sym funcs))))
     (nreverse funcs)))
+
+;;; Symbol functions
+
+(defun concat-symbol-pkg (pkg &rest args)
+  (declare (dynamic-extent args))
+  (flet ((stringify (arg)
+           (etypecase arg
+             (string
+              (string-upcase arg))
+             (symbol
+              (symbol-name arg)))))
+    (let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
+      (intern #-case-sensitive (string-upcase str)
+             #+case-sensitive str
+             (if pkg pkg *package*)))))
+
+
+(defun concat-symbol (&rest args)
+  (apply #'concat-symbol-pkg nil args))
+
+(defun ensure-keyword (name)
+  "Returns keyword for a name"
+  (etypecase name
+    (keyword name)
+    (string (values (intern
+                    #-case-sensitive (string-upcase name)
+                    #+case-sensitive name
+                    :keyword)))
+    (symbol (values (intern (symbol-name name)) :keyword))))

diff --git a/console.lisp b/console.lisp
new file mode 100644 (file)
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))

diff --git a/genutils.lisp b/genutils.lisp
index fafc9024f028b14641619481bd15b0fbcd0838e1..04678e6aeeb2cc23a032256fff845e2f0b300930 100644 (file)
--- a/genutils.lisp
+++ b/genutils.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: genutils.lisp,v 1.11 2002/12/04 16:49:23 kevin Exp $
+;;;; $Id: genutils.lisp,v 1.12 2002/12/13 21:59:57 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -325,15 +325,6 @@
     (terpri ostrm)))
 
 
-;;; Symbol functions
-
-(defmacro concat-symbol (&rest args)
-  `(intern (concatenate 'string ,@args)))
-
-(defmacro concat-symbol-pkg (pkg &rest args)
-  `(intern (concatenate 'string ,@args) ,pkg))
-
-
 ;;; IO
 
 

diff --git a/kmrcl.asd b/kmrcl.asd
index d3c69b5fb94ffab7f7bd5c53a7341347baaa3cfb..83ccb5ae5ec255b51acab40cd201352c7f0a0b4b 100644 (file)
--- a/kmrcl.asd
+++ b/kmrcl.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: kmrcl.asd,v 1.22 2002/11/25 07:45:36 kevin Exp $
+;;;; $Id: kmrcl.asd,v 1.23 2002/12/13 21:59:57 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -23,6 +23,7 @@
                      (pushnew :kmrcl cl:*features*))
     :components 
     ((:file "package")
+     (:file "console" :depends-on ("package"))
      (:file "genutils" :depends-on ("package"))
      (:file "strings" :depends-on ("package"))
      (:file "equal" :depends-on ("package"))

diff --git a/package.lisp b/package.lisp
index 757c9165bcff0bbeff02aa588d3e9e9722f32fb0..b71a95da384a3960f706f300e1f6a827ca5180bf 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: package.lisp,v 1.15 2002/12/04 16:49:23 kevin Exp $
+;;;; $Id: package.lisp,v 1.16 2002/12/13 21:59:57 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -65,8 +65,6 @@
          #:indent-spaces
          #:print-list
          #:print-rows
-         #:concat-symbol
-         #:concat-symbol-pkg
          #:file-subst
          #:stream-subst
          #:remove-tree-if
@@ -83,7 +81,12 @@
          #:in
          #:mean
          #:with-gensyms
-         
+
+         ;; symbols.lisp
+         #:ensure-keyword
+         #:concat-symbol
+         #:concat-symbol-pkg
+
          ;; From attrib-class.lisp
          #:attributes-class
          #:slot-attribute
@@ -119,6 +122,14 @@
          #:xml-tag-contents
          #:positions-xml-tag-contents
          #:xml-cdata
+         
+         ;; From console
+         *console-msgs*
+         cmsg
+         cmsg-c
+         cmsg-add
+         cmsg-remove
+         fixme
          ))