r5024: *** empty log message ***

diff --git a/base-class.lisp b/base-class.lisp
index 93eed698c6befd4686fd2591f98f4be37db44be8..4b65c8d441be56ec697de28d0e686b4ded29bf53 100644 (file)
--- a/base-class.lisp
+++ b/base-class.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: base-class.lisp,v 1.8 2003/05/14 08:30:38 kevin Exp $
+;;;; $Id: base-class.lisp,v 1.9 2003/05/22 20:40:03 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -24,5 +24,6 @@
 
 (defmethod print-object ((obj hyperobject) (s stream))
   (print-unreadable-object (obj s :type t :identity nil)
-    (funcall (obj-data-func (get-category-view obj :compact-text)) obj s nil)))
+    (funcall (obj-data-printer (get-category-view obj :compact-text))
+            obj s nil)))
 

diff --git a/debian/changelog b/debian/changelog
index 7d24471efba7328f5a1aeeba694b189b22e11c89..1836e2af6da41d428cc102c1633e231c747e2cf6 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-hyperobject (2.8.5-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Thu, 22 May 2003 14:23:26 -0600
+
 cl-hyperobject (2.8.4-1) unstable; urgency=low
 
   * New upstream

diff --git a/hyperobject.asd b/hyperobject.asd
index abc41a8cdb3175b92ebc85a31af3bdd191f110f5..ff1932628c4833ac1e2a18132b63efb344fc19f2 100644 (file)
--- a/hyperobject.asd
+++ b/hyperobject.asd
@@ -7,7 +7,7 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: hyperobject.asd,v 1.23 2003/04/28 21:11:55 kevin Exp $
+;;;; $Id: hyperobject.asd,v 1.24 2003/05/22 20:40:03 kevin Exp $
 ;;;; *************************************************************************
 
 (defpackage hyperobject-system (:use #:asdf #:cl))
@@ -30,7 +30,6 @@
    (:file "sql" :depends-on ("connect"))
    (:file "views" :depends-on ("mop"))
    (:file "base-class" :depends-on ("views" "sql" "rules"))
-   (:file "wrapper" :depends-on ("base-class"))
    )
   :depends-on (:kmrcl :clsql))
 

diff --git a/old/wrapper.lisp b/old/wrapper.lisp
new file mode 100644 (file)
index 0000000..5c550af
--- /dev/null
+++ b/old/wrapper.lisp
@@ -0,0 +1,66 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          wrapper.lisp
+;;;; Purpose:       Macro wrapper for Hyperobject
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: wrapper.lisp,v 1.1 2003/05/22 20:40:03 kevin Exp $
+;;;;
+;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
+;;;; *************************************************************************
+
+(in-package :hyperobject)
+
+(eval-when (:compile-toplevel :execute)
+  (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
+
+#||
+(defmacro define-hyperobject (name parents fields &rest meta-fields)
+  (let* ((meta-fields (process-meta-fields fields meta-fields))
+        (cl-fields (process-hyper-fields fields meta-fields)))
+    `(progn
+       (eval-when (:compile-toplevel :load-toplevel :execute)
+        (defclass ,name ,(append parents (list 'hyperobject)) ,cl-fields
+          ,@meta-fields))(and documentation (list (list :documentation documentation)))))
+       (let ((,value-func (compile nil (eval (slot-value ,meta 'value-func))))
+            (,xml-value-func (compile nil (eval (slot-value ,meta 'xml-value-func)))))
+        (defmethod ho-title ((obj ,name))
+          ,title)
+        (defmethod ho-name ((obj ,name))
+          ,(string-downcase (symbol-name name)))
+        (defmethod ho-fields ((obj ,name))
+          ',(slot-value meta 'fields))
+        (defmethod ho-references ((obj ,name))
+          ',(slot-value meta 'references))
+        (defmethod ho-subobjects ((obj ,name))
+          ',(slot-value meta 'subobjects))
+        (defmethod ho-value-func ((obj ,name))
+          ,value-func)
+        (defmethod ho-xml-value-func ((obj ,name))
+          ,xml-value-func)
+        (defmethod ho-fmtstr-text ((obj ,name))
+          ,(slot-value meta 'fmtstr-text))
+        (defmethod ho-fmtstr-html ((obj ,name))
+          ,(slot-value meta 'fmtstr-html))
+        (defmethod ho-fmtstr-xml ((obj ,name))
+          ,(slot-value meta 'fmtstr-xml))
+        (defmethod ho-fmtstr-text-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-text-labels))
+        (defmethod ho-fmtstr-html-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-html-labels))
+        (defmethod ho-fmtstr-xml-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-xml-labels))
+        (defmethod ho-fmtstr-html-ref ((obj ,name))
+          ,(slot-value meta 'fmtstr-html-ref))
+        (defmethod ho-fmtstr-xml-ref ((obj ,name))
+          ,(slot-value meta 'fmtstr-xml-ref))
+        (defmethod ho-fmtstr-html-ref-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-html-ref-labels))
+        (defmethod ho-fmtstr-xml-ref-labels ((obj ,name))
+          ,(slot-value meta 'fmtstr-xml-ref-labels))
+        ))))
+
+||#

diff --git a/views.lisp b/views.lisp
index 6c7b9faef997129baff6515a300461f4dd9601fa..70819fd276faa89a894cb03156d4e386fd4db58a 100644 (file)
--- a/views.lisp
+++ b/views.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: views.lisp,v 1.45 2003/05/16 07:35:09 kevin Exp $
+;;;; $Id: views.lisp,v 1.46 2003/05/22 20:40:03 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
 ;;;; *************************************************************************
@@ -40,29 +40,29 @@
                   :accessor file-start-str)
    (file-end-str :type (or string null) :initform nil :initarg :file-end-str
                 :accessor file-end-str)
-   (list-start-str-or-func :type (or string function null) :initform nil
-                          :initarg :list-start-str-or-func
-                     :accessor list-start-str-or-func)
+   (list-start-printer :type (or string function null) :initform nil
+                          :initarg :list-start-printer
+                     :accessor list-start-printer)
    (list-start-indent :initform nil :initarg :list-start-indent
                      :accessor list-start-indent)
-   (list-end-str-or-func :type (or string function null) :initform nil
-                        :initarg :list-end-str-or-func
-                   :accessor list-end-str-or-func)
+   (list-end-printer :type (or string function null) :initform nil
+                        :initarg :list-end-printer
+                   :accessor list-end-printer)
    (list-end-indent :initform nil :initarg :list-end-indent
                    :accessor list-end-indent)
-   (obj-start-str-or-func :type (or string function null) :initform nil :initarg :obj-start-str-or-func
-                    :accessor obj-start-str-or-func)
+   (obj-start-printer :type (or string function null) :initform nil :initarg :obj-start-printer
+                    :accessor obj-start-printer)
    (obj-start-indent :initform nil :initarg :obj-start-indent
                     :accessor obj-start-indent)
-   (obj-end-str-or-func :type (or string function null) :initform nil :initarg :obj-end-str-or-func
-                  :accessor obj-end-str-or-func)
+   (obj-end-printer :type (or string function null) :initform nil :initarg :obj-end-printer
+                  :accessor obj-end-printer)
    (obj-end-indent :initform nil :initarg :obj-end-indent
                   :accessor obj-end-indent)
    (obj-data-indent :initform nil :initarg :obj-data-indent
                    :accessor obj-data-indent)
-   (obj-data-func :type (or function null) :initform nil
-                       :initarg :obj-data-func
-                       :accessor obj-data-func)
+   (obj-data-printer :type (or function null) :initform nil
+                       :initarg :obj-data-printer
+                       :accessor obj-data-printer)
    (obj-data-print-code :type (or function null) :initform nil
                  :initarg :obj-data-print-code
                  :accessor obj-data-print-code)
@@ -335,7 +335,7 @@
       (setf (obj-data-print-code view) `(lambda (x s links)
                                         (declare (ignorable links))
                                         ,@(map 'list #'identity print-func)))
-      (setf (obj-data-func view)
+      (setf (obj-data-printer view)
            (compile nil (eval (obj-data-print-code view)))))
     
     (setf (link-slots view) (nreverse links)))
@@ -391,7 +391,7 @@
    strm))
 
 (defun initialize-text-view (view)
-  (setf (list-start-str-or-func view)
+  (setf (list-start-printer view)
        (compile nil
                 (eval '(lambda (obj nitems strm)
                         (write-user-name-maybe-plural obj nitems strm)
@@ -414,13 +414,13 @@
   (setf (file-start-str view) (format nil "<html><body>~%"))
   (setf (file-end-str view) (format nil "</body><html>~%"))
   (setf (list-start-indent view) t)
-  (setf (list-start-str-or-func view) #'html-list-start-func)
-  (setf (list-end-str-or-func view) (format nil "</ul></div>~%"))
+  (setf (list-start-printer view) #'html-list-start-func)
+  (setf (list-end-printer view) (format nil "</ul></div>~%"))
   (setf (list-end-indent view) t)
   (setf (obj-start-indent view) t)
-  (setf (obj-start-str-or-func view) "<li>")
+  (setf (obj-start-printer view) "<li>")
   (setf (obj-end-indent view)  t)
-  (setf (obj-end-str-or-func view)  (format nil "</li>~%"))
+  (setf (obj-end-printer view)  (format nil "</li>~%"))
   (setf (obj-data-indent view) nil))
 
 (defun initialize-xhtml-view (view)
@@ -428,13 +428,13 @@
   (setf (file-start-str view) (format nil "<html><body>~%"))
   (setf (file-end-str view) (format nil "</body><html>~%"))
   (setf (list-start-indent view) t)
-  (setf (list-start-str-or-func view) #'html-list-start-func)
-  (setf (list-end-str-or-func view) (format nil "</ul></div>~%"))
+  (setf (list-start-printer view) #'html-list-start-func)
+  (setf (list-end-printer view) (format nil "</ul></div>~%"))
   (setf (list-end-indent view) t)
   (setf (obj-start-indent view) t)
-  (setf (obj-start-str-or-func view) "<li>")
+  (setf (obj-start-printer view) "<li>")
   (setf (obj-end-indent view)  t)
-  (setf (obj-end-str-or-func view) (format nil "</li>~%"))
+  (setf (obj-end-printer view) (format nil "</li>~%"))
   (setf (obj-data-indent view) nil))
 
 (defun xmlformat-list-end-func (x strm)
@@ -456,12 +456,12 @@
   (initialize-text-view view)
   (setf (file-start-str view) "") ; (std-xml-header)
   (setf (list-start-indent view)  t)
-  (setf (list-start-str-or-func view) #'xmlformat-list-start-func)
+  (setf (list-start-printer view) #'xmlformat-list-start-func)
   (setf (list-end-indent view) t)
-  (setf (list-end-str-or-func view) #'xmlformat-list-end-func)
-  (setf (obj-start-str-or-func view) (format nil "<~(~a~)>" (object-class-name view)))
+  (setf (list-end-printer view) #'xmlformat-list-end-func)
+  (setf (obj-start-printer view) (format nil "<~(~a~)>" (object-class-name view)))
   (setf (obj-start-indent view) t)
-  (setf (obj-end-str-or-func view) (format nil "</~(~a~)>~%" (object-class-name view)))
+  (setf (obj-end-printer view) (format nil "</~(~a~)>~%" (object-class-name view)))
   (setf (obj-end-indent view) nil)
   (setf (obj-data-indent view) nil))
 
@@ -481,7 +481,7 @@
 (defun fmt-list-start (obj view strm indent num-items)
   (when (list-start-indent view)
     (indent-spaces indent strm))
-  (awhen (list-start-str-or-func view)
+  (awhen (list-start-printer view)
         (if (stringp it)
             (write-string it strm)
             (funcall it obj num-items strm))))
@@ -490,7 +490,7 @@
   (declare (ignore num-items))
   (when (list-end-indent view)
       (indent-spaces indent strm))
-  (awhen (list-end-str-or-func view)
+  (awhen (list-end-printer view)
         (if (stringp it)
             (write-string it strm)
             (funcall it obj strm))))
@@ -500,7 +500,7 @@
 (defun fmt-obj-start (obj view strm indent)
   (when (obj-start-indent view)
     (indent-spaces indent strm))
-  (awhen (obj-start-str-or-func view)
+  (awhen (obj-start-printer view)
         (if (stringp it)
             (write-string it strm)
             (funcall it obj strm))))
@@ -508,7 +508,7 @@
 (defun fmt-obj-end (obj view strm indent)
   (when (obj-end-indent view)
     (indent-spaces indent strm))
-  (awhen (obj-end-str-or-func view)
+  (awhen (obj-end-printer view)
         (if (stringp it)
             (write-string it strm)
             (funcall it obj strm))))
@@ -547,7 +547,7 @@
         (write-string it strm)))
 
 (defun fmt-obj-data-plain (obj view strm)
-  (awhen (obj-data-func view)
+  (awhen (obj-data-printer view)
         (funcall it obj strm nil)))
 
 (defun fmt-obj-data-with-link (obj view strm refvars)
@@ -559,7 +559,7 @@
                                    (append (link-parameters it) refvars))
                   refvalues)
             (push (make-link-end obj view name) refvalues)))
-    (funcall (obj-data-func view) obj strm (nreverse refvalues))))
+    (funcall (obj-data-printer view) obj strm (nreverse refvalues))))
 
 (defun obj-data (obj view)
   "Returns the objects data as a string. Used by common-graphics outline function"

diff --git a/wrapper.lisp b/wrapper.lisp
deleted file mode 100644 (file)
index d6f5427..0000000
--- a/wrapper.lisp
+++ /dev/null
@@ -1,66 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          wrapper.lisp
-;;;; Purpose:       Macro wrapper for Hyperobject
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Apr 2000
-;;;;
-;;;; $Id: wrapper.lisp,v 1.4 2003/05/14 05:29:48 kevin Exp $
-;;;;
-;;;; This file is Copyright (c) 2000-2003 by Kevin M. Rosenberg
-;;;; *************************************************************************
-
-(in-package :hyperobject)
-
-(eval-when (:compile-toplevel :execute)
-  (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
-
-#||
-(defmacro define-hyperobject (name parents fields &rest meta-fields)
-  (let* ((meta-fields (process-meta-fields fields meta-fields))
-        (cl-fields (process-hyper-fields fields meta-fields)))
-    `(progn
-       (eval-when (:compile-toplevel :load-toplevel :execute)
-        (defclass ,name ,(append parents (list 'hyperobject)) ,cl-fields
-          ,@meta-fields))(and documentation (list (list :documentation documentation)))))
-       (let ((,value-func (compile nil (eval (slot-value ,meta 'value-func))))
-            (,xml-value-func (compile nil (eval (slot-value ,meta 'xml-value-func)))))
-        (defmethod ho-title ((obj ,name))
-          ,title)
-        (defmethod ho-name ((obj ,name))
-          ,(string-downcase (symbol-name name)))
-        (defmethod ho-fields ((obj ,name))
-          ',(slot-value meta 'fields))
-        (defmethod ho-references ((obj ,name))
-          ',(slot-value meta 'references))
-        (defmethod ho-subobjects ((obj ,name))
-          ',(slot-value meta 'subobjects))
-        (defmethod ho-value-func ((obj ,name))
-          ,value-func)
-        (defmethod ho-xml-value-func ((obj ,name))
-          ,xml-value-func)
-        (defmethod ho-fmtstr-text ((obj ,name))
-          ,(slot-value meta 'fmtstr-text))
-        (defmethod ho-fmtstr-html ((obj ,name))
-          ,(slot-value meta 'fmtstr-html))
-        (defmethod ho-fmtstr-xml ((obj ,name))
-          ,(slot-value meta 'fmtstr-xml))
-        (defmethod ho-fmtstr-text-labels ((obj ,name))
-          ,(slot-value meta 'fmtstr-text-labels))
-        (defmethod ho-fmtstr-html-labels ((obj ,name))
-          ,(slot-value meta 'fmtstr-html-labels))
-        (defmethod ho-fmtstr-xml-labels ((obj ,name))
-          ,(slot-value meta 'fmtstr-xml-labels))
-        (defmethod ho-fmtstr-html-ref ((obj ,name))
-          ,(slot-value meta 'fmtstr-html-ref))
-        (defmethod ho-fmtstr-xml-ref ((obj ,name))
-          ,(slot-value meta 'fmtstr-xml-ref))
-        (defmethod ho-fmtstr-html-ref-labels ((obj ,name))
-          ,(slot-value meta 'fmtstr-html-ref-labels))
-        (defmethod ho-fmtstr-xml-ref-labels ((obj ,name))
-          ,(slot-value meta 'fmtstr-xml-ref-labels))
-        ))))
-
-||#