[cells-cvs] CVS cells

[ktilton]

Update of /project/cells/cvsroot/cells
In directory clnet:/tmp/cvs-serv6247

Modified Files:
	cell-types.lisp cells.lisp cells.lpr md-slot-value.lisp 
Log Message:


--- /project/cells/cvsroot/cells/cell-types.lisp	2006/07/24 05:03:07	1.16
+++ /project/cells/cvsroot/cells/cell-types.lisp	2006/07/25 10:51:48	1.17
@@ -45,9 +45,10 @@
 (defun caller-drop (used caller)
   (fifo-delete (c-caller-store used) caller))
 
-;;;(defmethod trcp ((c cell))
-;;;  (and ;; (typep (c-model c) 'index)
-;;;   (find (c-slot-name c) '(celtk::state mathx::problem))))
+(defmethod trcp ((c cell))
+  #+not (and ;; (typep (c-model c) 'index)
+   (find (c-slot-name c) '(celtk::state mathx::problem))))
+
 
 ; --- ephemerality --------------------------------------------------
 ; 
@@ -131,7 +132,7 @@
 ;_____________________ print __________________________________
 
 (defmethod print-object :before ((c cell) stream)
-  (unless *print-readably*
+  (unless (or *stop* *print-readably*)
     (format stream "[~a~a:" (if (c-inputp c) "i" "?")
       (cond
        ((null (c-model c)) #\0)
@@ -139,8 +140,9 @@
        ((not (c-currentp c)) #\#)
        (t #\space)))))
 
+
 (defmethod print-object ((c cell) stream)
-  (if *print-readably*
+  (if (or *stop* *print-readably*)
       (call-next-method)
     (progn
       (c-print-value c stream)
@@ -149,6 +151,7 @@
         (symbol-name (or (c-slot-name c) :anoncell))
         (or (c-model c) :anonmd)))))
 
+
 ;__________________
 
 (defmethod c-print-value ((c c-ruled) stream)
--- /project/cells/cvsroot/cells/cells.lisp	2006/06/25 21:30:34	1.14
+++ /project/cells/cvsroot/cells/cells.lisp	2006/07/25 10:51:48	1.15
@@ -45,8 +45,8 @@
   (trc nil "------ cell reset ----------------------------"))
 
 (defun c-stop (&optional why)
-  (format t "~&C-STOP> stopping because ~a" why)
-  (setf *stop* t))
+  (setf *stop* t)
+  (format t "~&C-STOP> stopping because ~a" why)  )
 
 (define-symbol-macro .stop
     (c-stop :user))
@@ -132,9 +132,12 @@
 
 (defun c-break (&rest args)
   (unless *stop*
-    (c-stop args)
-    (format t "c-break > stopping > ~a" args)
-    (apply 'break args)))
+    (LET ((*print-level* 3)
+          (*print-circle* t)
+          )
+      (c-stop args)
+      (format t "c-break > stopping > ~a" args)
+      (apply 'break args))))
 
 
 
--- /project/cells/cvsroot/cells/cells.lpr	2006/07/24 05:03:08	1.18
+++ /project/cells/cvsroot/cells/cells.lpr	2006/07/25 10:51:48	1.19
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.0 [Windows] (Jul 19, 2006 19:38)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.0 [Windows] (Jul 24, 2006 15:27)"; cg: "1.81"; -*-
 
 (in-package :cg-user)
 
--- /project/cells/cvsroot/cells/md-slot-value.lisp	2006/07/24 05:03:08	1.25
+++ /project/cells/cvsroot/cells/md-slot-value.lisp	2006/07/25 10:51:48	1.26
@@ -18,7 +18,7 @@
 
 (in-package :cells)
 
-(defparameter *ide-app-hard-to-kill* nil)
+(defparameter *ide-app-hard-to-kill* t)
 
 (defun md-slot-value (self slot-name &aux (c (md-slot-cell self slot-name)))
   (tagbody
@@ -83,15 +83,18 @@
              (return-from calculate-and-set))
            
            (when (find c *call-stack*) ;; circularity
-             (trc "cell appears in call stack:" c)
-             (loop with caller-reiterated
+             (trc "cell appears in call stack:" *stop*)
+             (setf *stop* t)
+             (break)
+             #+not (loop with caller-reiterated
                    for caller in *call-stack*
                    until caller-reiterated
                    do (trc "caller:" caller)
                    (pprint (cr-code c))
                    (setf caller-reiterated (eq caller c)))
              (c-break ;; break is problem when testing cells on some CLs
-              "cell ~a midst askers (see above)" c))
+              "cell ~a midst askers (see above)" c)
+             (break))
   
            (multiple-value-bind (raw-value propagation-code)
                (calculate-and-link c)