X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop-example.lisp;fp=mop-example.lisp;h=ce275d52f4a6e6dc5e666d46a48d7528313f7f24;hb=63b552ae64bb098d42c4f23c2850a03ff707f12a;hp=0000000000000000000000000000000000000000;hpb=2b7f11038d88180777d7c6ac9a02f26c020c2c0d;p=hyperobject.git

diff --git a/mop-example.lisp b/mop-example.lisp
new file mode 100644
index 0000000..ce275d5
--- /dev/null
+++ b/mop-example.lisp
@@ -0,0 +1,90 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          hyperobject-example.lisp
+;;;; Purpose:       Hyperobject Example file
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Oct 2002
+;;;;
+;;;; A simple example file for hyperobjects
+;;;;
+;;;; $Id: mop-example.lisp,v 1.1 2002/11/22 10:49:24 kevin Exp $
+;;;;
+;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+ 
+(in-package :hyperobject-mop-user)
+
+
+(defclass person (hyperobject)
+  ((first-name :type string :initarg :first-name :reader first-name)
+   (last-name :type string :initarg :last-name :reader last-name)
+   (dob :type integer :initarg :dob :reader dob)
+   (resume :initarg :resume :reader resume)
+   (addresses :initarg :addresses :reader addresses))
+  (:metaclass hyperobject-class)
+  (:default-initargs 
+   :first-name nil :last-name nil :resume nil :dob 0 :addresses nil)
+  (:title "Person")
+  (:subobjects-lists (addresses address))
+  (:fields (first-name  :string) (last-name :string) (dob :integer format-date)
+	   (resume :cdata))
+  (:ref-fields (last-name find-person-by-last-name)))
+
+(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))))
+
+(defclass address (hyperobject)
+  ((title :type string :initarg :title :reader title)
+   (street :type string :initarg :street :reader street)
+   (phones :initarg :phones :reader phones))
+  (:metaclass hyperobject-class)
+  (:default-initargs :title nil :street nil :phones nil)
+  (:title "Address")
+  (:subobjects-lists (phones phone))
+  (:fields (title :string) (street  :string)))
+
+
+(defclass phone (hyperobject)
+  ((phone-number :type string :initarg :phone-number :reader phone-number))
+  (:metaclass hyperobject-class)
+  (:title "Phone Number")
+  (:fields (phone-number :string)))
+
+
+(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)