;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: symbols.lisp,v 1.1 2003/04/28 23:51:59 kevin Exp $
+;;;; $Id: symbols.lisp,v 1.4 2003/07/19 20:32:48 kevin Exp $
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(in-package :kmrcl)
+(in-package #:kmrcl)
(defun cl-symbols ()
(append (cl-variables) (cl-functions)))
;;; Symbol functions
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (char= #\a (schar (symbol-name '#:a) 0))
+ (pushnew :lowercase-reader *features*)))
+
+(defun string-default-case (str)
+ #+(and (not case-sensitive) (not lowercase-reader))
+ (string-upcase str)
+ #+(and (not case-sensitive) lowercase-reader)
+ (string-downcase str)
+ #+case-sensitive
+ str)
+
(defun concat-symbol-pkg (pkg &rest args)
(declare (dynamic-extent args))
(flet ((stringify (arg)
(symbol
(symbol-name arg)))))
(let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
- (intern #-case-sensitive (string-upcase str)
- #+case-sensitive str
+ (intern (string-default-case str)
(if pkg pkg *package*)))))
"Returns keyword for a name"
(etypecase name
(keyword name)
- (string (intern #-case-sensitive (string-upcase name)
- #+case-sensitive name
- :keyword))
+ (string (intern (string-default-case name) :keyword))
(symbol (intern (symbol-name name) :keyword))))
(defun show (&optional (what :variables) (package *package*))