[cells-cvs] CVS update: cell-cultures/cells/cells.lisp cell-cultures/cells/propagate.lisp

Kenny Tilton ktilton at common-lisp.net
Thu Dec 9 23:01:41 UTC 2004


Update of /project/cells/cvsroot/cell-cultures/cells
In directory common-lisp.net:/tmp/cvs-serv24507/cells

Modified Files:
	cells.lisp propagate.lisp 
Log Message:
Backing out possibly good change to c-output-slot mechanism intended to improve programmability under Corman and CLisp, which do not handle progn method combination normally used by c-output-slot-name, just to get Vasilis's original Clisp cells-gtk working. This fix can go back in if cells-gtk gets properly ported to UFFI.
Date: Fri Dec 10 00:01:30 2004
Author: ktilton

Index: cell-cultures/cells/cells.lisp
diff -u cell-cultures/cells/cells.lisp:1.5 cell-cultures/cells/cells.lisp:1.6
--- cell-cultures/cells/cells.lisp:1.5	Thu Oct 28 02:09:13 2004
+++ cell-cultures/cells/cells.lisp	Fri Dec 10 00:01:23 2004
@@ -94,18 +94,12 @@
 
 (define-condition unbound-cell (unbound-slot) ())
 
-#-(or cormanlisp clisp)
 (defgeneric c-output-slot-name (slotname self new old old-boundp)
+  #-(or cormanlisp clisp)
   (:method-combination progn))
 
-#+(and (not cells-testing) (or cormanlisp clisp))
-(defmethod c-output-slot-name (slot-name self new old old-boundp)
-  (declare (ignorable slot-name self new old old-boundp)))
-
 #-cells-testing
-(defmethod c-output-slot-name
-    #-(or cormanlisp clisp) progn
-  #+(or cormanlisp clisp) :before
+(defmethod c-output-slot-name #-(or cormanlisp clisp) progn
   (slot-name self new old old-boundp)
   (declare (ignorable slot-name self new old old-boundp)))
 


Index: cell-cultures/cells/propagate.lisp
diff -u cell-cultures/cells/propagate.lisp:1.5 cell-cultures/cells/propagate.lisp:1.6
--- cell-cultures/cells/propagate.lisp:1.5	Sun Dec  5 05:50:32 2004
+++ cell-cultures/cells/propagate.lisp	Fri Dec 10 00:01:23 2004
@@ -161,7 +161,7 @@
                    (format t "~&output ~d (~a ~a) old: ~a" ,temp1 ',slotname ,loc-self ,oldvarg))
                  (format t "~&output ~d (~a ~a) new: ~a" ,temp1 ',slotname ,loc-self ,new-varg))))
         `(defmethod c-output-slot-name
-             #-(or clisp cormanlisp) progn #+(or clisp cormanlisp) :around
+             #-(or clisp cormanlisp) progn ;;broke cells-gtk #+(or clisp cormanlisp) :around
            ((slotname (eql ',slotname)) ,self-arg ,new-varg ,oldvarg ,oldvargboundp)
            (declare (ignorable
                      ,@(flet ((arg-name (arg-spec)
@@ -171,7 +171,8 @@
                          (list (arg-name self-arg)(arg-name new-varg)
                            (arg-name oldvarg)(arg-name oldvargboundp)))))
            , at output-body
-           #+(or clisp cormanlisp) (call-next-method)))))
+           ;;broke cells-gtk #+(or clisp cormanlisp) (call-next-method)
+           ))))
 
 (defmacro bump-output-count (slotname) ;; pure test func
   `(if (get ',slotname :outputs)




More information about the Cells-cvs mailing list