;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: views.lisp,v 1.4 2002/11/29 23:14:31 kevin Exp $
+;;;; $Id: views.lisp,v 1.7 2002/12/05 18:31:36 kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
(in-package :hyperobject)
(eval-when (:compile-toplevel :execute)
- (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
+ (declaim (optimize (speed 2) (safety 2) (compilation-speed 0) (debug 2))))
;;;; *************************************************************************
;;;; Metaclass Intialization
;;;; *************************************************************************
-(defun process-views (cl)
+(defun finalize-hyperlinks (cl)
+ (let ((hyperlinks '()))
+ (dolist (esd (class-slots cl))
+ (awhen (slot-value esd 'hyperlink)
+ (push
+ (make-instance 'hyperlink
+ :name (slot-definition-name esd)
+ :lookup it
+ :link-parameters (slot-value esd 'hyperlink-parameters))
+ hyperlinks)))
+ (setf (slot-value cl 'hyperlinks) hyperlinks)))
+
+
+(defun finalize-views (cl)
"Calculate all view slots for a hyperobject class"
(let ((fmtstr-text "")
(fmtstr-html "")
(let ((link-start
(make-link-start x (link-ref fmt) (name ref) (lookup ref)
(nth (position (name ref)
- (hyperobject-class-fields x)
- :key #'(lambda (x)
- (slot-definition-name x)))
+ (slot-value x 'print-slots))
field-values)
(append (link-parameters ref) refvars)))
(link-end (make-link-end x (link-ref fmt) (name ref))))
(fmt-file-end fmt os)))
objs)
+
+;;; Misc formatting
+
+(defun fmt-comma-integer (i)
+ (format nil "~:d" i))
+