;;;; 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.8 2002/12/05 19:15:02 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 "")
;; make list of hyperlink link fields for printing to refstr template
(dolist (ref (hyperobject-class-hyperlinks x))
- (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)))
- field-values)
- (append (link-parameters ref) refvars)))
- (link-end (make-link-end x (link-ref fmt) (name ref))))
- (push link-start refvalues)
- (push link-end refvalues)))
+ (let ((print-pos (position (name ref) (hyperobject-class-print-slots x))))
+ (when print-pos
+ (let ((link-start (make-link-start x (link-ref fmt) (name ref) (lookup ref)
+ (nth print-pos field-values)
+ (append (link-parameters ref) refvars)))
+ (link-end (make-link-end x (link-ref fmt) (name ref))))
+ (push link-start refvalues)
+ (push link-end refvalues)))))
(setq refvalues (nreverse refvalues))
-
(apply #'format s refstr refvalues)))
(defgeneric obj-data (obj))
(fmt-file-end fmt os)))
objs)
+
+;;; Misc formatting
+
+(defun fmt-comma-integer (i)
+ (format nil "~:d" i))
+