From 21c4e5bd0f49bf0349ce0778fed676d05f11f78e Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Fri, 13 Dec 2002 22:26:41 +0000
Subject: [PATCH] r3625: *** empty log message ***

---
 mop.lisp | 33 ++++++++++++++++++++++++++++++---
 1 file changed, 30 insertions(+), 3 deletions(-)

diff --git a/mop.lisp b/mop.lisp
index da33f87..8496282 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.12 2002/12/13 22:00:05 kevin Exp $
+;;;; $Id: mop.lisp,v 1.13 2002/12/13 22:26:41 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -53,6 +53,8 @@
    (class-id :type integer :initform nil
 	     :accessor class-id
 	     :documentation "Unique ID for the class")
+   (default-view :initform nil :initarg :default-view :accessor default-view
+		 :documentation "The default view for a class")
 
    ;; SQL commands
    (create-table-cmd :initform nil :reader create-table-cmd)
@@ -61,8 +63,8 @@
 
    (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")
+   (rules :type list :initform nil :initarg :rules :accessor rules
+	  :documentation "List of rules")
    )
   (:documentation "Metaclass for Markup Language classes."))
 
@@ -341,6 +343,7 @@
   (finalize-views cl)
   (finalize-hyperlinks cl)
   (finalize-sql cl)
+  (finalize-rules cl)
   (finalize-documentation cl))
 
 
@@ -368,6 +371,30 @@
 
 ;;; Slot accessor and class rules
 
+(defclass rule ()
+  ((dependants :initarg dependants :initform nil :accessor dependants)
+   (volatile :initarg modifieds :initform nil :accessor modifieds)
+   (source-code :initarg source-code :initform nil :accessor source-code)
+   (function :initform nil :accessor function)))
+
+(defun compile-rule (source-code cl)
+  )
+  
+(defun finalize-rules (cl)
+  (let* ((direct-rules (direct-rules cl))
+	 (rule-vector (make-vector (length direct-rules) :fill-pointer nil
+				   :adjustable nil)))
+    (dotimes (i (length direct-rules))
+      (destructuring-bind (name (&key dependants volatile) &rest source-code)
+	  (nth i direct-rules)
+	(setf (aref rule-vector i) (make-instance 'rule
+						  :name name
+						  :dependants depedenants
+						  :volatile volatile
+						  :source-code source-code
+						  :function (compile-rule source-code cl)))))
+    (setf (rules cl) rule-vector)))
+
 (defun fire-class-rules (cl obj)
   "Fire all class rules. Called after a slot is modified."
   (dolist (rule (direct-rules cl))
-- 
2.34.1