[Maxima-commits] CVS: maxima/src commac.lisp,1.20,1.21

[Raymond T. <rt...@us...>]

Update of /cvsroot/maxima/maxima/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11191

Modified Files:
	commac.lisp 
Log Message:
o Make a new function to invert the case of a string like
  readtable-case :invert.
o Use it in intern-invert-case.
o Use it in maknam which needs to invert the case before creating the
  symbol. 


Index: commac.lisp
===================================================================
RCS file: /cvsroot/maxima/maxima/src/commac.lisp,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- commac.lisp	18 Nov 2004 15:20:31 -0000	1.20
+++ commac.lisp	23 Nov 2004 22:13:41 -0000	1.21
@@ -514,20 +514,29 @@
 (defun implode (lis) (implode1 lis nil))
 
 
-(defun intern-invert-case (string)
-  ;; Like read-from-string with readtable-case :invert
+(defun maybe-invert-string-case (string)
+  ;; If STRING is all the same case, invert the case.  Otherwise, do
+  ;; nothing.
   (flet ((alpha-upper-case-p (s)
 	   (not (some #'lower-case-p s)))
 	 (alpha-lower-case-p (s)
 	   (not (some #'upper-case-p s))))
     ;; Don't explicitly add a package here.  It seems maxima sets
     ;; *package* as needed.
-    (intern (cond ((alpha-upper-case-p string)
-		   (string-downcase string))
-		  ((alpha-lower-case-p string)
-		   (string-upcase string))
-		  (t
-		   string)))))
+    (cond ((alpha-upper-case-p string)
+	   (string-downcase string))
+	  ((alpha-lower-case-p string)
+	   (string-upcase string))
+	  (t
+	   string))))
+
+(defun intern-invert-case (string)
+  ;; Like read-from-string with readtable-case :invert
+  ;;
+  ;; Not explicit package for INTERN.  It seems maxima sets *package*
+  ;; as needed.
+  (intern (maybe-invert-string-case string)))
+
 
 #-gcl
 (let ((local-table (copy-readtable nil)))
@@ -618,7 +627,7 @@
 	 collecting v into tem
 	 else do (maxima-error "bad entry")
 	 finally 
-	 (return (make-symbol (coerce tem 'string)))))
+	 (return (make-symbol (maybe-invert-string-case (coerce tem 'string))))))
 
 ;;for those window labels etc. that are wrong type.