r3461: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Sat, 23 Nov 2002 18:41:45 +0000 (18:41 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Sat, 23 Nov 2002 18:41:45 +0000 (18:41 +0000)
example.lisp
hyperobject-no-mop.lisp
hyperobject.lisp
no-mop-example.lisp

index 75ef3f7baef8e6d0e804acfa78c892a97b456a13..39a884be6bae84599fbb1a39aa90439d7efaf347 100644 (file)
@@ -9,7 +9,7 @@
 ;;;;
 ;;;; A simple example file for hyperobjects
 ;;;;
-;;;; $Id: example.lisp,v 1.4 2002/11/22 19:48:49 kevin Exp $
+;;;; $Id: example.lisp,v 1.5 2002/11/23 18:41:45 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 
 
 (defclass person (hyperobject)
-  ((first-name :type string :initarg :first-name :reader first-name :initform nil)
-   (last-name :type string :initarg :last-name :reader last-name :initform nil
+  ((first-name :type string :initarg :first-name :reader first-name)
+   (last-name :type string :initarg :last-name :reader last-name
              :reference find-person-by-last-name)
-   (dob :type integer :initarg :dob :reader dob :initform 0 :format-func format-date)
+   (dob :type integer :initarg :dob :reader dob :print-formatter format-date)
    (resume :type cdata :initarg :resume :reader resume)
-   (addresses :initarg :addresses :reader addresses :initform nil :subobject t))
+   (addresses :initarg :addresses :reader addresses :subobject t))
   (:metaclass hyperobject-class)
+  (:default-initargs :first-name nil :last-name nil :dob 0 :resume nil) 
   (:print-slots first-name last-name dob resume)
   (:title "Person"))
 
                hr min sec))))
 
 (defclass address (hyperobject)
-  ((title :type string :initarg :title :reader title :initform nil)
-   (street :type string :initarg :street :reader street :initform nil)
-   (phones :initarg :phones :reader phones :initform nil :subobject t))
+  ((title :type string :initarg :title :reader title)
+   (street :type string :initarg :street :reader street)
+   (phones :initarg :phones :reader phones :subobject t))
   (:metaclass hyperobject-class)
+  (:default-initargs :title nil :street nil) 
   (:title "Address")
   (:print-slots title street))
 
@@ -53,6 +55,7 @@
   ((phone-number :type string :initarg :phone-number :reader phone-number))
   (:metaclass hyperobject-class)
   (:title "Phone Number")
+  (:default-initargs :phone-number nil)
   (:print-slots phone-number))
 
 
index d9f468bca963cf9c6520a9353def551ba85c0fd9..56c7f5e31b7f51c19697ee235f4a0d64229e34e4 100644 (file)
@@ -9,7 +9,7 @@
 ;;;;
 ;;;; This is a rewrite of hyperobjec't to avoid using metaclasses.
 ;;;;
