;;;; -*- 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: person.lisp,v 1.1 2002/11/29 23:14:32 kevin Exp $ ;;;; ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg ;;;; ;;;; ************************************************************************* (in-package :hyperobject-user) (defclass person (hyperobject) ((first-name :type string :initarg :first-name :reader first-name) (last-name :type string :initarg :last-name :reader last-name :reference find-person-by-last-name) (dob :type integer :initarg :dob :reader dob :print-formatter format-date) (resume :type cdata :initarg :resume :reader resume) (addresses :initarg :addresses :reader addresses :subobject t)) (:metaclass hyperobject-class) (:default-initargs :first-name nil :last-name nil :dob 0 :resume nil) (:print-slots first-name last-name dob resume) (:title "Person") (:description "A Person")) (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 :subobject t)) (:metaclass hyperobject-class) (:default-initargs :title nil :street nil) (:title "Address") (:print-slots title street) (:description "An address")) (defclass phone (hyperobject) ((title :type string :initarg :title :reader title) (phone-number :type string :initarg :phone-number :reader phone-number)) (:metaclass hyperobject-class) (:title "Phone Number") (:default-initargs :title nil :phone-number nil) (:print-slots title phone-number) (:description "A phone number")) (defparameter home-phone-1 (make-instance 'phone :title "Voice" :phone-number "367-9812")) (defparameter home-phone-2 (make-instance 'phone :title "Fax" :phone-number "367-9813")) (defparameter office-phone-1 (make-instance 'phone :title "Main line" :phone-number "123-0001")) (defparameter office-phone-2 (make-instance 'phone :title "Staff line" :phone-number "123-0002")) (defparameter office-phone-3 (make-instance 'phone :title "Fax" :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~%") (view mary :subobjects t) (format t "~&XML Format with field labels and hyperlinks~%") (view mary :subobjects t :label t :format :xmlref)