;;;;
;;;; A simple example file for hyperobjects
;;;;
-;;;; $Id: example.lisp,v 1.4 2002/11/22 19:48:49 kevin Exp $
+;;;; $Id: example.lisp,v 1.5 2002/11/23 18:41:45 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
(defclass person (hyperobject)
- ((first-name :type string :initarg :first-name :reader first-name :initform nil)
- (last-name :type string :initarg :last-name :reader last-name :initform nil
+ ((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 :initform 0 :format-func format-date)
+ (dob :type integer :initarg :dob :reader dob :print-formatter format-date)
(resume :type cdata :initarg :resume :reader resume)
- (addresses :initarg :addresses :reader addresses :initform nil :subobject t))
+ (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"))
hr min sec))))
(defclass address (hyperobject)
- ((title :type string :initarg :title :reader title :initform nil)
- (street :type string :initarg :street :reader street :initform nil)
- (phones :initarg :phones :reader phones :initform nil :subobject t))
+ ((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))
((phone-number :type string :initarg :phone-number :reader phone-number))
(:metaclass hyperobject-class)
(:title "Phone Number")
+ (:default-initargs :phone-number nil)
(:print-slots phone-number))
;;;;
;;;; This is a rewrite of hyperobjec't to avoid using metaclasses.
;;;;
-;;;; $Id: hyperobject-no-mop.lisp,v 1.2 2002/11/22 19:48:49 kevin Exp $
+;;;; $Id: hyperobject-no-mop.lisp,v 1.3 2002/11/23 18:41:45 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
(defclass field ()
((name :type symbol :initform nil :initarg :name :reader name)
- (format-func :initform nil :initarg :format-func :reader format-func)
+ (print-formatter :initform nil :initarg :print-formatter :reader print-formatter)
(cl-type :initform nil :reader cl-type)
(ho-type :initform nil :reader ho-type)
(subobject :initform nil :reader subobject)
(name &rest rest &key
;; the following list of keywords is reproduced below in the
;; remove-keys form. important to keep them in sync
- type reader writer accessor initform format-func initarg
+ type reader writer accessor initform print-formatter initarg
reference subobject
;; list ends
&allow-other-keys) field
(let ((other-args (remove-keys
- '(type reader writer accessor initform format-func
+ '(type reader writer accessor initform print-formatter
initarg reference subobject)
rest))
(field-obj (make-instance 'field :name name))
(push field-obj fields)
(loop for (k v) in `((:type ,type) (:reader ,reader) (:writer ,writer)
(:accessor ,accessor) (:initform ,initform)
- (:format-func ,format-func) (:initarg ,initarg)
+ (:print-formatter ,print-formatter) (:initarg ,initarg)
(:subobject ,subobject) (:reference ,reference))
do
(case k
(:accessor
(when v
(push (list :accessor v) kv)))
- (:format-func
+ (:print-formatter
(when v
- (setf (slot-value field-obj 'format-func) v)))
+ (setf (slot-value field-obj 'print-formatter) v)))
(:writer
(when v
(push (list :writer v) kv)))
(dolist (field (slot-value meta 'fields))
(declare (ignore rest))
(let* ((name (name field))
- (format-func (format-func field))
+ (print-formatter (print-formatter field))
(type (ho-type field))
(reference (reference field))
(namestr (symbol-name name))
(string-append fmtstr-html-ref-labels html-label-str)
(string-append fmtstr-xml-ref-labels xml-label-str)))
- (if format-func
+ (if print-formatter
(setq plain-value-func
- (list `(,format-func (,(intern namestr package) x))))
+ (list `(,print-formatter (,(intern namestr package) x))))
(setq plain-value-func
(list `(,(intern namestr package) x))))
(setq value-func (append value-func plain-value-func))
;;;; in Text, HTML, and XML formats. This includes hyperlinking
;;;; capability and sub-objects.
;;;;
-;;;; $Id: hyperobject.lisp,v 1.9 2002/11/22 19:48:49 kevin Exp $
+;;;; $Id: hyperobject.lisp,v 1.10 2002/11/23 18:41:45 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
(defclass hyperobject-dsd (standard-direct-slot-definition)
((ho-type :initarg :ho-type :initform nil :accessor dsd-ho-type)
- (format-func :initarg :format-func :initform nil :accessor dsd-format-func)
+ (print-formatter :initarg :print-formatter :initform nil :accessor dsd-print-formatter)
(subobject :initarg :subobject :initform nil :accessor dsd-subobject)
(reference :initarg :reference :initform nil :accessor dsd-reference)
))
(defclass hyperobject-esd (standard-effective-slot-definition)
((ho-type :initarg :ho-type :initform nil :accessor esd-ho-type)
- (format-func :initarg :format-func :initform nil :accessor esd-format-func)
+ (print-formatter :initarg :print-formatter :initform nil :accessor esd-print-formatter)
(subobject :initarg :subobject :initform nil :accessor esd-subobject)
(reference :initarg :reference :initform nil :accessor esd-reference)
))
(apply
#'make-instance 'hyperobject-esd
:ho-type ho-type
- :format-func (slot-value dsd 'format-func)
+ :print-formatter (slot-value dsd 'print-formatter)
:subobject (slot-value dsd 'subobject)
:reference (slot-value dsd 'reference)
ia)))
(namestr (symbol-name (slot-definition-name slot)))
(namestr-lower (string-downcase (symbol-name (slot-definition-name slot))))
(type (slot-value slot 'ho-type))
- (formatter (slot-value slot 'format-func))
+ (print-formatter (slot-value slot 'print-formatter))
(value-fmt "~a")
(plain-value-func nil)
html-str xml-str html-label-str xml-label-str)
(string-append fmtstr-html-ref-labels html-label-str)
(string-append fmtstr-xml-ref-labels xml-label-str)))
- (if formatter
+ (if print-formatter
(setq plain-value-func
- (list `(,formatter (,(intern namestr package) x))))
+ (list `(,print-formatter (,(intern namestr package) x))))
(setq plain-value-func
(list `(,(intern namestr package) x))))
(setq value-func (append value-func plain-value-func))
;;;; in Text, HTML, and XML formats. This includes hyperlinking
;;;; capability and sub-objects.
;;;;
-;;;; $Id: no-mop-example.lisp,v 1.2 2002/11/22 19:48:49 kevin Exp $
+;;;; $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
;;;;
(define-hyperobject person ()
((first-name :type string :reference find-person-by-last-name)
(last-name :type string)
- (dob :type integer :initform 0 :format-func format-date)
+ (dob :type integer :initform 0 :print-formatter format-date)
(resume :type cdata)
(addresses :subobject t))
(:title "Person")