X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=mop.lisp;h=1094c56f0fd4595ab9b97dc7db90a14f6be3bd71;hb=da95022a6396191e772e59cd7622c7c5919ce605;hp=e315843aecc11282fdca3291278f10290f80a8e7;hpb=8c743e4dea6fe52c62c1cdf02a75839654e1427c;p=hyperobject.git

diff --git a/mop.lisp b/mop.lisp
index e315843..1094c56 100644
--- a/mop.lisp
+++ b/mop.lisp
@@ -11,7 +11,7 @@
 ;;;; in Text, HTML, and XML formats. This includes hyperlinking
 ;;;; capability and sub-objects.
 ;;;;
-;;;; $Id: mop.lisp,v 1.9 2002/12/09 19:37:54 kevin Exp $
+;;;; $Id: mop.lisp,v 1.10 2002/12/13 05:44:19 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -28,8 +28,8 @@
   ( ;; slots initialized in defclass
    (user-name :initarg :user-name :type string :initform nil
 	  :documentation "User name for class")
-   (print-slots :initarg :print-slots :type list :initform nil
-		:documentation "List of slots to print")
+   (default-print-slots :initarg :default-print-slots :type list :initform nil
+			:documentation "Defaults slots for a view")
    (description :initarg :description :initform nil
 		:documentation "Class description")
    (version :initarg :version :initform nil
@@ -45,23 +45,16 @@
 	       "List of fields that have hyperlinks")
    (class-id :type integer :initform nil :documentation
 	     "Unique ID for the class")
-   
+
+   ;; SQL commands
    (create-table-cmd :initform nil :reader create-table-cmd)
    (create-indices-cmds :initform nil :reader create-index-cmds)
    (drop-table-cmd :initform nil :reader drop-table-cmd)
 
-   (value-func :initform nil :type function)
-   (xmlvalue-func :initform nil :type function)
-   (fmtstr-text :initform nil :type string)
-   (fmtstr-html :initform nil :type string)
-   (fmtstr-xml :initform nil :type string)
-   (fmtstr-text-labels :initform nil :type string)
-   (fmtstr-html-labels :initform nil :type string)
-   (fmtstr-xml-labels :initform nil :type string)
-   (fmtstr-html-ref :initform nil :type string)
-   (fmtstr-xml-ref :initform nil :type string)
-   (fmtstr-html-ref-labels :initform nil :type string)
-   (fmtstr-xml-ref-labels :initform nil :type string)
+   (views :type list :initform nil :initarg :views :accessor views
+	  :documentation "List of views")
+   (default-view :initform nil :initarg :default-view :accessor default-view
+		 :documentation "The default view for a class")
    )
   (:documentation "Metaclass for Markup Language classes."))
 
@@ -93,7 +86,8 @@
   t)
 
 (defmethod finalize-inheritance :after ((cl hyperobject-class))
-  (init-hyperobject-class cl))
+  (init-hyperobject-class cl)
+  )
 
 ;; Slot definitions
 (defmethod direct-slot-definition-class ((cl hyperobject-class) 
@@ -305,10 +299,22 @@
 		   (format nil "~%Class description: ~A" it) "")
 	      (aif (slot-value cl 'subobjects)
 		   (format nil "~%Subobjects:~{ ~A~}" (mapcar #'name-slot it)) "")
-	      (aif (slot-value cl 'print-slots)
-		   (format nil "~%Print-slots:~{ ~A~}" it) "")
+	      (aif (slot-value cl 'default-print-slots)
+		   (format nil "~%Default print slots:~{ ~A~}" it) "")
 	      ))))
 
+(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 init-hyperobject-class (cl)
   "Initialize a hyperobject class. Calculates all class slots"
   (finalize-subobjects cl)
@@ -325,30 +331,6 @@
 (defun find-slot-by-name (cl name)
   (find name (class-slots cl) :key #'slot-definition-name))
 
-(defun hyperobject-class-fmtstr-text (obj)
-  (slot-value (class-of obj) 'fmtstr-text))
-
-(defun hyperobject-class-fmtstr-html (obj)
-  (slot-value (class-of obj) 'fmtstr-html))
-
-(defun hyperobject-class-fmtstr-xml (obj)
-  (slot-value (class-of obj) 'fmtstr-xml))
-
-(defun hyperobject-class-fmtstr-text-labels (obj)
-  (slot-value (class-of obj) 'fmtstr-text-labels))
-
-(defun hyperobject-class-fmtstr-html-labels (obj)
-  (slot-value (class-of obj) 'fmtstr-html-labels))
-
-(defun hyperobject-class-fmtstr-xml-labels (obj)
-  (slot-value (class-of obj) 'fmtstr-xml-labels))
-
-(defun hyperobject-class-value-func (obj)
-  (slot-value (class-of obj) 'value-func))
-
-(defun hyperobject-class-xmlvalue-func (obj)
-  (slot-value (class-of obj) 'xmlvalue-func))
-
 (defun hyperobject-class-user-name (obj)
   (awhen (slot-value (class-of obj) 'user-name)
 	 (if (consp it)
@@ -364,18 +346,3 @@
 (defun hyperobject-class-fields (obj)
   (class-slots (class-of obj)))
 
-(defun hyperobject-class-print-slots (obj)
-  (slot-value (class-of obj) 'print-slots))
-
-(defun hyperobject-class-fmtstr-html-ref (obj)
-  (slot-value (class-of obj) 'fmtstr-html-ref))
-
-(defun hyperobject-class-fmtstr-xml-ref (obj)
-  (slot-value (class-of obj) 'fmtstr-xml-ref))
-
-(defun hyperobject-class-fmtstr-html-ref-labels (obj)
-  (slot-value (class-of obj) 'fmtstr-html-ref-labels))
-
-(defun hyperobject-class-fmtstr-xml-ref-labels (obj)
-  (slot-value (class-of obj) 'fmtstr-xml-ref-labels))
-