-;;;; $Id: hyperobject-no-mop.lisp,v 1.2 2002/11/22 19:48:49 kevin Exp $
+;;;; $Id: hyperobject-no-mop.lisp,v 1.3 2002/11/23 18:41:45 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -48,7 +48,7 @@
 
 (defclass field ()
   ((name :type symbol :initform nil :initarg :name :reader name)
-   (format-func :initform nil :initarg :format-func :reader format-func)
+   (print-formatter :initform nil :initarg :print-formatter :reader print-formatter)
    (cl-type :initform nil :reader cl-type)
    (ho-type :initform nil :reader ho-type)
    (subobject :initform nil :reader subobject)
                     (name &rest rest &key
                           ;; the following list of keywords is reproduced below in the
                           ;; remove-keys form.  important to keep them in sync
-                          type reader writer accessor initform format-func initarg
+                          type reader writer accessor initform print-formatter initarg
                           reference subobject
                           ;; list ends
                           &allow-other-keys) field
                 (let ((other-args (remove-keys
-                                   '(type reader writer accessor initform format-func
+                                   '(type reader writer accessor initform print-formatter
                                      initarg reference subobject)
                               rest))
                       (field-obj (make-instance 'field :name name)) 
                   (push field-obj fields)
                   (loop for (k v) in `((:type ,type) (:reader ,reader) (:writer ,writer)
                                        (:accessor ,accessor) (:initform ,initform)
-                                       (:format-func ,format-func) (:initarg ,initarg)
+                                       (:print-formatter ,print-formatter) (:initarg ,initarg)
                                        (:subobject ,subobject) (:reference ,reference))
                      do
                        (case k
                          (:accessor
                           (when v
                             (push (list :accessor v) kv)))
-                         (:format-func
+                         (:print-formatter
                           (when v
-                            (setf (slot-value field-obj 'format-func) v)))
+                            (setf (slot-value field-obj 'print-formatter) v)))
                          (:writer
                           (when v
                             (push (list :writer v) kv)))
       (dolist (field (slot-value meta 'fields))
        (declare (ignore rest))
        (let* ((name (name field))
-              (format-func (format-func field))
+              (print-formatter (print-formatter field))
               (type (ho-type field))
               (reference (reference field))
               (namestr (symbol-name name))
                  (string-append fmtstr-html-ref-labels html-label-str)
                  (string-append fmtstr-xml-ref-labels xml-label-str)))
 
-           (if format-func
+           (if print-formatter
                (setq plain-value-func 
-                     (list `(,format-func (,(intern namestr package) x))))
+                     (list `(,print-formatter (,(intern namestr package) x))))
                (setq plain-value-func 
                      (list `(,(intern namestr package) x))))
            (setq value-func (append value-func plain-value-func))
index cedfa5e82452c1292e9c6daf9d07b2aace52db37..a6d1b4944119a80484e7e5da90eb92f0d9b90695 100644 (file)
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: hyperobject.lisp,v 1.9 2002/11/22 19:48:49 kevin Exp $
+;;;; $Id: hyperobject.lisp,v 1.10 2002/11/23 18:41:45 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 
 (defclass hyperobject-dsd (standard-direct-slot-definition)
   ((ho-type :initarg :ho-type :initform nil :accessor dsd-ho-type)
-   (format-func :initarg :format-func :initform nil :accessor dsd-format-func)
+   (print-formatter :initarg :print-formatter :initform nil :accessor dsd-print-formatter)
    (subobject :initarg :subobject :initform nil :accessor dsd-subobject)
    (reference :initarg :reference :initform nil :accessor dsd-reference)
    ))
 
 (defclass hyperobject-esd (standard-effective-slot-definition)
   ((ho-type :initarg :ho-type :initform nil :accessor esd-ho-type)
-   (format-func :initarg :format-func :initform nil :accessor esd-format-func)
+   (print-formatter :initarg :print-formatter :initform nil :accessor esd-print-formatter)
    (subobject :initarg :subobject :initform nil :accessor esd-subobject)
    (reference :initarg :reference :initform nil :accessor esd-reference)
   ))
@@ -162,7 +162,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
       (apply
        #'make-instance 'hyperobject-esd 
        :ho-type ho-type
-       :format-func (slot-value dsd 'format-func)
+       :print-formatter (slot-value dsd 'print-formatter)
        :subobject (slot-value dsd 'subobject)
        :reference (slot-value dsd 'reference)
        ia)))
@@ -226,7 +226,7 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
                (namestr (symbol-name (slot-definition-name slot)))
                (namestr-lower (string-downcase (symbol-name (slot-definition-name slot))))
                  (type (slot-value slot 'ho-type))
-                 (formatter (slot-value slot 'format-func))
+                 (print-formatter (slot-value slot 'print-formatter))
                  (value-fmt "~a")
                  (plain-value-func nil)
                  html-str xml-str html-label-str xml-label-str)
@@ -280,9 +280,9 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
                (string-append fmtstr-html-ref-labels html-label-str)
                (string-append fmtstr-xml-ref-labels xml-label-str)))
          
-         (if formatter
+         (if print-formatter
              (setq plain-value-func 
-                   (list `(,formatter (,(intern namestr package) x))))
+                   (list `(,print-formatter (,(intern namestr package) x))))
              (setq plain-value-func 
                    (list `(,(intern namestr package) x))))
          (setq value-func (append value-func plain-value-func))
index 414acf1529b9be13b9449890b155540291c893d9..88d5a8819aaef83f9926d00310b806056a63648e 100644 (file)
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: no-mop-example.lisp,v 1.2 2002/11/22 19:48:49 kevin Exp $
+;;;; $Id: no-mop-example.lisp,v 1.3 2002/11/23 18:41:45 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -22,7 +22,7 @@
 (define-hyperobject person ()
   ((first-name :type string :reference find-person-by-last-name)
    (last-name :type string)
-   (dob :type integer :initform 0 :format-func format-date)
+   (dob :type integer :initform 0 :print-formatter format-date)
    (resume :type cdata)
    (addresses :subobject t))
   (:title "Person")