X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=examples%2Fexample-no-mop.lisp;fp=examples%2Fexample-no-mop.lisp;h=0000000000000000000000000000000000000000;hb=c0d7503d6636b6d5adb762258fdb20c1b4ceb53a;hp=c2393f14d213e8fa090f411f37f33a35ddacfae4;hpb=cda49a13fa66d935f4d7db644364cc741b9c1c4c;p=hyperobject.git diff --git a/examples/example-no-mop.lisp b/examples/example-no-mop.lisp deleted file mode 100644 index c2393f1..0000000 --- a/examples/example-no-mop.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: example-no-mop.lisp,v 1.1 2002/11/25 04:47:23 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)