r3287: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Sun, 3 Nov 2002 20:10:48 +0000 (20:10 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Sun, 3 Nov 2002 20:10:48 +0000 (20:10 +0000)
debian/control
hyperobject.asd
hyperobject.lisp
package.lisp

index 7d76bfb3ea39e93e8483b0e9d1e2cc89dfde4e4b..e22b2f4a1c35d4c70475b83aaafc9b36e4ce6d05 100644 (file)
@@ -7,7 +7,7 @@ Standards-Version: 3.5.7.1
 
 Package: cl-hyperobject
 Architecture: all
-Depends: ${shlibs:Depends}, common-lisp-controller
+Depends: ${shlibs:Depends}, common-lisp-controller, cl-kmrcl
 Description: Common Lisp library for hyperobject
  This package contains a library for creating and display hyperobjects.
  Hyperobjects contain references to subobjects as well as to linked
index 50063cd9a4cfee99133c010214160f6c6f3a64f0..b75e9a78221c7ba413e43f231c026fa720705272 100644 (file)
@@ -7,13 +7,14 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: hyperobject.asd,v 1.1 2002/11/03 19:59:10 kevin Exp $
+;;;; $Id: hyperobject.asd,v 1.2 2002/11/03 20:10:48 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;; *************************************************************************
 
 (in-package :asdf)
 
+#+(or allegro lispworks cmu sbcl scl)
 (defsystem :hyperobject
     :perform (load-op :after (op hyperobject)
                      (pushnew :hyperobject cl:*features*))
@@ -23,6 +24,7 @@
     :depends-on (:kmrcl))
 
 
+#+(or allegro lispworks cmu sbcl scl)
 (when (ignore-errors (find-class 'load-compiled-op))
   (defmethod perform :after ((op load-compiled-op)
                             (c (eql (find-system :hyperobject))))
index 37f27eb617675bfb6f09730a7effe211218a7211..0e34dcdfc22141da79484a1b529e921d8e2ca18f 100644 (file)
@@ -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
 ;;;;
 
 ;; 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)))
index 18acce7baefb7e2a1e115fa03b471800aea8ea2a..0c230530e479cbd9014dbcdcf9656f332527bf87 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: package.lisp,v 1.1 2002/11/03 19:59:10 kevin Exp $
+;;;; $Id: package.lisp,v 1.2 2002/11/03 20:06:19 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -17,7 +17,7 @@
 (in-package :cl-user)
 
 (defpackage #:hyperobject
-  (:use #:common-lisp)
+  (:use #:common-lisp #:kmrcl)
   (:export
    #:ml-class
    #:ml-class-title