From c8c006fab664f91589e0aa6ae26f9b1c52fc37c1 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Sat, 23 Nov 2002 22:19:17 +0000
Subject: [PATCH] r3464: *** empty log message ***

---
 example-no-mop.lisp | 80 +++++++++++++++++++++++++++++++++++++++++++++
 hyperobject.lisp    |  5 +--
 2 files changed, 81 insertions(+), 4 deletions(-)
 create mode 100644 example-no-mop.lisp

diff --git a/example-no-mop.lisp b/example-no-mop.lisp
new file mode 100644
index 0000000..f36fae2
--- /dev/null
+++ b/example-no-mop.lisp
@@ -0,0 +1,80 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          hyperobject-plain-example.lisp
+;;;; Purpose:       Hyper Object Metaclass
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; This metaclass as functions to classes to allow display
+;;;; in Text, HTML, and XML formats. This includes hyperlinking
+;;;; capability and sub-objects.
+;;;;
+;;;; $Id: example-no-mop.lisp,v 1.1 2002/11/23 22:19:17 kevin Exp $
+;;;;
+;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+ 
+(in-package :hyperobject-no-mop-user)
+
+(define-hyperobject person ()
+  ((first-name :type string :reference find-person-by-last-name)
+   (last-name :type string)
+   (dob :type integer :initform 0 :print-formatter format-date)
+   (resume :type cdata)
+   (addresses :subobject t))
+  (:title "Person")
+  (:documentation "Person hyperobject class"))
+
+(defun format-date (ut)
+  (when (typep ut 'integer)
+      (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
+	  (decode-universal-time ut)
+	(declare (ignore daylight-p zone))
+	(format nil "~[Mon~;Tue~;Wed~;Thu~;Fri~;Sat~;Sun~], ~d ~[Jan~;Feb~;Mar~;Apr~;May~;Jun~;Jul~;Aug~;Sep~;Oct~;Nov~;Dec~] ~d ~2,'0d:~2,'0d:~2,'0d" 
+		dow
+		day
+		(1- mon)
+		year
+		hr min sec))))
+
+(define-hyperobject address ()
+  ((title :type string)
+   (street :type string)
+   (phones :subobject t))
+  (:title "Address")
+  (:documentation "Address hyperobject"))
+
+(define-hyperobject phone ()
+  ((phone-number :type string))
+  (:title "Phone Number")
+  (:documentation "Phone hyperobject"))
+
+
+(defparameter home-phone-1 (make-instance 'phone :phone-number "367-9812"))
+(defparameter home-phone-2 (make-instance 'phone :phone-number "367-9813"))
+
+(defparameter office-phone-1 (make-instance 'phone :phone-number "123-0001"))
+(defparameter office-phone-2 (make-instance 'phone :phone-number "123-0002"))
+(defparameter office-phone-3 (make-instance 'phone :phone-number "123-0005"))
+
+(defparameter home (make-instance 'address :title "Home" :street "321 Shady Lane"
+				  :phones (list home-phone-1 home-phone-2)))
+
+(defparameter office (make-instance 'address :title "Office" :street "113 Main St."
+				    :phones (list office-phone-1 office-phone-2 office-phone-3)))
+
+			      
+(defparameter mary (make-instance 'person :first-name "Mary" :last-name "Jackson"
+			    :dob (get-universal-time)
+			    :addresses (list home office)
+			    :resume "Style & Grace"))
+
+
+(format t "~&Text Format~%")
+(print-hyperobject mary :subobjects t)
+
+(format t "~&XML Format with field labels and hyperlinks~%")
+(print-hyperobject mary :subobjects t :label t :format :xmlref)
diff --git a/hyperobject.lisp b/hyperobject.lisp
index a6d1b49..454e57f 100644
--- 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.10 2002/11/23 18:41:45 kevin Exp $
+;;;; $Id: hyperobject.lisp,v 1.11 2002/11/23 22:19:17 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -234,9 +234,6 @@ Format is ((field-name field-lookup-func other-link-params) ...)")
 	      (when (or (eql type :integer) (eql type :fixnum))
 		(setq value-fmt "~d"))
 	      
-	      (when (eql type :commainteger)
-		(setq value-fmt "~:d"))
-	      
 	      (when (eql type :boolean)
 		(setq value-fmt "~a"))
 	      
-- 
2.34.1