r3461: *** empty log message ***

[hyperobject.git] / hyperobject-no-mop.lisp

diff --git a/hyperobject-no-mop.lisp b/hyperobject-no-mop.lisp
index d9f468bca963cf9c6520a9353def551ba85c0fd9..56c7f5e31b7f51c19697ee235f4a0d64229e34e4 100644 (file)
--- a/hyperobject-no-mop.lisp
+++ b/hyperobject-no-mop.lisp
@@ -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)
@@ -113,12 +113,12 @@
                     (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)) 
@@ -127,7 +127,7 @@
                   (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
@@ -141,9 +141,9 @@
                          (: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)))
@@ -219,7 +219,7 @@
       (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))
@@ -272,9 +272,9 @@
                  (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))