[Openmcl-cvs-notifications] r12794 - /trunk/source/lib/misc.lisp

[rme at clozure.com]

Author: rme
Date: Tue Sep  8 20:55:52 2009
New Revision: 12794

Log:
New functions WATCH and UNWATCH.

Modified:
    trunk/source/lib/misc.lisp

Modified: trunk/source/lib/misc.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/misc.lisp (original)
+++ trunk/source/lib/misc.lisp Tue Sep  8 20:55:52 2009
@@ -1042,4 +1042,24 @@
               string
               (%svref lock target::lock.kind-cell)
               (lock-name lock)
-              (%ptr-to-int (%svref lock target::lock._value-cell)))))
+              (%ptr-to-int (%svref lock target::lock._value-cell)))))
+
+(defun watch (&optional thing)
+  (if thing
+    ;; typecheck thing?
+    (%watch thing)
+    (let (result)
+      (%map-areas #'(lambda (x) (push x result)) area-watched area-watched)
+      result)))
+
+(defun unwatch (thing)
+  (%map-areas #'(lambda (x)
+		  (when (eq x thing)
+		    ;; This is a rather questionable thing to do,
+		    ;; since we'll be unlinking an area from the area
+		    ;; list while %map-areas iterates over it, but I
+		    ;; think we'll get away with it.
+		    (%unwatch thing)
+		    (return-from unwatch)))
+	      area-watched area-watched))
+      =