April 2008 - cells-cvs@common-lisp.net - mailman3.common-lisp.net

[cells-cvs] CVS cells-gtk3/test-images
by phildebrandt 13 Apr '08

13 Apr '08

Update of /project/cells/cvsroot/cells-gtk3/test-images In directory clnet:/tmp/cvs-serv4765/test-images Log Message: Directory /project/cells/cvsroot/cells-gtk3/test-images added to the repository

1 0

[cells-cvs] CVS cells
by phildebrandt 13 Apr '08

13 Apr '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv30090 Modified Files: md-slot-value.lisp Log Message: Fixed ensure-value-is-current, now works with my code. --- /project/cells/cvsroot/cells/md-slot-value.lisp 2008/04/12 22:53:26 1.42 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2008/04/13 10:22:03 1.43 @@ -79,7 +79,7 @@ ;; (trc c "ensure-value-is-current > entry" c (c-state c) :now-pulse *data-pulse-id* debug-id ensurer) (when *not-to-be* - (return-from ensure-value-is-current t)) + (return-from ensure-value-is-current (c-value c))) (when (and (not (symbolp (c-model c)))(eq :eternal-rest (md-state (c-model c)))) (break "model ~a of cell ~a is dead" (c-model c) c))

1 0

[cells-cvs] Research has revealed!
by Frieda 13 Apr '08

13 Apr '08

Recent discoveries in herbal science have shed new light on the subject of penis enlargement. Research has revealed that your penis has the ability to grow beyond its current size when fully erect. Like all the other muscles in your body, your penis is actually designed to grow! http://www.qunebtoh.com/

1 0

[cells-cvs] CVS cells/cells-test
by ktilton 12 Apr '08

12 Apr '08

Update of /project/cells/cvsroot/cells/cells-test In directory clnet:/tmp/cvs-serv19981/cells-test Modified Files: test-kid-slotting.lisp Log Message: Allow access to dead instances during *not-to-be* processing. --- /project/cells/cvsroot/cells/cells-test/test-kid-slotting.lisp 2006/06/20 14:16:45 1.3 +++ /project/cells/cvsroot/cells/cells-test/test-kid-slotting.lisp 2008/04/12 22:53:26 1.4 @@ -26,8 +26,8 @@ (defmd image (family) left top width height) -(defun right (x) (+ (left x) (width x))) -(defun bottom (x) (+ (top x) (height x))) +(defun i-right (x) (+ (left x) (width x))) +(defun i-bottom (x) (+ (top x) (height x))) (defmd stack (image) justify @@ -42,7 +42,7 @@ (:right (- (width .parent) (^width))))))) (mk-kid-slot (top) (c? (bif (psib (psib)) - (bottom psib) + (i-bottom psib) (top .parent)))))) :accessor kid-slots :initarg :kid-slots)) @@ -53,7 +53,7 @@ ;; because they will be endowed with rules as necessary to achieve that end by the parent stack. ;; ;; note the ifmissing option, which defaults to nil. the stack's goal is mainly to manage the -;; top attribute of each kid to match any predecessor's bottom attribute. the stack will as a +;; top attribute of each kid to match any predecessor's i-bottom attribute. the stack will as a ;; a convenience arrange for horizontal justification, but if some kid chose to define its ;; left attribute that would be honored. ;; @@ -74,11 +74,11 @@ (every (lambda (k) (eql 10 (left k))) (kids stack)))) (ct-assert (every (lambda (k) - (eql (top k) (bottom (fm-prior-sib k)))) + (eql (top k) (i-bottom (fm-prior-sib k)))) (cdr (kids stack)))) (setf (justify stack) :right) - (ct-assert (and (eql 510 (right stack)) - (every (lambda (k) (eql 510 (right k))) + (ct-assert (and (eql 510 (i-right stack)) + (every (lambda (k) (eql 510 (i-right k))) (kids stack)))) ))

1 0

[cells-cvs] CVS cells
by ktilton 12 Apr '08

