1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: hyperobject-plain-example.lisp
6 ;;;; Purpose: Hyper Object Metaclass
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Apr 2000
10 ;;;; This metaclass as functions to classes to allow display
11 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
12 ;;;; capability and sub-objects.
16 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
18 ;;;; *************************************************************************
20 (in-package :hyperobject-no-mop-user)
22 (define-hyperobject person ()
23 ((first-name :type string :reference find-person-by-last-name)
24 (last-name :type string)
25 (dob :type integer :initform 0 :print-formatter format-date)
27 (addresses :subobject t))
29 (:documentation "Person hyperobject class"))
31 (defun format-date (ut)
32 (when (typep ut 'integer)
33 (multiple-value-bind (sec min hr day mon year dow daylight-p zone)
34 (decode-universal-time ut)
35 (declare (ignore daylight-p zone))
36 (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"
43 (define-hyperobject address ()
46 (phones :subobject t))
48 (:documentation "Address hyperobject"))
50 (define-hyperobject phone ()
51 ((phone-number :type string))
52 (:title "Phone Number")
53 (:documentation "Phone hyperobject"))
56 (defparameter home-phone-1 (make-instance 'phone :phone-number "367-9812"))
57 (defparameter home-phone-2 (make-instance 'phone :phone-number "367-9813"))
59 (defparameter office-phone-1 (make-instance 'phone :phone-number "123-0001"))
60 (defparameter office-phone-2 (make-instance 'phone :phone-number "123-0002"))
61 (defparameter office-phone-3 (make-instance 'phone :phone-number "123-0005"))
63 (defparameter home (make-instance 'address :title "Home" :street "321 Shady Lane"
64 :phones (list home-phone-1 home-phone-2)))
66 (defparameter office (make-instance 'address :title "Office" :street "113 Main St."
67 :phones (list office-phone-1 office-phone-2 office-phone-3)))
70 (defparameter mary (make-instance 'person :first-name "Mary" :last-name "Jackson"
71 :dob (get-universal-time)
72 :addresses (list home office)
73 :resume "Style & Grace"))
76 (format t "~&Text Format~%")
77 (print-hyperobject mary :subobjects t)
79 (format t "~&XML Format with field labels and hyperlinks~%")
80 (print-hyperobject mary :subobjects t :label t :format :xmlref)