1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: hyperobject-example.lisp
6 ;;;; Purpose: Hyperobject Example file
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Oct 2002
10 ;;;; A simple example file for hyperobjects
12 ;;;; $Id: mop-example.lisp,v 1.1 2002/11/22 10:49:24 kevin Exp $
14 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
16 ;;;; *************************************************************************
18 (in-package :hyperobject-mop-user)
21 (defclass person (hyperobject)
22 ((first-name :type string :initarg :first-name :reader first-name)
23 (last-name :type string :initarg :last-name :reader last-name)
24 (dob :type integer :initarg :dob :reader dob)
25 (resume :initarg :resume :reader resume)
26 (addresses :initarg :addresses :reader addresses))
27 (:metaclass hyperobject-class)
29 :first-name nil :last-name nil :resume nil :dob 0 :addresses nil)
31 (:subobjects-lists (addresses address))
32 (:fields (first-name :string) (last-name :string) (dob :integer format-date)
34 (:ref-fields (last-name find-person-by-last-name)))
36 (defun format-date (ut)
37 (when (typep ut 'integer)
38 (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
39 (decode-universal-time ut)
40 (declare (ignore daylight-p zone))
41 (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"
48 (defclass address (hyperobject)
49 ((title :type string :initarg :title :reader title)
50 (street :type string :initarg :street :reader street)
51 (phones :initarg :phones :reader phones))
52 (:metaclass hyperobject-class)
53 (:default-initargs :title nil :street nil :phones nil)
55 (:subobjects-lists (phones phone))
56 (:fields (title :string) (street :string)))
59 (defclass phone (hyperobject)
60 ((phone-number :type string :initarg :phone-number :reader phone-number))
61 (:metaclass hyperobject-class)
62 (:title "Phone Number")
63 (:fields (phone-number :string)))
66 (defparameter home-phone-1 (make-instance 'phone :phone-number "367-9812"))
67 (defparameter home-phone-2 (make-instance 'phone :phone-number "367-9813"))
69 (defparameter office-phone-1 (make-instance 'phone :phone-number "123-0001"))
70 (defparameter office-phone-2 (make-instance 'phone :phone-number "123-0002"))
71 (defparameter office-phone-3 (make-instance 'phone :phone-number "123-0005"))
73 (defparameter home (make-instance 'address :title "Home" :street "321 Shady Lane"
74 :phones (list home-phone-1 home-phone-2)))
76 (defparameter office (make-instance 'address :title "Office" :street "113 Main St."
77 :phones (list office-phone-1 office-phone-2 office-phone-3)))
80 (defparameter mary (make-instance 'person :first-name "Mary" :last-name "Jackson"
81 :dob (get-universal-time)
82 :addresses (list home office)
83 :resume "Style & Grace"))
86 (format t "~&Text Format~%")
87 (print-hyperobject mary :subobjects t)
89 (format t "~&XML Format with field labels and hyperlinks~%")
90 (print-hyperobject mary :subobjects t :label t :format :xmlref)