12 Apr '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv19981 Modified Files: cells.lisp md-slot-value.lisp md-utilities.lisp Log Message: Allow access to dead instances during *not-to-be* processing. --- /project/cells/cvsroot/cells/cells.lisp 2008/04/11 09:19:29 1.26 +++ /project/cells/cvsroot/cells/cells.lisp 2008/04/12 22:53:26 1.27 @@ -47,6 +47,7 @@ (defparameter *within-integrity* nil) (defparameter *client-queue-handler* nil) (defparameter *unfinished-business* nil) +(defparameter *not-to-be* nil) #+test (cells-reset) --- /project/cells/cvsroot/cells/md-slot-value.lisp 2008/04/11 09:19:32 1.41 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2008/04/12 22:53:26 1.42 @@ -21,8 +21,9 @@ (defparameter *ide-app-hard-to-kill* t) (defun md-slot-value (self slot-name &aux (c (md-slot-cell self slot-name))) - (when (mdead self) - (trc "md-slot-value passed dead self, returning NIL" self) + (when (and (not *not-to-be*) + (mdead self)) + (trc "md-slot-value passed dead self, returning NIL" self slot-name c) (inspect self) (break "see inspector for dead ~a" self) (return-from md-slot-value nil)) @@ -57,7 +58,7 @@ (record-caller c)))) (defun chk (s &optional (key 'anon)) - (when (eq :eternal-rest (md-state s)) + (when (mdead s) (break "model ~a is dead at ~a" s key))) ;;;(defmethod trcp ((c cell)) @@ -77,6 +78,9 @@ (count-it :ensure-value-is-current) ;; (trc c "ensure-value-is-current > entry" c (c-state c) :now-pulse *data-pulse-id* debug-id ensurer) + (when *not-to-be* + (return-from ensure-value-is-current t)) + (when (and (not (symbolp (c-model c)))(eq :eternal-rest (md-state (c-model c)))) (break "model ~a of cell ~a is dead" (c-model c) c)) --- /project/cells/cvsroot/cells/md-utilities.lisp 2008/01/29 04:29:52 1.14 +++ /project/cells/cvsroot/cells/md-utilities.lisp 2008/04/12 22:53:26 1.15 @@ -31,9 +31,9 @@ ;___________________ birth / death__________________________________ (defgeneric mdead (self) - (:method ((self model-object)) - (eq :eternal-rest (md-state self))) + (unless *not-to-be* + (eq :eternal-rest (md-state self)))) (:method (self) (declare (ignore self)) @@ -45,20 +45,20 @@ (:method :around ((self model-object)) (declare (ignorable self)) - (trc nil #+not (typep self '(or mathx::problem mathx::prb-solvers mathx::prb-solver)) - "not.to-be nailing" self) - ;;showpanic (c-assert (not (eq (md-state self) :eternal-rest))) - (unless (eq (md-state self) :eternal-rest) - (call-next-method) - - (setf (fm-parent self) nil - (md-state self) :eternal-rest) - - (md-map-cells self nil - (lambda (c) - (c-assert (eq :quiesced (c-state c))))) ;; fails if user obstructs not.to-be with primary method (use :before etc) + (let ((*not-to-be* t)) + (trc nil #+not (typep self '(or mathx::problem mathx::prb-solvers mathx::prb-solver)) + "not.to-be nailing" self) + (unless (eq (md-state self) :eternal-rest) + (call-next-method) + + (setf (fm-parent self) nil + (md-state self) :eternal-rest) + + (md-map-cells self nil + (lambda (c) + (c-assert (eq :quiesced (c-state c))))) ;; fails if user obstructs not.to-be with primary method (use :before etc) - (trc nil "not.to-be cleared 2 fm-parent, eternal-rest" self)))) + (trc nil "not.to-be cleared 2 fm-parent, eternal-rest" self))))) (defun md-quiesce (self) (trc nil "md-quiesce nailing cells" self (type-of self))

1 0

[cells-cvs] CVS cells-gtk
by phildebrandt 11 Apr '08

11 Apr '08

Update of /project/cells/cvsroot/cells-gtk In directory clnet:/tmp/cvs-serv8725 Modified Files: INSTALL.TXT Log Message: test --- /project/cells/cvsroot/cells-gtk/INSTALL.TXT 2008/01/28 23:59:22 1.1 +++ /project/cells/cvsroot/cells-gtk/INSTALL.TXT 2008/04/11 14:38:42 1.2 @@ -1,3 +1,4 @@ +#check To compile and run:

1 0

[cells-cvs] CVS cells
by phildebrandt 11 Apr '08

11 Apr '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv29303 Modified Files: family.lisp Log Message: family changed back. --- /project/cells/cvsroot/cells/family.lisp 2008/04/11 13:58:47 1.25 +++ /project/cells/cvsroot/cells/family.lisp 2008/04/11 14:00:14 1.26 @@ -14,8 +14,6 @@ See the Lisp Lesser GNU Public License for more details. -## useless edit by PH - |# (in-package :cells)

1 0

[cells-cvs] CVS cells
by phildebrandt 11 Apr '08

11 Apr '08

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv28945 Modified Files: family.lisp Log Message: family check. --- /project/cells/cvsroot/cells/family.lisp 2008/04/11 09:19:30 1.24 +++ /project/cells/cvsroot/cells/family.lisp 2008/04/11 13:58:47 1.25 @@ -14,6 +14,8 @@ See the Lisp Lesser GNU Public License for more details. +## useless edit by PH + |# (in-package :cells)

1 0

[cells-cvs] CVS triple-cells
by ktilton 11 Apr '08

11 Apr '08

Update of /project/cells/cvsroot/triple-cells In directory clnet:/tmp/cvs-serv8262 Modified Files: defpackage.lisp observer.lisp triple-cells.lpr Log Message: --- /project/cells/cvsroot/triple-cells/defpackage.lisp 2008/02/23 01:22:11 1.2 +++ /project/cells/cvsroot/triple-cells/defpackage.lisp 2008/04/11 09:24:42 1.3 @@ -31,3 +31,6 @@ (:nicknames :3c) (:use #:common-lisp #:utils-kt #:db.agraph #:cells)) ;; cells just for TRC (so far) +(in-package :triple-cells) + +(defvar *3c-observers*) \ No newline at end of file --- /project/cells/cvsroot/triple-cells/observer.lisp 2008/02/23 01:22:11 1.2 +++ /project/cells/cvsroot/triple-cells/observer.lisp 2008/04/11 09:24:42 1.3 @@ -57,7 +57,7 @@ ;;; ---------------------------------------------------- -(defvar *3c-observers*) + (defun (setf 3c-observer) (function c-node) (assert (functionp function) () "3c-observer setf not rule: ~a ~a" (type-of function) function) --- /project/cells/cvsroot/triple-cells/triple-cells.lpr 2008/02/23 01:22:11 1.4 +++ /project/cells/cvsroot/triple-cells/triple-cells.lpr 2008/04/11 09:24:42 1.5 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.1 [Windows] (Feb 1, 2008 18:35)"; cg: "1.103.2.10"; -*- +;; -*- lisp-version: "8.1 [Windows] (Apr 3, 2008 23:47)"; cg: "1.103.2.10"; -*- (in-package :cg-user) @@ -7,13 +7,13 @@ (define-project :name :triple-cells :modules (list (make-instance 'module :name "defpackage.lisp") (make-instance 'module :name "ag-utilities.lisp") + (make-instance 'module :name "3c-integrity.lisp") (make-instance 'module :name "core.lisp") (make-instance 'module :name "api.lisp") (make-instance 'module :name "dataflow.lisp") (make-instance 'module :name "observer.lisp") (make-instance 'module :name "hello-world.lisp") - (make-instance 'module :name "read-me.lisp") - (make-instance 'module :name "3c-integrity.lisp")) + (make-instance 'module :name "read-me.lisp")) :projects (list (make-instance 'project-module :name "..\\Cells\\cells")) :libraries nil

1 0

[cells-cvs] CVS Celtk
by ktilton 11 Apr '08

11 Apr '08

Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv7901 Modified Files: composites.lisp run.lisp tk-interp.lisp Log Message: --- /project/cells/cvsroot/Celtk/composites.lisp 2008/03/23 23:47:42 1.27 +++ /project/cells/cvsroot/Celtk/composites.lisp 2008/04/11 09:23:51 1.28 @@ -123,12 +123,16 @@ (loop for task in *app-idle-tasks* do (funcall task self task))) -(defmd window (toplevel composite-widget decoration-mixin) +(export! resources ^resources) + +(defmd window (toplevel composite-widget) (title$ (c? (string-capitalize (class-name (class-of self))))) (dictionary (make-hash-table :test 'equalp)) (tkwins (make-hash-table)) (xwins (make-hash-table)) (cursor :arrow :cell nil) + (resources (c-in nil) + :documentation "A-list of anything useful to be used consistently, such as ((paper . \"paper038edgeless\")(metal . \"metal033\"))") (keyboard-modifiers (c-in nil)) (callbacks (make-hash-table :test #'eq)) (edit-style (c-in nil)) @@ -144,6 +148,7 @@ Actually holds last event code, :focusin or :focusout") on-key-down on-key-up + (show-tool-tips? (c-in t)) :width (c?n 800) :height (c?n 600)) @@ -155,7 +160,7 @@ (trc nil "configure cursor" self new-value) (tk-format-now ". configure -cursor ~a" (string-downcase (symbol-name new-value))))) -(export! .control-key-p .alt-key-p .shift-key-p focus-state ^focus-state) +(export! .control-key-p .alt-key-p .shift-key-p focus-state ^focus-state show-tool-tips? ^show-tool-tips?) (define-symbol-macro .control-key-p (find :control (keyboard-modifiers .tkw))) (define-symbol-macro .alt-key-p (find :alt (keyboard-modifiers .tkw))) (define-symbol-macro .shift-key-p (find :shift (keyboard-modifiers .tkw))) --- /project/cells/cvsroot/Celtk/run.lisp 2008/03/23 23:47:42 1.28 +++ /project/cells/cvsroot/Celtk/run.lisp 2008/04/11 09:23:51 1.29 @@ -18,6 +18,7 @@ (in-package :Celtk) + ;;; --- running a Celtk (window class, actually) -------------------------------------- (eval-now! --- /project/cells/cvsroot/Celtk/tk-interp.lisp 2008/01/03 20:23:30 1.20 +++ /project/cells/cvsroot/Celtk/tk-interp.lisp 2008/04/11 09:23:51 1.21 @@ -214,6 +214,12 @@ (tcl-find-executable (argv0)) (set-initialized))) +#+test +(load-foreign-library 'Togl) + +#+test +(load "togl17.dll" :verbose t) + ;; Send a script to a given Tcl/Tk interpreter (defun eval-script (interp script)

1 0