X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=no-mop-example.lisp;fp=no-mop-example.lisp;h=0000000000000000000000000000000000000000;hb=e964aded44e186a93e1a3d963ffc447efe6368e4;hp=88d5a8819aaef83f9926d00310b806056a63648e;hpb=c8c006fab664f91589e0aa6ae26f9b1c52fc37c1;p=hyperobject.git diff --git a/no-mop-example.lisp b/no-mop-example.lisp deleted file mode 100644 index 88d5a88..0000000 --- a/no-mop-example.lisp +++ /dev/null @@ -1,80 +0,0 @@ -;;;; -*- 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: no-mop-example.lisp,v 1.3 2002/11/23 18:41:45 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)