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))))) ,@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)