Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30160 Modified Files: print.lisp Log Message: Minor edit. Date: Mon Jan 17 11:54:38 2005 Author: ffjeld Index: movitz/losp/muerte/print.lisp diff -u movitz/losp/muerte/print.lisp:1.15 movitz/losp/muerte/print.lisp:1.16 --- movitz/losp/muerte/print.lisp:1.15 Mon Oct 11 15:53:09 2004 +++ movitz/losp/muerte/print.lisp Mon Jan 17 11:54:38 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef@acm.org> ;;;; Created at: Mon Sep 3 11:48:19 2001 ;;;; -;;;; $Id: print.lisp,v 1.15 2004/10/11 13:53:09 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.16 2005/01/17 10:54:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -32,6 +32,7 @@ (defvar *print-level* 3) (defvar *print-pretty* t) (defvar *print-circle* nil) +(defvar *print-case* :upcase) (defvar *print-safely* nil) @@ -252,15 +253,13 @@ (let ((name (symbol-name symbol))) (if (and (plusp (length name)) (every (lambda (c) - (or (upper-case-p c) - (member c '(#\+ #\- #\% #\$ #\* #\@ #\. #\& - #\/ #\< #\> #\=)) - (digit-char-p c))) - name) - (not (every (lambda (c) - (or (digit-char-p c *read-base*) - (member c '(#\.)))) - name))) + (and (or (upper-case-p c) + (member c '(#\+ #\- #\% #\$ #\* #\@ #\. #\& + #\/ #\< #\> #\=)) + (digit-char-p c)) + (not (or (digit-char-p c *read-base*) + (member c '(#\.)))))) + name)) (write-string name stream) (stream-write-escaped-string stream name #\|))))) (cond