projects
/
hyperobject.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r3630: *** empty log message ***
[hyperobject.git]
/
mop.lisp
diff --git
a/mop.lisp
b/mop.lisp
index 46d45141a8147edae11581d77de185c16063bf68..496bc56c3ae7977205f3a3d34e24051b9701f2f7 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.
;;;;
;;;; in Text, HTML, and XML formats. This includes hyperlinking
;;;; capability and sub-objects.
;;;;
-;;;; $Id: mop.lisp,v 1.1
5 2002/12/14 18:51:56
kevin Exp $
+;;;; $Id: mop.lisp,v 1.1
6 2002/12/14 21:52:48
kevin Exp $
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
;;;;
;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
;;;;
@@
-385,14
+385,13
@@
(defun compile-rule (source-code dependants volatile cl)
(let ((access (appendnew dependants volatile)))
(defun compile-rule (source-code dependants volatile cl)
(let ((access (appendnew dependants volatile)))
-
;;
(compile nil
+ (compile nil
(eval
`(lambda (obj)
(when (every #'(lambda (x) (slot-boundp obj x))
(quote ,dependants))
(with-slots ,access obj
(eval
`(lambda (obj)
(when (every #'(lambda (x) (slot-boundp obj x))
(quote ,dependants))
(with-slots ,access obj
- ,@source-code))))))
-;;)
+ ,@source-code)))))))
(defun finalize-rules (cl)
(let* ((direct-rules (direct-rules cl))
(defun finalize-rules (cl)
(let* ((direct-rules (direct-rules cl))
@@
-417,9
+416,16
@@
(let ((name (slot-definition-name slot)))
(dolist (rule (rules cl))
(when (find name (dependants rule))
(let ((name (slot-definition-name slot)))
(dolist (rule (rules cl))
(when (find name (dependants rule))
- (cmsg
"firing rule: ~a" rule
)
+ (cmsg
-c :debug "firing rule: ~W" (source-code rule)
)
(funcall (func rule) obj)))))
(funcall (func rule) obj)))))
+
+#+ignore
+(defmethod (setf slot-value-using-class)
+ :around (new-value (cl hyperobject-class) obj
+ (slot standard-effective-slot-definition))
+ (call-next-method))
+
(defmethod (setf slot-value-using-class)
:around (new-value (cl hyperobject-class) obj
(slot standard-effective-slot-definition))
(defmethod (setf slot-value-using-class)
:around (new-value (cl hyperobject-class) obj
(slot standard-effective-slot-definition))