r3292: *** empty log message ***

diff --git a/debian/changelog b/debian/changelog
index b1c3d7da35173dc84f425730452d5b6e2a12e7f5..13681fe637b404125a738f5f820bf65b2a8fea7b 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,15 @@
+cl-hyperobject (1.2.2-1) unstable; urgency=low
+
+  * Change position of a defclass
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon,  4 Nov 2002 12:09:58 -0700
+
+cl-hyperobject (1.2.1-1) unstable; urgency=low
+
+  * Fix parameter bug
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon,  4 Nov 2002 11:37:35 -0700
+
 cl-hyperobject (1.2-1) unstable; urgency=low
 
   * New upstream

diff --git a/debian/rules b/debian/rules
index 66e1069b4c441bbb01802b2731778e7e5873729f..8eeb8e47168ec1fcea9bdcf4f312e0258d288ee5 100755 (executable)
--- a/debian/rules
+++ b/debian/rules
@@ -51,7 +51,7 @@ binary-indep: build install
        dh_testroot -i
 #      dh_installdebconf       
        dh_installdocs -i
-#      dh_installexamples -i hyperobject-example.lisp
+       dh_installexamples -i hyperobject-example.lisp
 #      dh_installmenu
 #      dh_installlogrotate
 #      dh_installemacsen

diff --git a/hyperobject.lisp b/hyperobject.lisp
index e95b8118ed2ac2197c5b2cacd586af85fa3e09cb..926fde9b7d17847a96f057a9ad0c3a74818ca156 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.3 2002/11/04 18:02:13 kevin Exp $
+;;;; $Id: hyperobject.lisp,v 1.4 2002/11/04 19:19:04 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -26,12 +26,12 @@
 
 ;; Utilities
 
