r3625: *** empty log message ***

diff --git a/mop.lisp b/mop.lisp
index da33f873fed27787e0eb017efbff65dd0db798d0..84962823c874719170d5b8ba5ece212d0753c3f4 100644 (file)
--- 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))