r3291: *** empty log message ***

diff --git a/debian/changelog b/debian/changelog
index ab46d98ce2d4f5afe0459cc93f6787281efb5df2..b1c3d7da35173dc84f425730452d5b6e2a12e7f5 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,15 @@
+cl-hyperobject (1.2-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon,  4 Nov 2002 09:38:26 -0700
+
+cl-hyperobject (1.1-1) unstable; urgency=low
+
+  * Fix upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Sun,  3 Nov 2002 16:34:52 -0700
+
 cl-hyperobject (1.0-1) unstable; urgency=low
 
   * Initial Release (closes: 167591)

diff --git a/debian/control b/debian/control
index e22b2f4a1c35d4c70475b83aaafc9b36e4ce6d05..5fc7d3be9e12cac697266b3727507cf591b7a141 100644 (file)
--- a/debian/control
+++ b/debian/control
@@ -8,7 +8,7 @@ Standards-Version: 3.5.7.1
 Package: cl-hyperobject
 Architecture: all
 Depends: ${shlibs:Depends}, common-lisp-controller, cl-kmrcl
-Description: Common Lisp library for hyperobject
+Description: Common Lisp library for hyperobjects
  This package contains a library for creating and display hyperobjects.
  Hyperobjects contain references to subobjects as well as to linked
  objects.  This package includes functions to display hyperobjects in

diff --git a/hyperobject.lisp b/hyperobject.lisp
index 0e34dcdfc22141da79484a1b529e921d8e2ca18f..e95b8118ed2ac2197c5b2cacd586af85fa3e09cb 100644 (file)
--- 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.2 2002/11/03 20:06:19 kevin Exp $
+;;;; $Id: hyperobject.lisp,v 1.3 2002/11/04 18:02:13 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -38,7 +38,7 @@
 
 ;; Main class
 
-(defclass ho-class (#-(or cmu sbcl) standard-class
+(defclass hyperobject-class (#-(or cmu sbcl) standard-class
                      #+cmu pcl::standard-class
                      #+sbcl sb-pcl::standard-class)
   ((title :initarg :title :type string :reader ml-std-title
@@ -77,76 +77,76 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   (:documentation "Metaclass for Markup Language classes."))
 
 #+cmu
-(defmethod pcl:finalize-inheritance :after ((cl ho-class))
-  (init-ho-class cl))
+(defmethod pcl:finalize-inheritance :after ((cl hyperobject-class))
+  (init-hyperobject-class cl))
 
 #+scl
-(defmethod clos:finalize-inheritance :after ((cl ho-class))
-  (init-ho-class cl))
+(defmethod clos:finalize-inheritance :after ((cl hyperobject-class))
+  (init-hyperobject-class cl))
 
 
 #+sbcl
-(defmethod sb-pcl:finalize-inheritance :after ((cl ho-class))
-  (init-ho-class cl))
+(defmethod sb-pcl:finalize-inheritance :after ((cl hyperobject-class))
+  (init-hyperobject-class cl))
 
 
 #+cmu
-(defmethod pcl:validate-superclass ((class ho-class) (superclass pcl::standard-class))
+(defmethod pcl:validate-superclass ((class hyperobject-class) (superclass pcl::standard-class))
   t)
 
 #+scl
-(defmethod clos:validate-superclass ((class ho-class) (superclass standard-class))
+(defmethod clos:validate-superclass ((class hyperobject-class) (superclass standard-class))
   t)
 
 #+sbcl
-(defmethod sb-pcl:validate-superclass ((class ho-class) (superclass sb-pcl::standard-class))
+(defmethod sb-pcl:validate-superclass ((class hyperobject-class) (superclass sb-pcl::standard-class))
   t)
 
 #+allegro
-(defmethod mop:finalize-inheritance :after ((cl ho-class))
-  (init-ho-class cl))
+(defmethod mop:finalize-inheritance :after ((cl hyperobject-class))
+  (init-hyperobject-class cl))
 
 #+lispworks
-(defmethod clos:finalize-inheritance :after ((cl ho-class))
-  (init-ho-class cl))
+(defmethod clos:finalize-inheritance :after ((cl hyperobject-class))
+  (init-hyperobject-class cl))
 
 #+lispworks
-(defmethod clos:process-a-class-option ((class ho-class)
+(defmethod clos:process-a-class-option ((class hyperobject-class)
                                        (name (eql :title))
                                        value)
   (unless value
-    (error "ho-class title must have a value"))
+    (error "hyperobject-class title must have a value"))
   (if (null (cdr value))
       (list name (car value))
     (list name `',value)))
 
 #+lispworks
-(defmethod clos:process-a-class-option ((class ho-class)
+(defmethod clos:process-a-class-option ((class hyperobject-class)
                                        (name (eql :fields))
                                        value)
   (unless value
-    (error "ho-class fields must have a value"))
+    (error "hyperobject-class fields must have a value"))
   (list name `',value))
 
 #+lispworks
-(defmethod clos:process-a-class-option ((class ho-class)
+(defmethod clos:process-a-class-option ((class hyperobject-class)
                                        (name (eql :ref-fields))
                                        value)
   (unless value
-    (error "ho-class ref-fields must have a value"))
+    (error "hyperobject-class ref-fields must have a value"))
   (list name `',value))
 
 #+lispworks
-(defmethod clos:process-a-class-option ((class ho-class)
+(defmethod clos:process-a-class-option ((class hyperobject-class)
                                        (name (eql :subobjects-lists))
                                        value)
   (unless value
-    (error "ho-class subobjects-lists must have a value"))
+    (error "hyperobject-class subobjects-lists must have a value"))
   (list name `',value))
 
 ;;;; Class initialization function
       
-(defun init-ho-class (cl)
+(defun init-hyperobject-class (cl)
     (let ((fmtstr-text "")
          (fmtstr-html "")
          (fmtstr-xml "")
@@ -258,65 +258,65 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     (values))
 
 
-(defun ho-class-fmtstr-text (obj)
+(defun hyperobject-class-fmtstr-text (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-text))
 
-(defun ho-class-fmtstr-html (obj)
+(defun hyperobject-class-fmtstr-html (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-html))
 
-(defun ho-class-fmtstr-xml (obj)
+(defun hyperobject-class-fmtstr-xml (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-xml))
 
-(defun ho-class-fmtstr-text-labels (obj)
+(defun hyperobject-class-fmtstr-text-labels (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-text-labels))
 
-(defun ho-class-fmtstr-html-labels (obj)
+(defun hyperobject-class-fmtstr-html-labels (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-html-labels))
 
-(defun ho-class-fmtstr-xml-labels (obj)
+(defun hyperobject-class-fmtstr-xml-labels (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-xml-labels))
 
-(defun ho-class-value-func (obj)
+(defun hyperobject-class-value-func (obj)
   (slot-value (kmr-class-of obj) 'value-func))
 
-(defun ho-class-xmlvalue-func (obj)
+(defun hyperobject-class-xmlvalue-func (obj)
   (slot-value (kmr-class-of obj) 'xmlvalue-func))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-(defun ho-class-title (obj)
+(defun hyperobject-class-title (obj)
   (awhen (slot-value (kmr-class-of obj) 'title)
            (if (consp it)
                (car it)
              it))))
 
-(defun ho-class-subobjects-lists (obj)
+(defun hyperobject-class-subobjects-lists (obj)
   (slot-value (kmr-class-of obj) 'subobjects-lists))
 
-(defun ho-class-ref-fields (obj)
+(defun hyperobject-class-ref-fields (obj)
   (slot-value (kmr-class-of obj) 'ref-fields))
 
-(defun ho-class-fields (obj)
+(defun hyperobject-class-fields (obj)
   (slot-value (kmr-class-of obj) 'fields))
 
-(defun ho-class-fmtstr-html-ref (obj)
+(defun hyperobject-class-fmtstr-html-ref (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-html-ref))
 
-(defun ho-class-fmtstr-xml-ref (obj)
+(defun hyperobject-class-fmtstr-xml-ref (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-xml-ref))
 
-(defun ho-class-fmtstr-html-ref-labels (obj)
+(defun hyperobject-class-fmtstr-html-ref-labels (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-html-ref-labels))
 
-(defun ho-class-fmtstr-xml-ref-labels (obj)
+(defun hyperobject-class-fmtstr-xml-ref-labels (obj)
   (slot-value (kmr-class-of obj) 'fmtstr-xml-ref-labels))
 
 ;;; Class name functions
 
-(defgeneric ho-class-stdname (x))
-(defmethod ho-class-stdname ((name string))
+(defgeneric hyperobject-class-stdname (x))
+(defmethod hyperobject-class-stdname ((name string))
   (string-downcase (subseq name 1)))
   
-(defmethod ho-class-stdname ((cl standard-object))
+(defmethod hyperobject-class-stdname ((cl standard-object))
   (string-downcase (subseq (kmr-class-name (kmr-class-of cl)) 1)))
   
 ;;;; Generic Print functions
@@ -357,7 +357,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
       (:null *default-nullformat*)
       (otherwise *default-textformat*)))
     
-;;;; Output format classes for print ho-classes
+;;;; Output format classes for print hyperobject-classes
 
 (defclass dataformat ()
   ((file-start-str :type string :initarg :file-start-str :reader file-start-str)
@@ -395,7 +395,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   ())
 
 (defun text-list-start-value-func (obj nitems)
-  (values (ho-class-title obj) nitems))
+  (values (hyperobject-class-title obj) nitems))
 
 (defclass textformat (dataformat) 
   ()   
@@ -403,17 +403,17 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     :list-start-value-func #'text-list-start-value-func
     :list-start-indent t
     :obj-data-indent t
-    :obj-data-fmtstr #'ho-class-fmtstr-text
-    :obj-data-fmtstr-labels #'ho-class-fmtstr-text-labels
+    :obj-data-fmtstr #'hyperobject-class-fmtstr-text
+    :obj-data-fmtstr-labels #'hyperobject-class-fmtstr-text-labels
     :obj-data-end-fmtstr "~%"
-    :obj-data-value-func #'ho-class-value-func))
+    :obj-data-value-func #'hyperobject-class-value-func))
 
 
 (defun class-name-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)))
+  (values (hyperobject-class-title x) nitems (class-name-of x)))
 
 (defclass htmlformat (textformat) 
   ()
@@ -432,9 +432,9 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     :obj-end-fmtstr  "</li>~%"
     :obj-end-value-func #'identity
     :obj-data-indent t
-    :obj-data-fmtstr #'ho-class-fmtstr-html-labels
-    :obj-data-fmtstr-labels #'ho-class-fmtstr-html-labels
-    :obj-data-value-func #'ho-class-value-func))
+    :obj-data-fmtstr #'hyperobject-class-fmtstr-html-labels
+    :obj-data-fmtstr-labels #'hyperobject-class-fmtstr-html-labels
+    :obj-data-value-func #'hyperobject-class-value-func))
 
 (defclass xhtmlformat (textformat) 
   ()
@@ -453,16 +453,16 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     :obj-end-fmtstr  "</li>~%"
     :obj-end-value-func #'identity
     :obj-data-indent t
-    :obj-data-fmtstr #'ho-class-fmtstr-html-labels
-    :obj-data-fmtstr-labels #'ho-class-fmtstr-html-labels
-    :obj-data-value-func #'ho-class-xmlvalue-func))
+    :obj-data-fmtstr #'hyperobject-class-fmtstr-html-labels
+    :obj-data-fmtstr-labels #'hyperobject-class-fmtstr-html-labels
+    :obj-data-value-func #'hyperobject-class-xmlvalue-func))
 
 
 (defun xmlformat-list-end-value-func (x)
   (format nil "~alist" (class-name-of x)))
 
 (defun xmlformat-list-start-value-func (x nitems) 
-  (values (format nil "~alist" (class-name-of x)) (ho-class-title x) nitems))
+  (values (format nil "~alist" (class-name-of x)) (hyperobject-class-title x) nitems))
 
 (defclass xmlformat (textformat) 
   ()
@@ -480,9 +480,9 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     :obj-end-value-func #'class-name-of
     :obj-end-indent nil
     :obj-data-indent nil
-    :obj-data-fmtstr #'ho-class-fmtstr-xml
-    :obj-data-fmtstr-labels #'ho-class-fmtstr-xml-labels
-    :obj-data-value-func #'ho-class-xmlvalue-func))
+    :obj-data-fmtstr #'hyperobject-class-fmtstr-xml
+    :obj-data-fmtstr-labels #'hyperobject-class-fmtstr-xml-labels
+    :obj-data-value-func #'hyperobject-class-xmlvalue-func))
 
 (defclass link-ref ()
   ((fmtstr :type function :initarg :fmtstr :accessor fmtstr)
@@ -499,24 +499,24 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 (defclass html-link-ref (link-ref)
   ()
-  (:default-initargs :fmtstr #'ho-class-fmtstr-html-ref  
-    :fmtstr-labels #'ho-class-fmtstr-html-ref-labels
+  (:default-initargs :fmtstr #'hyperobject-class-fmtstr-html-ref  
+    :fmtstr-labels #'hyperobject-class-fmtstr-html-ref-labels
     :href-head "a href=" 
     :href-end "a" 
     :ampersand "&"))
 
 (defclass xhtml-link-ref (link-ref)
   ()
-  (:default-initargs :fmtstr #'ho-class-fmtstr-html-ref  
-    :fmtstr-labels #'ho-class-fmtstr-html-ref-labels
+  (:default-initargs :fmtstr #'hyperobject-class-fmtstr-html-ref  
+    :fmtstr-labels #'hyperobject-class-fmtstr-html-ref-labels
     :href-head "a href=" 
     :href-end "a" 
     :ampersand "&amp;"))
 
 (defclass xml-link-ref (link-ref)
   ()
-  (:default-initargs :fmtstr #'ho-class-fmtstr-xml-ref 
-                    :fmtstr-labels #'ho-class-fmtstr-xml-ref-labels
+  (:default-initargs :fmtstr #'hyperobject-class-fmtstr-xml-ref 
+                    :fmtstr-labels #'hyperobject-class-fmtstr-xml-ref-labels
                     :href-head "xmllink xlink:type=\"simple\" xlink:href=" 
                     :href-end "xmllink" 
                     :ampersand "&amp;")
@@ -654,10 +654,10 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
          (funcall (funcall (obj-data-value-func fmt) x) x))))
     
     ;; make list of reference link fields for printing to refstr template
-    (dolist (field (ho-class-ref-fields x))
+    (dolist (field (hyperobject-class-ref-fields x))
       (let ((link-start 
             (make-link-start x (link-ref fmt) (car field) (cadr field)
-                             (nth (position (car field) (ho-class-fields x) :key #'car) field-values)  
+                             (nth (position (car field) (hyperobject-class-fields x) :key #'car) field-values)  
                              (append (caddr field) refvars)))
            (link-end (make-link-end x (link-ref fmt) (car field))))
        (push link-start refvalues)
@@ -697,21 +697,21 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   (when objs
     (let ((objlist (mklist objs)))
       (dolist (obj objlist)
-        (awhen (ho-class-subobjects-lists obj)  ;; access list of functions
+        (awhen (hyperobject-class-subobjects-lists obj)  ;; access list of functions
           (dolist (child-obj it)   ;; for each child function
             (awhen (funcall (car child-obj) obj)
               (load-all-subobjects it))))))
     objs))
 
-(defgeneric output-ho-class (objs fmt strm
+(defgeneric print-hyperobject-class (objs fmt strm
                                  &optional label english-only-function
                                  indent subobjects refvars))
 
-(defmethod output-ho-class (objs (fmt dataformat) (strm stream) 
+(defmethod print-hyperobject-class (objs (fmt dataformat) (strm stream) 
                                 &optional (label nil) (indent 0)
                                 (english-only-function nil)
                                 (subobjects nil) (refvars nil))
-  "Display a single or list of ho-class instances and their subobjects"
+"Display a single or list of hyperobject-class instances and their subobjects"
   (when objs
     (setq objs (mklist objs))
     (let ((nobjs (length objs)))
@@ -723,10 +723,10 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
           (fmt-obj-start obj fmt strm indent)
           (fmt-obj-data obj fmt strm (1+ indent) label refvars)
           (if subobjects
-              (awhen (ho-class-subobjects-lists obj)  ;; access list of functions
+              (awhen (hyperobject-class-subobjects-lists obj)  ;; access list of functions
                         (dolist (child-obj it)   ;; for each child function
                           (awhen (funcall (car child-obj) obj) ;; access set of child objects
-                                    (output-ho-class it fmt strm label 
+                                    (print-hyperobject-class it fmt strm label 
                                                      english-only-function
                                                      (1+ indent) subobjects refvars)))))
           (fmt-obj-end obj fmt strm indent)))
@@ -734,15 +734,17 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     t))
 
 
-(defun print-ho (objs &key (os *standard-output*) (format :text)
+
+(defun print-hyperobject (objs &key (os *standard-output*) (format :text)
                      (label nil) (english-only-function nil)
                      (subobjects nil) (file-wrapper t) (refvars nil))
-  "EXPORTED Function: prints ho-class objects. Simplies call to output-ho-class"
+  "EXPORTED Function: prints hyperobject-class objects. Simplies call to print-hyperobject-class"
   (let ((fmt (make-format-instance format)))
     (if file-wrapper
        (fmt-file-start fmt os))
     (when objs
-      (output-ho-class objs fmt os label english-only-function 0 subobjects refvars))
+      (print-hyperobject-class objs fmt os label english-only-function 0 subobjects refvars))
     (if file-wrapper
        (fmt-file-end fmt os)))
   objs)
+

diff --git a/package.lisp b/package.lisp
index 0c230530e479cbd9014dbcdcf9656f332527bf87..da354bb1e71b953e0922f0d6111846e6484e3e23 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: package.lisp,v 1.2 2002/11/03 20:06:19 kevin Exp $
+;;;; $Id: package.lisp,v 1.3 2002/11/04 18:02:13 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -17,12 +17,14 @@
 (in-package :cl-user)
 
 (defpackage #:hyperobject
+  (:nicknames #:ho)
   (:use #:common-lisp #:kmrcl)
   (:export
-   #:ml-class
-   #:ml-class-title
+   #:hyperobject-class
+   #:hyperobject-base-url!
+   #:hyperobject-class-title
    #:load-all-subobjects
-   #:print-ho
+   #:print-hyperobject
    ))