-(defun kmr-class-of (obj)
+(defun portable-class-of (obj)
   #-(or cmu sbcl) (class-of obj)
   #+sbcl (sb-pcl:class-of obj)
   #+cmu (pcl:class-of obj))
 
-(defun kmr-class-name (obj)
+(defun portable-class-name (obj)
   #-(or cmu sbcl) (class-name obj)
   #+sbcl (sb-pcl:class-name obj)
   #+cmu (pcl:class-name obj))
@@ -76,6 +76,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   (:default-initargs :title nil :fields nil :subobjects-lists nil :ref-fields nil)
   (:documentation "Metaclass for Markup Language classes."))
 
+
 #+cmu
 (defmethod pcl:finalize-inheritance :after ((cl hyperobject-class))
   (init-hyperobject-class cl))
@@ -161,7 +162,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
          (value-func '())
          (xmlvalue-func '())
          (classname (class-name cl))
-         (package (symbol-package (kmr-class-name cl)))
+         (package (symbol-package (portable-class-name cl)))
          (ref-fields (slot-value cl 'ref-fields)))
       (declare (ignore classname))
       (dolist (f (slot-value cl 'fields))
@@ -259,56 +260,56 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 
 (defun hyperobject-class-fmtstr-text (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-text))
+  (slot-value (portable-class-of obj) 'fmtstr-text))
 
 (defun hyperobject-class-fmtstr-html (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-html))
+  (slot-value (portable-class-of obj) 'fmtstr-html))
 
 (defun hyperobject-class-fmtstr-xml (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-xml))
+  (slot-value (portable-class-of obj) 'fmtstr-xml))
 
 (defun hyperobject-class-fmtstr-text-labels (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-text-labels))
+  (slot-value (portable-class-of obj) 'fmtstr-text-labels))
 
 (defun hyperobject-class-fmtstr-html-labels (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-html-labels))
+  (slot-value (portable-class-of obj) 'fmtstr-html-labels))
 
 (defun hyperobject-class-fmtstr-xml-labels (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-xml-labels))
+  (slot-value (portable-class-of obj) 'fmtstr-xml-labels))
 
 (defun hyperobject-class-value-func (obj)
-  (slot-value (kmr-class-of obj) 'value-func))
+  (slot-value (portable-class-of obj) 'value-func))
 
 (defun hyperobject-class-xmlvalue-func (obj)
-  (slot-value (kmr-class-of obj) 'xmlvalue-func))
+  (slot-value (portable-class-of obj) 'xmlvalue-func))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defun hyperobject-class-title (obj)
-  (awhen (slot-value (kmr-class-of obj) 'title)
+  (awhen (slot-value (portable-class-of obj) 'title)
            (if (consp it)
                (car it)
              it))))
 
 (defun hyperobject-class-subobjects-lists (obj)
-  (slot-value (kmr-class-of obj) 'subobjects-lists))
+  (slot-value (portable-class-of obj) 'subobjects-lists))
 
 (defun hyperobject-class-ref-fields (obj)
-  (slot-value (kmr-class-of obj) 'ref-fields))
+  (slot-value (portable-class-of obj) 'ref-fields))
 
 (defun hyperobject-class-fields (obj)
-  (slot-value (kmr-class-of obj) 'fields))
+  (slot-value (portable-class-of obj) 'fields))
 
 (defun hyperobject-class-fmtstr-html-ref (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-html-ref))
+  (slot-value (portable-class-of obj) 'fmtstr-html-ref))
 
 (defun hyperobject-class-fmtstr-xml-ref (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-xml-ref))
+  (slot-value (portable-class-of obj) 'fmtstr-xml-ref))
 
 (defun hyperobject-class-fmtstr-html-ref-labels (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-html-ref-labels))
+  (slot-value (portable-class-of obj) 'fmtstr-html-ref-labels))
 
 (defun hyperobject-class-fmtstr-xml-ref-labels (obj)
-  (slot-value (kmr-class-of obj) 'fmtstr-xml-ref-labels))
+  (slot-value (portable-class-of obj) 'fmtstr-xml-ref-labels))
 
 ;;; Class name functions
 
@@ -317,7 +318,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
   (string-downcase (subseq name 1)))
   
 (defmethod hyperobject-class-stdname ((cl standard-object))
-  (string-downcase (subseq (kmr-class-name (kmr-class-of cl)) 1)))
+  (string-downcase (subseq (portable-class-name (portable-class-of cl)) 1)))
   
 ;;;; Generic Print functions
 
@@ -410,7 +411,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 
 
 (defun class-name-of (obj)
-  (string-downcase (kmr-class-name (kmr-class-of obj))))
+  (string-downcase (portable-class-name (portable-class-of obj))))
 
 (defun htmlformat-list-start-value-func (x nitems) 
   (values (hyperobject-class-title x) nitems (class-name-of x)))
@@ -727,8 +728,8 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
                         (dolist (child-obj it)   ;; for each child function
                           (awhen (funcall (car child-obj) obj) ;; access set of child objects
                                     (print-hyperobject-class it fmt strm label 
-                                                     english-only-function
-                                                     (1+ indent) subobjects refvars)))))
+                                                     (1+ indent) english-only-function
+                                                    subobjects refvars)))))
           (fmt-obj-end obj fmt strm indent)))
       (fmt-list-end (car objs) fmt strm indent nobjs))
     t))
@@ -743,8 +744,22 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
     (if file-wrapper
        (fmt-file-start fmt os))
     (when objs
-      (print-hyperobject-class objs fmt os label english-only-function 0 subobjects refvars))
+      (print-hyperobject-class objs fmt os label 0 english-only-function subobjects refvars))
     (if file-wrapper
        (fmt-file-end fmt os)))
   objs)
 
+
+(defclass hyperobject ()
+  ()
+  (:metaclass hyperobject-class))
+
+
+(defmethod print-object ((obj hyperobject) (s stream))
+  (print-unreadable-object (obj s :type t :identity t)
+    (let ((fmt (make-instance 'hyperobject::textformat)))
+      (apply #'format 
+            s (funcall (hyperobject::obj-data-fmtstr fmt) obj)
+            (multiple-value-list 
+             (funcall (funcall (hyperobject::obj-data-value-func fmt) obj) obj))))))
+

diff --git a/package.lisp b/package.lisp
index da354bb1e71b953e0922f0d6111846e6484e3e23..93383b69137eb39ff189a9ba9c98a8c12d7e4ff8 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.3 2002/11/04 18:02:13 kevin Exp $
+;;;; $Id: package.lisp,v 1.4 2002/11/04 19:19:04 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -20,6 +20,7 @@
   (:nicknames #:ho)
   (:use #:common-lisp #:kmrcl)
   (:export
+   #:hyperobject
    #:hyperobject-class
    #:hyperobject-base-url!
    #:hyperobject-class-title
@@ -27,4 +28,6 @@
    #:print-hyperobject
    ))
 
+(defpackage #:hyperobject-user
+  (:use #:hyperobject #:cl #:cl-user))