X-Git-Url: http://git.kpe.io/?p=hyperobject.git;a=blobdiff_plain;f=hyperobject.lisp;h=0e34dcdfc22141da79484a1b529e921d8e2ca18f;hp=37f27eb617675bfb6f09730a7effe211218a7211;hb=eeecdad997c633f810028c741e9562554e6f105d;hpb=516272144b06d6a8a96a1a4f7b38bbaf410f2f14

diff --git a/hyperobject.lisp b/hyperobject.lisp
index 37f27eb..0e34dcd 100644
--- a/hyperobject.lisp
+++ b/hyperobject.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: hyperobject.lisp,v 1.1 2002/11/03 19:59:10 kevin Exp $
+;;;; $Id: hyperobject.lisp,v 1.2 2002/11/03 20:06:19 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -26,20 +26,18 @@
 
 ;; Utilities
 
-(defun my-class-of (obj)
+(defun kmr-class-of (obj)
   #-(or cmu sbcl) (class-of obj)
   #+sbcl (sb-pcl:class-of obj)
   #+cmu (pcl:class-of obj))
 
-(defun my-class-name (obj)
+(defun kmr-class-name (obj)
   #-(or cmu sbcl) (class-name obj)
   #+sbcl (sb-pcl:class-name obj)
   #+cmu (pcl:class-name obj))
 
-(defun xml-cdata (str)
-  (concatenate 'string "<![CDATA[" str "]]>"))
+;; Main class
 
-;; 
 (defclass ho-class (#-(or cmu sbcl) standard-class
 		      #+cmu pcl::standard-class
 		      #+sbcl sb-pcl::standard-class)
@@ -163,7 +161,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 	  (value-func '())
 	  (xmlvalue-func '())
 	  (classname (class-name cl))
-	  (package (symbol-package (my-class-name cl)))
+	  (package (symbol-package (kmr-class-name cl)))
 	  (ref-fields (slot-value cl 'ref-fields)))
       (declare (ignore classname))
       (dolist (f (slot-value cl 'fields))
@@ -261,56 +259,56 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 
 (defun ho-class-fmtstr-text (obj)
-  (slot-value (my-class-of obj) 'fmtstr-text))
+  (slot-value (kmr-class-of obj) 'fmtstr-text))
 
 (defun ho-class-fmtstr-html (obj)
-  (slot-value (my-class-of obj) 'fmtstr-html))
+  (slot-value (kmr-class-of obj) 'fmtstr-html))
 
 (defun ho-class-fmtstr-xml (obj)
-  (slot-value (my-class-of obj) 'fmtstr-xml))
+  (slot-value (kmr-class-of obj) 'fmtstr-xml))
 
 (defun ho-class-fmtstr-text-labels (obj)
-  (slot-value (my-class-of obj) 'fmtstr-text-labels))
+  (slot-value (kmr-class-of obj) 'fmtstr-text-labels))
 
 (defun ho-class-fmtstr-html-labels (obj)
-  (slot-value (my-class-of obj) 'fmtstr-html-labels))
+  (slot-value (kmr-class-of obj) 'fmtstr-html-labels))
 
 (defun ho-class-fmtstr-xml-labels (obj)
-  (slot-value (my-class-of obj) 'fmtstr-xml-labels))
+  (slot-value (kmr-class-of obj) 'fmtstr-xml-labels))
 
 (defun ho-class-value-func (obj)
-  (slot-value (my-class-of obj) 'value-func))
+  (slot-value (kmr-class-of obj) 'value-func))
 
 (defun ho-class-xmlvalue-func (obj)
-  (slot-value (my-class-of obj) 'xmlvalue-func))
+  (slot-value (kmr-class-of obj) 'xmlvalue-func))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defun ho-class-title (obj)
-  (awhen (slot-value (my-class-of obj) 'title)
+  (awhen (slot-value (kmr-class-of obj) 'title)
 	    (if (consp it)
 		(car it)
 	      it))))
 
 (defun ho-class-subobjects-lists (obj)
-  (slot-value (my-class-of obj) 'subobjects-lists))
+  (slot-value (kmr-class-of obj) 'subobjects-lists))
 
 (defun ho-class-ref-fields (obj)
-  (slot-value (my-class-of obj) 'ref-fields))
+  (slot-value (kmr-class-of obj) 'ref-fields))
 
 (defun ho-class-fields (obj)
-  (slot-value (my-class-of obj) 'fields))
+  (slot-value (kmr-class-of obj) 'fields))
 
 (defun ho-class-fmtstr-html-ref (obj)
-  (slot-value (my-class-of obj) 'fmtstr-html-ref))
+  (slot-value (kmr-class-of obj) 'fmtstr-html-ref))
 
 (defun ho-class-fmtstr-xml-ref (obj)
-  (slot-value (my-class-of obj) 'fmtstr-xml-ref))
+  (slot-value (kmr-class-of obj) 'fmtstr-xml-ref))
 
 (defun ho-class-fmtstr-html-ref-labels (obj)
-  (slot-value (my-class-of obj) 'fmtstr-html-ref-labels))
+  (slot-value (kmr-class-of obj) 'fmtstr-html-ref-labels))
 
 (defun ho-class-fmtstr-xml-ref-labels (obj)
-  (slot-value (my-class-of obj) 'fmtstr-xml-ref-labels))
+  (slot-value (kmr-class-of obj) 'fmtstr-xml-ref-labels))
 
 ;;; Class name functions
 
@@ -319,7 +317,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   (string-downcase (subseq name 1)))
   
 (defmethod ho-class-stdname ((cl standard-object))
-  (string-downcase (subseq (my-class-name (my-class-of cl)) 1)))
+  (string-downcase (subseq (kmr-class-name (kmr-class-of cl)) 1)))
   
 ;;;; Generic Print functions
 
@@ -412,7 +410,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 
 (defun class-name-of (obj)
-  (string-downcase (my-class-name (my-class-of obj))))
+  (string-downcase (kmr-class-name (kmr-class-of obj))))
 
 (defun htmlformat-list-start-value-func (x nitems) 
   (values (ho-class-title x) nitems (class-name-of x)))