[albert-cvs] CVS: albert/apispec base.lisp,1.10,1.11 helpers.lisp,1.4,1.5

[Stig E S. <st...@us...>]

Update of /cvsroot/albert/albert/apispec
In directory sc8-pr-cvs1:/tmp/cvs-serv13923/apispec

Modified Files:
	base.lisp helpers.lisp 
Log Message:
updated some code so that albert will compile even if *readtable* is :downcase

Index: base.lisp
===================================================================
RCS file: /cvsroot/albert/albert/apispec/base.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** base.lisp	20 Oct 2003 17:47:58 -0000	1.10
--- base.lisp	14 Nov 2003 16:03:27 -0000	1.11
***************
*** 104,119 ****
  	 #+allegro
  	  (ecase excl:*current-case-mode*
! 	    (:case-sensitive-lower
! 	     'nstring-downcase)
! 	    (:case-insensitive-upper
! 	     'nstring-upcase))
  	  #-allegro
! 	  'nstring-upcase))
  
      `(let ((,str (,case-fun (reduce #'mystrcat (list ,@args)))))
         (if (and (plusp (length ,str)) (eql (char ,str 0) #\:))
  	   (intern (subseq ,str 1) *keyword-package*)
! 	 (intern ,str)
! 	 ))
      ))
  
--- 104,120 ----
  	 #+allegro
  	  (ecase excl:*current-case-mode*
! 	    (:case-sensitive-lower   'nstring-downcase)
! 	    (:case-insensitive-upper 'nstring-upcase))
  	  #-allegro
! 	  (ecase (cl:readtable-case cl:*readtable*)
! 	    (:downcase 'nstring-downcase)
! 	    (:upcase 'nstring-upcase))
! 	  ))
  
      `(let ((,str (,case-fun (reduce #'mystrcat (list ,@args)))))
         (if (and (plusp (length ,str)) (eql (char ,str 0) #\:))
  	   (intern (subseq ,str 1) *keyword-package*)
! 	   (intern ,str)
! 	   ))
      ))
  

Index: helpers.lisp
===================================================================
RCS file: /cvsroot/albert/albert/apispec/helpers.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** helpers.lisp	25 Oct 2003 21:47:26 -0000	1.4
--- helpers.lisp	14 Nov 2003 16:03:27 -0000	1.5
***************
*** 120,124 ****
    ;;  (warn "defining const ~a" name)
     
!   (let* ((mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
  	 (const-name (concat-pnames "+" mod-val "-name-" `,name "+")))
      `(eval-when (:compile-toplevel 
--- 120,126 ----
    ;;  (warn "defining const ~a" name)
     
!   (let* (;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
! 	 (sym-name (concat-pnames "+sds-" "module-name+"))
! 	 (mod-val (symbol-value sym-name))
  	 (const-name (concat-pnames "+" mod-val "-name-" `,name "+")))
      `(eval-when (:compile-toplevel 
***************
*** 133,137 ****
   where MOD is the name of the module
  "
!   (let* ((mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
  	 (const-name (concat-pnames "+" mod-val "-name-" `,name "+")))
      `,const-name))
--- 135,141 ----
   where MOD is the name of the module
  "
!   (let* (;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
! 	 (sym-name (concat-pnames "+sds-" "module-name+"))
! 	 (mod-val (symbol-value sym-name))
  	 (const-name (concat-pnames "+" mod-val "-name-" `,name "+")))
      `,const-name))
***************
*** 153,157 ****
  is a string
  "
!   (let* ((mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
  	 (full-class-name (concat-pnames mod-val "-" `,name))
  	 ;;(constr-name (concat-pnames "MAKE-" full-class-name))
--- 157,163 ----
  is a string
  "
!   (let* (;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
! 	 (sym-name (concat-pnames "+sds-" "module-name+"))
! 	 (mod-val (symbol-value sym-name))
  	 (full-class-name (concat-pnames mod-val "-" `,name))
  	 ;;(constr-name (concat-pnames "MAKE-" full-class-name))
***************
*** 276,282 ****
  
  (defmacro add-subelements (obj &rest attrs)
!   (let ((acc-name (concat-pnames "xml-class." "sub-Info-ptr"))
  	(fun-name (concat-pnames "make-xml-subelement-" "info"))
! 	(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
  	(el-type (concat-pnames "" "xml-subelement-info"))
  	(howmany (length attrs))
--- 282,290 ----
  
  (defmacro add-subelements (obj &rest attrs)
!   (let* ((acc-name (concat-pnames "xml-class." "sub-Info-ptr"))
  	(fun-name (concat-pnames "make-xml-subelement-" "info"))
! 	(sym-name (concat-pnames "+sds-" "module-name+"))
! 	(mod-val (symbol-value sym-name))
! 	;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
  	(el-type (concat-pnames "" "xml-subelement-info"))
  	(howmany (length attrs))
***************
*** 350,354 ****
    
    (let* ((xmlclass-word (concat-pnames "xml-" "class"))
! 	 (mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
  	 (full-class-name (concat-pnames mod-val "-" `,name))
  	 (export-list (list full-class-name))
--- 358,365 ----
    
    (let* ((xmlclass-word (concat-pnames "xml-" "class"))
! 	 (sym-name (concat-pnames "+sds-" "module-name+"))
! 	 (mod-val (symbol-value sym-name))
! 	 #|| (find-symbol (format nil "~a" :+sds-module-name+) *package*) ||#
! 	
  	 (full-class-name (concat-pnames mod-val "-" `,name))
  	 (export-list (list full-class-name))
***************
*** 380,383 ****
--- 391,395 ----
  	  (setf new-slots (nconc new-slots new-val)))))
  
+     ;;(format t "~&>> Creating class ~s of ~s |~s|~%" full-class-name mod-val sym-name)
      `(eval-when (:compile-toplevel 
  		 :load-toplevel
***************
*** 395,399 ****
      
      (dolist (i args)
!       (let* ((mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
  	     (full-class-name (concat-pnames mod-val "-" (if (symbolp i) i (car i))))
  	     (xml-name (if (symbolp i) `,i `,(cadr i)))
--- 407,413 ----
      
      (dolist (i args)
!       (let* (;;(mod-val (symbol-value (find-symbol (format nil "~a" :+sds-module-name+) *package*)))
! 	     (sym-name (concat-pnames "+sds-" "module-name+"))
! 	     (mod-val (symbol-value sym-name))
  	     (full-class-name (concat-pnames mod-val "-" (if (symbolp i) i (car i))))
  	     (xml-name (if (symbolp i) `,i `,(cadr i)))