May 2006 - cells-cvs@common-lisp.net - mailman3.common-lisp.net

[cells-cvs] CVS cells/utils-kt
by ktilton 20 May '06

20 May '06

Update of /project/cells/cvsroot/cells/utils-kt In directory clnet:/tmp/cvs-serv6697/utils-kt Modified Files: datetime.lisp debug.lisp defpackage.lisp detritus.lisp flow-control.lisp strings.lisp utils-kt.lpr Log Message: A slow tedious transition to LLGPL --- /project/cells/cvsroot/cells/utils-kt/datetime.lisp 2006/03/22 20:36:38 1.1 +++ /project/cells/cvsroot/cells/utils-kt/datetime.lisp 2006/05/20 06:32:20 1.2 @@ -1,25 +1,21 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*- -;;; -;;; -;;; Copyright © 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Utils-kt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# + (in-package :utils-kt) --- /project/cells/cvsroot/cells/utils-kt/debug.lisp 2006/05/01 20:23:14 1.7 +++ /project/cells/cvsroot/cells/utils-kt/debug.lisp 2006/05/20 06:32:20 1.8 @@ -1,24 +1,22 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: utils-kt; -*- ;;; -;;; Copyright (c) 1995,2004 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Utils-kt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# + (in-package :utils-kt) --- /project/cells/cvsroot/cells/utils-kt/defpackage.lisp 2006/04/01 21:47:00 1.3 +++ /project/cells/cvsroot/cells/utils-kt/defpackage.lisp 2006/05/20 06:32:20 1.4 @@ -1,24 +1,19 @@ -;; -*- mode: Lisp; Syntax: Common-Lisp; Package: utils-kt; -*- -;;; -;;; Copyright (c) 1995,2004 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Utils-kt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cl-user) --- /project/cells/cvsroot/cells/utils-kt/detritus.lisp 2006/05/03 08:22:16 1.5 +++ /project/cells/cvsroot/cells/utils-kt/detritus.lisp 2006/05/20 06:32:20 1.6 @@ -1,24 +1,21 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: utils-kt; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Utils-kt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# + (in-package :utils-kt) --- /project/cells/cvsroot/cells/utils-kt/flow-control.lisp 2005/05/18 21:47:32 1.2 +++ /project/cells/cvsroot/cells/utils-kt/flow-control.lisp 2006/05/20 06:32:20 1.3 @@ -1,25 +1,21 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: utils-kt; -*- -;;; -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Utils-kt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# + (in-package :utils-kt) --- /project/cells/cvsroot/cells/utils-kt/strings.lisp 2006/03/16 05:26:47 1.3 +++ /project/cells/cvsroot/cells/utils-kt/strings.lisp 2006/05/20 06:32:20 1.4 @@ -1,24 +1,21 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: utils-kt; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Utils-kt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# + (in-package :utils-kt) --- /project/cells/cvsroot/cells/utils-kt/utils-kt.lpr 2006/05/12 08:27:40 1.9 +++ /project/cells/cvsroot/cells/utils-kt/utils-kt.lpr 2006/05/20 06:32:20 1.10 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (May 5, 2006 15:39)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (May 11, 2006 6:29)"; cg: "1.81"; -*- (in-package :cg-user)

1 0

[cells-cvs] CVS cells
by ktilton 20 May '06

20 May '06

Update of /project/cells/cvsroot/cells In directory clnet:/tmp/cvs-serv6697 Modified Files: README.txt cell-types.lisp cells.lisp cells.lpr constructors.lisp defmodel.lisp family-values.lisp family.lisp fm-utilities.lisp initialize.lisp integrity.lisp link.lisp load.lisp md-slot-value.lisp md-utilities.lisp model-object.lisp optimization.lisp propagate.lisp slot-utilities.lisp synapse-types.lisp synapse.lisp Log Message: A slow tedious transition to LLGPL --- /project/cells/cvsroot/cells/README.txt 2006/03/22 04:08:34 1.2 +++ /project/cells/cvsroot/cells/README.txt 2006/05/20 06:32:19 1.3 @@ -25,7 +25,7 @@ Now in .\doc is cells-overview.pdf. That is pretty rough and obsolete in re the code, but some of it might be enlightening. -Cells is written in almost-portable ANSI Common Lisp. It makes very +Cells is written in portable ANSI Common Lisp. It makes very light use of the introspective portions of the MOP, and contains a few workarounds for shortcomings in common implementations. @@ -44,7 +44,7 @@ * MCL One of the Cells tests fails with CMUCL. This appears to be caused by -a bug in its CLOS implementation, but has not been investigated in +a bug in CMUCL's CLOS implementation, but has not been investigated in great depth. Cells is believed to work with Corman CL, but has not been recently @@ -57,8 +57,6 @@ package where the MOP lives. In reality, however, you might have to find workarounds for bugs in ANSI compliance. - - ***** Installation ***** [ Cells follows the usual convention for asdf and asdf-installable --- /project/cells/cvsroot/cells/cell-types.lisp 2006/03/16 05:28:27 1.8 +++ /project/cells/cvsroot/cells/cell-types.lisp 2006/05/20 06:32:19 1.9 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/cells.lisp 2006/05/01 20:23:14 1.8 +++ /project/cells/cvsroot/cells/cells.lisp 2006/05/20 06:32:19 1.9 @@ -1,27 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| -;;;(eval-when (compile load) -;;; (proclaim '(optimize (speed 1) (safety 1) (space 1) (debug 2)))) + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (eval-when (compile load) (proclaim '(optimize (speed 2) (safety 3) (space 1) (debug 3)))) --- /project/cells/cvsroot/cells/cells.lpr 2006/05/12 08:27:39 1.11 +++ /project/cells/cvsroot/cells/cells.lpr 2006/05/20 06:32:19 1.12 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (May 5, 2006 15:39)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (May 11, 2006 6:29)"; cg: "1.81"; -*- (in-package :cg-user) --- /project/cells/cvsroot/cells/constructors.lisp 2006/05/01 20:23:14 1.5 +++ /project/cells/cvsroot/cells/constructors.lisp 2006/05/20 06:32:19 1.6 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/defmodel.lisp 2006/03/16 05:28:28 1.3 +++ /project/cells/cvsroot/cells/defmodel.lisp 2006/05/20 06:32:19 1.4 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/family-values.lisp 2006/05/12 08:27:39 1.3 +++ /project/cells/cvsroot/cells/family-values.lisp 2006/05/20 06:32:19 1.4 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/family.lisp 2006/05/01 20:23:14 1.6 +++ /project/cells/cvsroot/cells/family.lisp 2006/05/20 06:32:19 1.7 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/fm-utilities.lisp 2006/05/01 20:23:14 1.6 +++ /project/cells/cvsroot/cells/fm-utilities.lisp 2006/05/20 06:32:19 1.7 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/initialize.lisp 2006/05/01 20:23:14 1.4 +++ /project/cells/cvsroot/cells/initialize.lisp 2006/05/20 06:32:19 1.5 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/integrity.lisp 2006/05/03 08:22:15 1.8 +++ /project/cells/cvsroot/cells/integrity.lisp 2006/05/20 06:32:19 1.9 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/link.lisp 2006/03/16 05:28:28 1.8 +++ /project/cells/cvsroot/cells/link.lisp 2006/05/20 06:32:19 1.9 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/load.lisp 2006/03/22 05:26:53 1.4 +++ /project/cells/cvsroot/cells/load.lisp 2006/05/20 06:32:19 1.5 @@ -11,10 +11,10 @@ asdf:*central-registry*) #-runtestsuite -(ASDF:OOS 'ASDF:LOAD-OP :CELLS) +(asdf:oos 'asdf:load-op :cells) #+runtestsuite -(ASDF:OOS 'ASDF:LOAD-OP :CELLS-TEST) +(asdf:oos 'asdf:load-op :cells-test) #+checkoutceltk (ASDF:OOS 'ASDF:LOAD-OP :CELTK) --- /project/cells/cvsroot/cells/md-slot-value.lisp 2006/05/04 21:25:12 1.13 +++ /project/cells/cvsroot/cells/md-slot-value.lisp 2006/05/20 06:32:19 1.14 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/md-utilities.lisp 2006/03/16 05:28:28 1.3 +++ /project/cells/cvsroot/cells/md-utilities.lisp 2006/05/20 06:32:19 1.4 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/model-object.lisp 2006/03/18 00:15:40 1.4 +++ /project/cells/cvsroot/cells/model-object.lisp 2006/05/20 06:32:19 1.5 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/optimization.lisp 2006/03/16 05:28:28 1.5 +++ /project/cells/cvsroot/cells/optimization.lisp 2006/05/20 06:32:19 1.6 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/propagate.lisp 2006/03/22 18:48:13 1.11 +++ /project/cells/cvsroot/cells/propagate.lisp 2006/05/20 06:32:19 1.12 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/slot-utilities.lisp 2006/03/16 05:28:28 1.2 +++ /project/cells/cvsroot/cells/slot-utilities.lisp 2006/05/20 06:32:19 1.3 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/synapse-types.lisp 2006/03/16 05:28:28 1.4 +++ /project/cells/cvsroot/cells/synapse-types.lisp 2006/05/20 06:32:19 1.5 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells) --- /project/cells/cvsroot/cells/synapse.lisp 2006/03/16 05:28:28 1.9 +++ /project/cells/cvsroot/cells/synapse.lisp 2006/05/20 06:32:19 1.10 @@ -1,24 +1,20 @@ ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cells; -*- -;;; -;;; Copyright (c) 1995,2003 by Kenneth William Tilton. -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining a copy -;;; of this software and associated documentation files (the "Software"), to deal -;;; in the Software without restriction, including without limitation the rights -;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -;;; copies of the Software, and to permit persons to whom the Software is furnished -;;; to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included in -;;; all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING -;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS -;;; IN THE SOFTWARE. +#| + + Cells -- Automatic Dataflow Managememnt + +Copyright (C) 1995, 2006 by Kenneth Tilton + +This library is free software; you can redistribute it and/or +modify it under the terms of the Lisp Lesser GNU Public License + (http://opensource.franz.com/preamble.html) known as the LLGPL. + +This library is distributed WITHOUT ANY WARRANTY; without even +the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +See the Lisp Lesser GNU Public License for more details. + +|# (in-package :cells)

1 0

[cells-cvs] CVS Celtk
by ktilton 17 May '06

17 May '06

Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv17320 Modified Files: demos.lisp entry.lisp menu.lisp multichoice.lisp run.lisp timer.lisp tk-events.lisp widget.lisp Log Message: create command replacing event generate --- /project/cells/cvsroot/Celtk/demos.lisp 2006/05/16 21:17:15 1.16 +++ /project/cells/cvsroot/Celtk/demos.lisp 2006/05/17 00:40:55 1.17 @@ -25,11 +25,11 @@ (defun ctk::tk-test () ;; ACL project manager needs a zero-argument function, in project package (test-window - ;; true tester: 'one-button-window + ;;'one-button-window ;; Not so good: 'ltktest-cells-inside ;; 'menu-button-test - ;; 'spinbox-test - 'lotsa-widgets + 'spinbox-test + ;; 'lotsa-widgets ;; Now in Gears project 'gears-demo )) @@ -40,6 +40,11 @@ (mk-frame-stack :packing (c?pack-self) :kids (c? (the-kids + (mk-menubar + :kids (c? (the-kids + (mk-menu-entry-cascade-ex (:label "File") + (mk-menu-entry-command-ex () "Load" (format t "~&Load pressed")) + (mk-menu-entry-command-ex () "Save" (format t "~&Save pressed")))))) (make-instance 'entry :id :entree :fm-parent *parent* @@ -48,70 +53,19 @@ :fm-parent *parent* :text "read" :on-command (lambda (self) - (trc "entry reads" (ctk::tk-eval-var (path (fm^ :entree))))))))))))) - -#+save -(defmodel one-button-window (window) - () - (:default-initargs - :on-event (lambda (self &rest event-args) - (trc "we got events" self event-args)) - :kids (c? (the-kids - (mk-menubar - :kids (c? (the-kids - (mk-menu-entry-cascade-ex (:label "File") - (mk-menu-entry-command-ex () "Load" (format t "~&Load pressed")) - (mk-menu-entry-command-ex () "Save" (format t "~&Save pressed")))))) - (mk-frame-stack - :packing (c?pack-self) - :kids (c? (the-kids - - ;;; (mk-scrolled-list - ;;; :id :spinpkg-sym-list - ;;; :list-height 6 - ;;; :list-item-keys (c? (loop for sym being the symbols in (find-package "CELTK") - ;;; for n below 5 - ;;; counting sym into symct - ;;; collecting sym into syms - ;;; finally (trc "syms found !!!" symct) - ;;; (return syms))) - ;;; :list-item-factory (lambda (sym) - ;;; (trc "make list item" sym *parent*) - ;;; (make-instance 'listbox-item - ;;; :fm-parent *parent* - ;;; :md-value sym - ;;; :item-text (down$ (symbol-name sym))))) - (mk-text-widget - :id :my-text - :md-value (c?n "hello, world") - :height 3 - :width 25) - (make-instance 'button - :fm-parent *parent* - :text "<<kenny>>" - :on-command (lambda (self) - (trc "button pushed!!!" self))) - ;;; (make-instance 'button - ;;; :fm-parent *parent* - ;;; :text "time now?" - ;;; :on-command (c? (lambda (self) - ;;; (trc "we got callbacks" self)))) + (trc "entry reads" (ctk::tk-eval-var (path (fm^ :entree)))))) (make-instance 'scale :fm-parent *parent* :tk-label "Boots" :on-command (c? (lambda (self value) - (trc "we got scale callbacks" self value)))) + (trc "we got scale callbacks" self (parse-integer value))))) (mk-spinbox :id :spin-pkg :md-value (c-in "cells") ;;(cells::c?n "cells") :tk-values (mapcar 'down$ (sort (mapcar 'package-name (list-all-packages)) - 'string>))) - (make-instance 'entry - :fm-parent *parent* - :md-value (c-in "Boots")) - ))))))) + 'string>)))))))))) (defmodel spinbox-test (window) () @@ -142,7 +96,8 @@ (make-instance 'listbox-item :fm-parent *parent* :md-value sym - :item-text (down$ (symbol-name sym)))))))))) + :item-text (down$ (symbol-name sym))))) + (mk-label :text (c? (selection (fm^ :spinpkg-sym-list))))))))) (defmodel menu-button-test (window) --- /project/cells/cvsroot/Celtk/entry.lisp 2006/05/16 02:52:22 1.7 +++ /project/cells/cvsroot/Celtk/entry.lisp 2006/05/17 00:40:55 1.8 @@ -65,8 +65,7 @@ (defmethod md-awaken :after ((self entry)) ;; move this to a traces slot on widget (with-integrity (:client `(:trace ,self)) - (tk-format-now "trace add variable ~a write TraceOP" (^path)) - )) + (tk-format-now "trace add variable ~a write TraceOP" (^path)))) ;;; /// this next replicates the handling of tk-mirror-variable because ;;; those leverage the COMMAND mechanism, which entry lacks --- /project/cells/cvsroot/Celtk/menu.lisp 2006/05/16 21:17:15 1.14 +++ /project/cells/cvsroot/Celtk/menu.lisp 2006/05/17 00:40:55 1.15 @@ -172,7 +172,7 @@ () (:tk-spec command -command) (:default-initargs - :command (c? (format nil "event generate . <<do-menu-command>> -data ~a" (path-idx self))))) + :command (c? (format nil "do-on-command ~a" (path-idx self))))) (defmacro mk-menu-entry-command-ex ((&rest menu-command-initargs) lbl callback-body) `(mk-menu-entry-command --- /project/cells/cvsroot/Celtk/multichoice.lisp 2006/05/16 21:17:15 1.7 +++ /project/cells/cvsroot/Celtk/multichoice.lisp 2006/05/17 00:40:55 1.8 @@ -44,10 +44,9 @@ :tk-variable nil ;;(c? (^path)) :xscrollcommand (c-in nil) :yscrollcommand (c-in nil) - :command (c? (format nil "event generate ~a <<do-on-command>> -data" (^path))) :on-command (lambda (self value) ;; (trc "hi scale" self value) - (setf (^md-value) value)))) + (setf (^md-value) (parse-integer value))))) (defmethod make-tk-instance :after ((self scale)) "Still necessary?" @@ -116,7 +115,7 @@ :id (gentemp "SPN") :textVariable (c? (^path)) :xscrollcommand (c-in nil) - :command (c? (format nil "event generate ~a <<do-on-command>> -data %s" (^path))) + :command (c? (format nil "do-on-command ~a %s" (^path))) :on-command (c? (lambda (self text) (eko ("variable mirror command fired !!!!!!!" text) (setf (^md-value) text)))))) --- /project/cells/cvsroot/Celtk/run.lisp 2006/05/16 02:52:22 1.10 +++ /project/cells/cvsroot/Celtk/run.lisp 2006/05/17 00:40:55 1.11 @@ -39,12 +39,13 @@ (tk-app-init *tki*) (tk-togl-init *tki*) (tk-format-now "proc TraceOP {n1 n2 op} {event generate $n1 <<trace>> -data $op}") + (tcl-create-command *tki* "do-on-command" (get-callback 'do-on-command) 42 0) (with-integrity () (setf *tkw* (make-instance root-class)) (tk-create-event-handler-ex *tkw* 'main-window-proc :virtualEventMask)) - + (tk-format `(:fini) "wm deiconify .") (tk-format-now "bind . <Escape> {destroy .}") @@ -55,9 +56,6 @@ (when (eq (xevent-type xe) :virtualevent) (bwhen (n$ (xsv name xe)) (case (read-from-string (string-upcase n$)) - (do-menu-command (let ((self (gethash (tcl-get-string (xsv user-data xe)) (dictionary *tkw*)))) - (bwhen (c (^on-command)) - (funcall c self)))) (time-is-up (let ((self (gethash (tcl-get-string (xsv user-data xe)) (dictionary *tkw*)))) (bwhen (c (^on-command)) (funcall c self)))) --- /project/cells/cvsroot/Celtk/timer.lisp 2006/05/16 02:52:22 1.5 +++ /project/cells/cvsroot/Celtk/timer.lisp 2006/05/17 00:40:55 1.6 @@ -52,7 +52,7 @@ (export '(repeat ^repeat))) (defmodel timer () - ((id :cell nil :initarg :id :accessor id :initform :anon + ((id :cell nil :initarg :id :accessor id :initform (gentemp "AFTER") :documentation "A debugging aid") (tag :cell nil :initarg :tag :accessor tag :initform :anon :documentation "A debugging aid") @@ -99,9 +99,8 @@ (setf (id self) (set-timer self (^delay))))))))))) (defun set-timer (self time) - (let ((lookup-id (gentemp "AFTER"))) - (setf (gethash lookup-id (dictionary *tkw*)) self) - (tk-eval "after ~a {event generate . <<time-is-up>> -data ~a}" time lookup-id))) + (setf (gethash (id self) (dictionary *tkw*)) self) + (tk-eval "after ~a {do-on-command ~a}" time (id self))) (defobserver timers ((self tk-object) new-value old-value) (dolist (k (set-difference old-value new-value)) --- /project/cells/cvsroot/Celtk/tk-events.lisp 2006/05/15 05:15:37 1.2 +++ /project/cells/cvsroot/Celtk/tk-events.lisp 2006/05/17 00:40:55 1.3 @@ -8,6 +8,18 @@ (tcl-idle-proc :pointer) (client-data :int)) +(defcfun ("Tcl_CreateCommand" tcl-create-command) :pointer + (interp :pointer) + (cmdName :string) + (proc :pointer) + (client-data :int) + (delete-proc :pointer)) + +(defcfun ("Tcl_SetResult" tcl-set-result) :void + (interp :pointer) + (result :string) + (free-proc :pointer)) + (defcfun ("Tcl_GetString" tcl-get-string) :string (tcl-obj :pointer)) --- /project/cells/cvsroot/Celtk/widget.lisp 2006/05/16 21:17:15 1.7 +++ /project/cells/cvsroot/Celtk/widget.lisp 2006/05/17 00:40:55 1.8 @@ -95,24 +95,21 @@ (defclass commander () () (:default-initargs - :command (c? (format nil "event generate ~a <<do-on-command>>" (^path))))) + :command (c? (format nil "do-on-command ~a" (^path))))) -(defcallback commander-event-proc :void ((client-data :int)(xe :pointer)) +(defcallback do-on-command :int ((client-data :int)(interp :pointer)(argc :int)(argv :pointer)) (declare (ignore client-data)) - (when (eq (xevent-type xe) :virtualevent) - (bwhen (n$ (xsv name xe)) - (case (read-from-string (string-upcase n$)) - (do-on-command (let ((self (xwin-widget (xsv event-window xe)))) - (bwhen (c (^on-command)) - (let ((d (xsv user-data xe))) - (if (plusp d) - (funcall c self (read-from-string (tcl-get-string d))) - (funcall c self)))))) - (otherwise (trc "commander sees unknown" n$)))))) - -(defmethod make-tk-instance :after ((self commander)) - (with-integrity (:client `(:post-make-tk ,self)) - (tk-create-event-handler-ex self 'commander-event-proc :virtualEventMask))) + (destructuring-bind (path &rest args) + (loop for argn upfrom 1 below argc + collecting (mem-aref argv :string argn)) + (bif (self (gethash path (dictionary *tkw*))) + (bIf (cmd (^on-command)) + (progn (apply cmd self args) + 0) + (progn (tcl-set-result interp (format nil "do-on-command> Target widget ~a has no on-command to run" path) 0) + 1)) + (progn (tcl-set-result interp (format nil "do-on-command> Target widget ~a does not exist" path) 0) + 1)))) (defun widget-menu (self key) (or (find key (^menus) :key 'md-name)

1 0

[cells-cvs] CVS Celtk
by ktilton 16 May '06

16 May '06

Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv26224 Modified Files: Celtk.lisp demos.lisp load.lisp lotsa-widgets.lisp menu.lisp multichoice.lisp tk-interp.lisp widget.lisp Log Message: --- /project/cells/cvsroot/Celtk/Celtk.lisp 2006/05/16 02:52:22 1.21 +++ /project/cells/cvsroot/Celtk/Celtk.lisp 2006/05/16 21:17:15 1.22 @@ -62,23 +62,22 @@ (define-symbol-macro .tkw (nearest self window)) + ; --- tk-format --- talking to wish/Tk ----------------------------------------------------- +(defconstant +tk-client-task-priority+ + '(:delete :forget :destroy + :pre-make-tk :make-tk :make-tk-menubutton :post-make-tk + :variable :bind :selection :trace :configure :grid :pack :fini)) + (defun tk-user-queue-sort (task1 task2) "Intended for use as user queue sorter, to make Tk happy by giving it stuff in the order it needs to work properly." - (let ((priority '(:delete :forget :destroy - :pre-make-tk :make-tk :make-tk-menubutton :post-make-tk - :variable :bind :selection :trace :configure :grid :pack :fini))) - (destructuring-bind (type1 self1 &rest dbg) task1 + (destructuring-bind (type1 self1 &rest dbg) task1 (declare (ignorable dbg)) - (assert type1) - (assert (find type1 priority) () "unknown task type ~a in task ~a" type1 task1) (destructuring-bind (type2 self2 &rest dbg) task2 (declare (ignorable dbg)) - (assert type2) - (assert (find type2 priority) () "unknown task type ~a in task ~a" type2 task2) - (let ((p1 (position type1 priority)) - (p2 (position type2 priority))) + (let ((p1 (position type1 +tk-client-task-priority+)) + (p2 (position type2 +tk-client-task-priority+))) (cond ((< p1 p2) t) ((< p2 p1) nil) @@ -86,12 +85,14 @@ (:make-tk (fm-ordered-p self1 self2)) (:pack - (fm-ascendant-p self2 self1)))))))))) + (fm-ascendant-p self2 self1))))))))) (defun tk-user-queue-handler (user-q) - #+shh (loop for (defer-info . nil) in (sort (copy-list (fifo-data user-q)) 'tk-user-queue-sort :key 'car) - do (trc "user-q-handler sees" defer-info)) + (loop for (defer-info . nil) in (fifo-data user-q) + unless (find (car defer-info) +tk-client-task-priority+) + do (error "unknown tk client task type ~a in task: ~a " (car defer-info) defer-info)) + (loop for (nil #+not defer-info . task) in (prog1 (sort (fifo-data user-q) 'tk-user-queue-sort :key 'car) (fifo-clear user-q)) --- /project/cells/cvsroot/Celtk/demos.lisp 2006/05/16 02:52:22 1.15 +++ /project/cells/cvsroot/Celtk/demos.lisp 2006/05/16 21:17:15 1.16 @@ -137,8 +137,7 @@ for n below 5 counting sym into symct collecting sym into syms - finally (trc "syms found !!!" symct) - (return syms))))) + finally (return syms))))) :list-item-factory (lambda (sym) (make-instance 'listbox-item :fm-parent *parent* @@ -154,7 +153,7 @@ (mk-popup-menubutton :id :font-face :initial-value (c? (second (^entry-values))) - :entry-values (c? (eko ("popup ff") (subseq (tk-eval-list "font families") 4 10)))) + :entry-values (c? (subseq (tk-eval-list "font families") 4 10))) (mk-label :text "Four score and seven years ago today, our fathers broguht forth on this continent a new nation..." :wraplength 200 :justify 'left --- /project/cells/cvsroot/Celtk/load.lisp 2006/05/12 08:30:14 1.5 +++ /project/cells/cvsroot/Celtk/load.lisp 2006/05/16 21:17:15 1.6 @@ -1,9 +1,26 @@ +;;; +;;; +;;; First, grab these: +;;; +;;; http://common-lisp.net/cgi-bin/viewcvs.cgi/cells/?root=cells +;;; Celtk: http://common-lisp.net/cgi-bin/viewcvs.cgi/Celtk/?root=cells +;;; CFFI: http://common-lisp.net/project/cffi/releases/cffi_0.9.1.tar.gz +;;; cl-opengl: http://common-lisp.net/cgi-bin/darcsweb/darcsweb.cgi?r=cl-opencl%20cl-openg… +;; +;;; At the bottom of any of those pages look for a "Download tarball" link. Except cl-opengl, those guys +;;; are not download-friendly. +;;; +;;; Next, get ASDF loaded: + #+eval-this-if-you-do-not-autoload-asdf (load (make-pathname #+lispworks :host #-lispworks :device "c" :directory '(:absolute "0dev" "cells") :name "asdf" :type "lisp")) +;;; /After/ you have manually evaluated the above form, you can tell ASDF +;;; where you put everything by adjusting these paths and evaluating: + (progn (push (make-pathname #+lispworks :host #-lispworks :device "c" :directory '(:absolute "0dev" "cells")) @@ -21,16 +38,14 @@ :directory '(:absolute "0dev" "Celtk")) asdf:*central-registry*)) -#-runtestsuite -(ASDF:OOS 'ASDF:LOAD-OP :CELLS) - -#+runtestsuite -(ASDF:OOS 'ASDF:LOAD-OP :CELLS-TEST) +;;; and now you can try building the whole mess: (ASDF:OOS 'ASDF:LOAD-OP :CELTK) -#+ortestceltk -(ctk:test-window 'celtk-user::ltktest-cells-inside) +;;; and test: + +(ctk::test-window 'celtk-user::lotsa-widgets) + +;;; When that crashes, track down all the define-foreign-library calls in the source +;;; and fix the pathnames to point to your shared libraries. -#+opengl -(celtk-user::gears) \ No newline at end of file --- /project/cells/cvsroot/Celtk/lotsa-widgets.lisp 2006/05/13 14:36:58 1.1 +++ /project/cells/cvsroot/Celtk/lotsa-widgets.lisp 2006/05/16 21:17:15 1.2 @@ -88,8 +88,7 @@ for n below 25 counting sym into symct collecting sym into syms - finally (trc "syms found !!!" symct) - (return syms))))) + finally (return syms))))) :list-item-factory (lambda (sym) (make-instance 'listbox-item :fm-parent *parent* @@ -161,7 +160,7 @@ (mk-popup-menubutton :id :font-face :initial-value (c? (second (^entry-values))) - :entry-values (c? (eko ("popup ff") (subseq (tk-eval-list "font families") 4 10)))) + :entry-values (c? (subseq (tk-eval-list "font families") 4 10))) (mk-scale :id :font-size :md-value (c-in 14) --- /project/cells/cvsroot/Celtk/menu.lisp 2006/05/15 05:15:37 1.13 +++ /project/cells/cvsroot/Celtk/menu.lisp 2006/05/16 21:17:15 1.14 @@ -63,11 +63,11 @@ `(mk-menu :kids (c? (the-kids ,@submenus)))) (defmethod make-tk-instance :after ((self menu)) - (trc "make-tk-instance > traversing menu" self) + (trc nil "make-tk-instance > traversing menu" self) (fm-menu-traverse self (lambda (entry &aux (menu self)) (assert (typep entry 'menu-entry)) - (trc "make-tk-instance visiting menu entry" (path menu) entry) + (trc nil "make-tk-instance visiting menu entry" (path menu) entry) (tk-format `(:post-make-tk ,self) "~(~a~) add ~(~a~) ~{~(~a~) ~a~^ ~}" (path menu) (tk-class entry) @@ -273,11 +273,9 @@ :kids (c? (the-kids ;; don't worry, this flattens (loop for v in (entry-values .parent) collecting - (progn - (trc "popup-menubutton entry label" v (down$ v)) - (mk-menu-entry-radiobutton + (mk-menu-entry-radiobutton :label (down$ v) - :value v)))))))))) + :value v))))))))) (defobserver initial-value ((self popup-menubutton)) (when new-value --- /project/cells/cvsroot/Celtk/multichoice.lisp 2006/05/16 02:52:22 1.6 +++ /project/cells/cvsroot/Celtk/multichoice.lisp 2006/05/16 21:17:15 1.7 @@ -46,7 +46,7 @@ :yscrollcommand (c-in nil) :command (c? (format nil "event generate ~a <<do-on-command>> -data" (^path))) :on-command (lambda (self value) - (trc "hi scale" self value) + ;; (trc "hi scale" self value) (setf (^md-value) value)))) (defmethod make-tk-instance :after ((self scale)) --- /project/cells/cvsroot/Celtk/tk-interp.lisp 2006/05/16 02:52:22 1.8 +++ /project/cells/cvsroot/Celtk/tk-interp.lisp 2006/05/16 21:17:15 1.9 @@ -100,7 +100,7 @@ (Tcl_Init interp) (Tk_Init interp) - (format t "~%*** Tk_AppInit has been called.~%") + ;;(format t "~%*** Tk_AppInit has been called.~%") ;; Return OK (foreign-enum-value 'tcl-retcode-values :tcl-ok)) --- /project/cells/cvsroot/Celtk/widget.lisp 2006/05/16 02:52:22 1.6 +++ /project/cells/cvsroot/Celtk/widget.lisp 2006/05/16 21:17:15 1.7 @@ -73,13 +73,13 @@ (defobserver event-handler () (when new-value ;; \\\ work out how to unregister any old value (with-integrity (:client `(:post-make-tk ,self)) - (trc "creating event handler for" self) + (trc nil "creating event handler for" self) (tk-create-event-handler-ex self 'widget-event-handler -1)))) ;; // make this -1 more efficient (defun tk-create-event-handler-ex (widget callback-name &rest masks) (let ((self-tkwin (widget-to-tkwin widget))) (assert (plusp self-tkwin)) - (trc "setting up widget virtual-event handler" widget :tkwin self-tkwin) + (trc nil "setting up widget virtual-event handler" widget :tkwin self-tkwin) (tk-create-event-handler self-tkwin (apply 'foreign-masks-combine 'tk-event-mask masks) (get-callback callback-name)

1 0

[cells-cvs] CVS Celtk
by ktilton 16 May '06

16 May '06

Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv17807 Removed Files: gears.lisp Log Message:

1 0

[cells-cvs] CVS Celtk/gears
by ktilton 16 May '06

16 May '06

Update of /project/cells/cvsroot/Celtk/gears In directory clnet:/tmp/cvs-serv17766/gears Log Message: Directory /project/cells/cvsroot/Celtk/gears added to the repository

1 0

[cells-cvs] CVS gears
by ktilton 16 May '06

16 May '06

Update of /project/cells/cvsroot/gears In directory clnet:/tmp/cvs-serv27612 Modified Files: gears.lisp Log Message: Celtk2 alpha release --- /project/cells/cvsroot/gears/gears.lisp 2006/05/12 08:33:46 1.1 +++ /project/cells/cvsroot/gears/gears.lisp 2006/05/16 02:53:12 1.2 @@ -47,33 +47,29 @@ :timer-interval (c? (let ((n$ (md-value (fm-other :vtime)))) (format nil "~a" (max 1 (or (parse-integer n$ :junk-allowed t) 0))))) :double 1 ;; "yes" - :bindings (c? (list - (list '(ctk::|<1>| "%X %Y") - (lambda (self event root-x root-y) - (declare (ignorable self event root-x root-y)) - (RotStart self root-x root-y) - 0)) - (list '(ctk::|<B1-Motion>| "%X %Y") - (lambda (self event root-x root-y) - (declare (ignore event)) - (RotMove self root-x root-y) - 0)))))))))) + :event-handler (c? (lambda (self xe) + (case (tk-event-type (xsv type xe)) + (:virtualevent + (trc "canvas virtual" (xsv name xe))) + (:buttonpress + (RotStart self (xsv x-root xe) (xsv y-root xe))) + (:motionnotify + (RotMove self (xsv x-root xe) (xsv y-root xe))) + (:buttonrelease + (setf *startx* nil))))))))))) (defun RotStart (self x y) - ;(trc "Rotstart!!!" self x y) (setf *startx* x) (setf *starty* y) (setf *xangle0* (rotx self)) (setf *yangle0* (roty self))) (defun RotMove (self x y) - ;(trc "RotMove!!!!" self x y) - (setf *xangle* (+ *xangle0* (- x *startx*))) - (setf *yangle* (+ *yangle0* (- y *starty*))) - (setf (rotx self) *xangle*) - (assert (eql *xangle* (rotx self))) - (setf (roty self) *yangle*) - (trc nil "RotMove x y" *xangle* *yangle*)) + (when *startx* + (setf *xangle* (+ *xangle0* (- x *startx*))) + (setf *yangle* (+ *yangle0* (- y *starty*))) + (setf (rotx self) *xangle*) + (setf (roty self) *yangle*))) (defconstant +pif+ (coerce pi 'single-float)) @@ -138,6 +134,7 @@ (gl:load-identity) (gl:translate 0 0 -30)))) + (defmethod togl-display-using-class ((self gears) &aux (scale (scale (upper self gears-demo)))) (declare (ignorable scale))

1 0

[cells-cvs] CVS Celtk
by ktilton 16 May '06

16 May '06

Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv27500 Modified Files: Celtk.asd Celtk.lisp demos.lisp entry.lisp ltktest-ci.lisp multichoice.lisp run.lisp timer.lisp tk-interp.lisp widget.lisp Log Message: Celtk2 alpha release --- /project/cells/cvsroot/Celtk/Celtk.asd 2006/05/12 08:30:13 1.6 +++ /project/cells/cvsroot/Celtk/Celtk.asd 2006/05/16 02:52:22 1.7 @@ -15,7 +15,9 @@ :depends-on (:cells :cl-opengl :cl-glu) :serial t :components ((:file "Celtk") + (:file "tk-structs") (:file "tk-interp") + (:file "tk-events") (:file "tk-object") (:file "widget") (:file "font") @@ -35,6 +37,6 @@ (:file "frame") (:file "togl") (:file "run") - (:file "demos") (:file "ltktest-ci") - (:file "gears"))) + (:file "lotsa-widgets") + (:file "demos"))) --- /project/cells/cvsroot/Celtk/Celtk.lisp 2006/05/15 05:15:37 1.20 +++ /project/cells/cvsroot/Celtk/Celtk.lisp 2006/05/16 02:52:22 1.21 @@ -24,8 +24,8 @@ (:nicknames "CTK") (:use :common-lisp :utils-kt :cells :cffi) (:export - #:<1> - #:title$ #:pop-up #:event-root-x #:event-root-y + #:<1> #:tk-event-type #:xsv #:name #:x-root #:y-root + #:title$ #:pop-up #:window #:panedwindow #:mk-row #:c?pack-self #:mk-stack #:mk-text-widget #:text-widget #:mk-panedwindow #:mk-stack #:mk-radiobutton #:mk-radiobutton-ex #:mk-radiobutton #:mk-label @@ -47,7 +47,7 @@ #:timer #:timers #:repeat #:executions #:state #:timer-reset #:make-timer-steps #:^widget-menu #:widget-menu #:tk-format-now #:coords #:^coords #:tk-translate-keysym - #:do-on-event #:*tkw*)) + #:*tkw*)) (defpackage :celtk-user (:use :common-lisp :utils-kt :cells :celtk)) --- /project/cells/cvsroot/Celtk/demos.lisp 2006/05/15 05:15:37 1.14 +++ /project/cells/cvsroot/Celtk/demos.lisp 2006/05/16 02:52:22 1.15 @@ -25,10 +25,10 @@ (defun ctk::tk-test () ;; ACL project manager needs a zero-argument function, in project package (test-window - ;; 'one-button-window - ;;'ltktest-cells-inside - ;; OK 'menu-button-test - ;; OK 'spinbox-test + ;; true tester: 'one-button-window + ;; Not so good: 'ltktest-cells-inside + ;; 'menu-button-test + ;; 'spinbox-test 'lotsa-widgets ;; Now in Gears project 'gears-demo )) --- /project/cells/cvsroot/Celtk/entry.lisp 2006/05/15 05:15:37 1.6 +++ /project/cells/cvsroot/Celtk/entry.lisp 2006/05/16 02:52:22 1.7 @@ -46,18 +46,27 @@ :id (gentemp "ENT") :xscrollcommand (c-in nil) :textvariable (c? (intern (^path))) - :virtual-event-handlers (c? (list `(tracewrite ,(lambda (self event client-data) - (declare (ignore event client-data)) - (let ((new-value (tcl-get-var *tki* (^path) - (var-flags :TCL_GLOBAL_ONLY :TCL_LEAVE_ERR_MSG)))) - (unless (string= new-value (^md-value)) - (setf (^md-value) new-value))))))) + :event-handler (lambda (self xe) + (TRC nil "widget-event-handler" self (xsv type xe) ) + (case (tk-event-type (xsv type xe)) + (:virtualevent + (trc nil "v/e" (xsv name xe)) + (case (read-from-string (string-upcase (xsv name xe))) + (trace + (TRC nil "entry e/h trace" self (when (plusp (xsv user-data xe)) + (tcl-get-string (xsv user-data xe)))) + ;; assuming write op, but data field shows that + (let ((new-value (tcl-get-var *tki* (^path) + (var-flags :TCL_NAMESPACE_ONLY)))) + (unless (string= new-value (^md-value)) + (setf (^md-value) new-value)))))))) :md-value (c-in ""))) (defmethod md-awaken :after ((self entry)) ;; move this to a traces slot on widget (with-integrity (:client `(:trace ,self)) - (tk-format-now "trace add variable ~a write TraceOP" (^path)))) + (tk-format-now "trace add variable ~a write TraceOP" (^path)) + )) ;;; /// this next replicates the handling of tk-mirror-variable because ;;; those leverage the COMMAND mechanism, which entry lacks @@ -90,9 +99,14 @@ :yscrollcommand (c-in nil) :modified (c-in nil) :borderwidth (c? (if (^modified) 8 2)) - :virtual-event-handlers (c? (list `(modified ,(lambda (self event client-data) - (eko ("<<Modified>> !!TK value for text-widget" self event client-data) - (setf (^modified) t)))))))) + :event-handler (lambda (self xe) + (case (tk-event-type (xsv type xe)) + (:virtualevent + (case (read-from-string (string-upcase (xsv name xe))) + (modified + (eko (nil "<<Modified>> !!TK value for text-widget" self) + (setf (^modified) t))))))))) + ;;;(defvar +tk-keysym-table+ ;;; (let ((ht (make-hash-table :test 'string=))) ;;; (with-open-file (ksyms "/0dev/math-paper/tk-keysym.dat" :direction :input) --- /project/cells/cvsroot/Celtk/ltktest-ci.lisp 2006/05/15 05:15:37 1.4 +++ /project/cells/cvsroot/Celtk/ltktest-ci.lisp 2006/05/16 02:52:22 1.5 @@ -327,22 +327,13 @@ ; This also simplifies Celtk since it just has to pass the Tk code along with "grid <path> " ; appended. ; - :event-handlers nil #+not (c? (list - (list '(<1> "%X %Y") - (lambda (self event root-x root-y) - (declare (ignorable event root-x root-y)) - - ; - ; Stolen from the original. It means "when the left button is - ; pressed on this widget, popup this menu where the button was pressed" - ; The only difference is that here we get to specify this along with - ; the rest of the configuration of this instance, whereas in the original - ; the enabling code was just "out there" in a long sequence of other - ; imperatives setting up this widget and that. ie, It is nice having - ; everything about X collected in one place. In case you are wondering, - ; a standard event-handler is created for any widget with handlers. - ; - (pop-up (^widget-menu :bkg-pop) root-x root-y))))) + :event-handler (c? (lambda (self xe) + (case (tk-event-type (xsv type xe)) + (:virtualevent + (trc "canvas virtual" (xsv name xe))) + (:buttonpress + (TRC "canvas buttonpress" self (xsv x-root xe)(xsv y-root xe)) + (pop-up (^widget-menu :bkg-pop) (xsv x-root xe) (xsv y-root xe)))))) :menus (c? (the-kids ; --- /project/cells/cvsroot/Celtk/multichoice.lisp 2006/05/15 05:15:37 1.5 +++ /project/cells/cvsroot/Celtk/multichoice.lisp 2006/05/16 02:52:22 1.6 @@ -69,16 +69,14 @@ :id (gentemp "LBX") :xscrollcommand (c-in nil) :yscrollcommand (c-in nil) - :virtual-event-handlers - (c? (assert (selector self)) - (when (selector self) ;; if not? Figure out how listbox tracks own selection - (list `(ListboxSelect ,(lambda (self event client-data) - (declare (ignore client-data event)) - (trc "NEW listbox callback firing" self ) - (let ((selection (parse-integer (tk-eval "~a curselection" (^path))))) - (trc "NEW listbox selection" self selection) - (setf (selection (selector self)) - (md-value (elt (^kids) selection))))))))))) + :event-handler (lambda (self xe) + (case (tk-event-type (xsv type xe)) + (:virtualevent + (case (read-from-string (string-upcase (xsv name xe))) + (ListboxSelect + (let ((selection (parse-integer (tk-eval "~a curselection" (^path))))) + (setf (selection (selector self)) + (md-value (elt (^kids) selection))))))))))) (defmodel listbox-item (tk-object) ((item-text :initarg :item-text :accessor item-text --- /project/cells/cvsroot/Celtk/run.lisp 2006/05/15 05:15:37 1.9 +++ /project/cells/cvsroot/Celtk/run.lisp 2006/05/16 02:52:22 1.10 @@ -38,7 +38,7 @@ ;; not recommended by Tcl doc (tcl-do-when-idle (get-callback 'tcl-idle-proc) 42) (tk-app-init *tki*) (tk-togl-init *tki*) - (tk-format-now "proc TraceOP {n1 n2 op} {event generate $n1 <<tracewrite>> -data {$n1 $op}}") + (tk-format-now "proc TraceOP {n1 n2 op} {event generate $n1 <<trace>> -data $op}") (with-integrity () (setf *tkw* (make-instance root-class)) @@ -48,9 +48,7 @@ (tk-format `(:fini) "wm deiconify .") (tk-format-now "bind . <Escape> {destroy .}") - ;; one or the other of... - (tcl-do-one-event-loop)#+either-or (Tk_MainLoop) - ) + (tcl-do-one-event-loop)) (defcallback main-window-proc :void ((client-data :int)(xe :pointer)) (declare (ignore client-data)) @@ -73,28 +71,11 @@ (defun tcl-do-one-event-loop () (loop while (plusp (tk-get-num-main-windows)) do (loop until (zerop (Tcl_DoOneEvent 2))) ;; 2== TCL_DONT_WAIT - (sleep *event-loop-delay*) + (sleep *event-loop-delay*) ;; give the IDE a few cycles finally ;;(tk-eval "exit") - (tcl-delete-interp *tki*) + (tcl-delete-interp *tki*) ;; probably unnecessary (setf *tki* nil))) - - -(defmethod do-on-event (self event-type$ &rest args &aux (event-type (intern event-type$ :ctk))) - (assert (symbolp event-type)) - (trc nil "on event!!!" self event-type args) - (bif (ecb (gethash event-type (event-handlers self))) - (apply ecb self event-type args) - (progn - (trc "no event handlers for" self event-type (symbol-package event-type)) - (loop for k being the hash-keys of (event-handlers self) - do (trc "known key" k (symbol-package k)))))) - -(defmethod do-on-command (self &rest args) - (bif (ocb (on-command self)) - (apply ocb self args) - (trc "weird, no on-command value" self args))) - (defun test-window (root-class) "nails existing window as a convenience in iterative development" (declare (ignorable root-class)) --- /project/cells/cvsroot/Celtk/timer.lisp 2006/05/15 05:15:37 1.4 +++ /project/cells/cvsroot/Celtk/timer.lisp 2006/05/16 02:52:22 1.5 @@ -52,7 +52,7 @@ (export '(repeat ^repeat))) (defmodel timer () - ((id :cell nil :initarg :id :accessor id :initform (gentemp "AFTER") + ((id :cell nil :initarg :id :accessor id :initform :anon :documentation "A debugging aid") (tag :cell nil :initarg :tag :accessor tag :initform :anon :documentation "A debugging aid") @@ -99,8 +99,9 @@ (setf (id self) (set-timer self (^delay))))))))))) (defun set-timer (self time) - (setf (gethash (id self) (dictionary *tkw*)) self) ;; redundant but fast - (tk-eval "after ~a {event generate . <<time-is-up>> -data ~a}" time (id self))) + (let ((lookup-id (gentemp "AFTER"))) + (setf (gethash lookup-id (dictionary *tkw*)) self) + (tk-eval "after ~a {event generate . <<time-is-up>> -data ~a}" time lookup-id))) (defobserver timers ((self tk-object) new-value old-value) (dolist (k (set-difference old-value new-value)) --- /project/cells/cvsroot/Celtk/tk-interp.lisp 2006/05/15 05:15:37 1.7 +++ /project/cells/cvsroot/Celtk/tk-interp.lisp 2006/05/16 02:52:22 1.8 @@ -160,8 +160,6 @@ (pathName :string) (related-tkwin :pointer)) - - ;;; --- Togl (Version 1.7 and above needed!) ----------------------------- @@ -253,39 +251,7 @@ (tcl-eval interp script)) -#+testing -(defun exec-button () - (tk-interp-init-ensure) - (let ((interp (Tcl_CreateInterp))) - (tk-app-init interp) - (togl_init interp) - #+works (progn - (eval-script interp "button .b1 -text Hello") - (eval-script interp "pack .b1")) - (eval-script interp "togl .t1 -height 100 -height 100 -ident t1") - ;;(eval-script interp "puts \"Hello puts\"") - ) - (Tk_MainLoop)) - -#+testing -(defun test-result () - (tk-interp-init-ensure) - (let ((*tki* (Tcl_CreateInterp))) - (tk-app-init *tki*) - #+wait (eval-script *tki* "font families") - #+ok (eval-script *tki* "tk scaling") - #+ok (progn - (eval-script *tki* "set xyz 42") - (eval-script *tki* "set xyz")) - ;;(trc "string result:" (tcl-get-string-result interp)) - (trc "tk-eval result:" (tk-eval "tk scaling")) - (trc "tk-eval-list result:" (tk-eval-list "font families")))) - -;;;(defun exec-main () -;;; (main "\\0devtools\\frgotk\\psu-rc-gui.tcl")) -;;; -;;;#+test -;;;(exec-main) + ;;; Togl stuff --- /project/cells/cvsroot/Celtk/widget.lisp 2006/05/15 05:15:37 1.5 +++ /project/cells/cvsroot/Celtk/widget.lisp 2006/05/16 02:52:22 1.6 @@ -22,6 +22,31 @@ (in-package :Celtk) +;;; --- widget tkwin window glue ----------------------- + +(defun widget-to-tkwin (self) + (tk-name-to-window *tki* (path self) (tk-main-window *tki*))) + +(defun xwin-register (self) + (when (tkwin self) + (let ((xwin (tkwin-window (tkwin self)))) + (when (plusp xwin) + (setf (gethash xwin (xwins .tkw)) self) + xwin)))) + +(defun tkwin-widget (tkwin) + (gethash tkwin (tkwins *tkw*))) + +(defun xwin-widget (xwin) ;; assignment of xwin is deferred so...all this BS.. + (when (plusp xwin) + (or (gethash xwin (xwins *tkw*)) + (loop for self being the hash-values of (tkwins *tkw*) + using (hash-key tkwin) + unless (xwin self) ;; we woulda found it by now + do (when (eql xwin (xwin-register self)) + (return-from xwin-widget self)) + finally (trc "xwin-widget > no widget for xwin " xwin))))) + ;;; --- widget ----------------------------------------- (defmodel widget (family tk-object) @@ -35,10 +60,7 @@ (packing :reader packing :initarg :packing :initform nil) (gridding :reader gridding :initarg :gridding :initform nil) (enabled :reader enabled :initarg :enabled :initform t) - (event-handlers :reader event-handlers :initarg :event-handlers :initform nil) - (virtual-event-handlers :reader virtual-event-handlers :initarg :virtual-event-handlers :initform nil) - (needs-event-handler-p :reader needs-event-handler-p - :initform (c? (or (^event-handlers)(^virtual-event-handlers)))) + (event-handler :reader event-handler :initarg :event-handler :initform nil) (menus :reader menus :initarg :menus :initform nil :documentation "An assoc of an arbitrary key and the associated CLOS menu instances (not their tk ids)") (image-files :reader image-files :initarg :image-files :initform nil) @@ -48,26 +70,12 @@ (:default-initargs :id (gentemp "W"))) -(defobserver needs-event-handler-p () - (when new-value +(defobserver event-handler () + (when new-value ;; \\\ work out how to unregister any old value (with-integrity (:client `(:post-make-tk ,self)) + (trc "creating event handler for" self) (tk-create-event-handler-ex self 'widget-event-handler -1)))) ;; // make this -1 more efficient -(defun widget-to-tkwin (self) - (tk-name-to-window *tki* (path self) (tk-main-window *tki*))) - -(defcallback widget-event-handler :void ((client-data :int)(xe :pointer)) - (trc "bingo" (tk-event-type (xsv type xe))) - (case (tk-event-type (xsv type xe)) - (:virtualevent - (let* ((self (xwin-widget (xsv event-window xe))) - (name (read-from-string (string-upcase (xsv name xe)))) - (entry (assoc name (^virtual-event-handlers)))) - (TRC "widget-event-handler" self name) - (if entry - (funcall (second entry) self xe client-data) - (trc "no handler for" name self)))))) - (defun tk-create-event-handler-ex (widget callback-name &rest masks) (let ((self-tkwin (widget-to-tkwin widget))) (assert (plusp self-tkwin)) @@ -77,6 +85,13 @@ (get-callback callback-name) self-tkwin))) +(defcallback widget-event-handler :void ((client-data :int)(xe :pointer)) + (let ((self (tkwin-widget client-data))) + (assert self () "widget-event-handler > no widget for tkwin ~a" client-data) + (bif (h (^event-handler)) + (funcall h self xe) + (trc "widget-event-handler > warning: no handler in instance requesting event handling" self)))) + (defclass commander () () (:default-initargs @@ -112,26 +127,6 @@ (tk-name-to-window *tki* (^path) (tk-main-window *tki*)))))) (setf (gethash tkwin (tkwins .tkw)) self))) -(defun xwin-register (self) - (when (tkwin self) - (let ((xwin (tkwin-window (tkwin self)))) - (when (plusp xwin) - (setf (gethash xwin (xwins .tkw)) self) - xwin)))) - -(defun tkwin-widget (tkwin) - (gethash tkwin (tkwins *tkw*))) - -(defun xwin-widget (xwin) ;; assignment of xwin is deferred so...all this BS.. - (when (plusp xwin) - (or (gethash xwin (xwins *tkw*)) - (loop for self being the hash-values of (tkwins *tkw*) - using (hash-key tkwin) - unless (xwin self) ;; we woulda found it by now - do (when (eql xwin (xwin-register self)) - (return-from xwin-widget self)) - finally (trc "xwin-widget > no widget for xwin " xwin))))) - (defmethod make-tk-instance ((self widget)) (setf (gethash (^path) (dictionary .tkw)) self) (trc nil "mktki" self (^path)) @@ -139,6 +134,10 @@ (when (tk-class self) (tk-format-now "~(~a~) ~a ~{~(~a~) ~a~^ ~}" ;; call to this GF now integrity-wrapped by caller (tk-class self) (path self)(tk-configurations self))) + #+tryinafter (tkwin-register self))) + +(defmethod make-tk-instance :after ((self widget)) + (with-integrity (:client `(:post-make-tk ,self)) (tkwin-register self))) (defmethod tk-configure ((self widget) option value)

1 0

[cells-cvs] CVS Celtk
by ktilton 15 May '06

15 May '06

Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv18787 Modified Files: togl.lisp Added Files: tk-structs.lisp Log Message: --- /project/cells/cvsroot/Celtk/togl.lisp 2006/05/15 05:15:37 1.4 +++ /project/cells/cvsroot/Celtk/togl.lisp 2006/05/15 09:00:47 1.5 @@ -130,8 +130,7 @@ (def-togl-callback display ()) (def-togl-callback reshape ()) (def-togl-callback destroy ()) -(def-togl-callback timer () - (check-faux-events)) +(def-togl-callback timer ()) (defmethod make-tk-instance ((self togl)) (with-integrity (:client `(:make-tk ,self)) --- /project/cells/cvsroot/Celtk/tk-structs.lisp 2006/05/15 09:00:48 NONE +++ /project/cells/cvsroot/Celtk/tk-structs.lisp 2006/05/15 09:00:48 1.1 (in-package :celtk) (defctype Window :unsigned-long) ;; <sigh> The XWindow pointer stored in the tkwin record (defctype Time :unsigned-long) (defctype Tk_Uid :string) (defcstruct tk-fake-win "Used by macros to peek at tkwins (why use a fake window definition?)" (display :pointer) (dummy1 :pointer) (screen-num :int) (visual :pointer) (depth :int) (window Window) (dummy2 :pointer) (dummy3 :pointer) (parent-ptr Window) (dummy4 :pointer) (dummy5 :pointer) (pathName :string) ;;; Tk_Uid nameUid; ;;; Tk_Uid classUid; ;;; XWindowChanges changes; ;;; unsigned int dummy6; /* dirtyChanges */ ;;; XSetWindowAttributes atts; ;;; unsigned long dummy7; /* dirtyAtts */ ;;; unsigned int flags; ;;; char *dummy8; /* handlerList */ ;;;#ifdef TK_USE_INPUT_METHODS ;;; XIC dummy9; /* inputContext */ ;;;#endif /* TK_USE_INPUT_METHODS */ ;;; ClientData *dummy10; /* tagPtr */ ;;; int dummy11; /* numTags */ ;;; int dummy12; /* optionLevel */ ;;; char *dummy13; /* selHandlerList */ ;;; char *dummy14; /* geomMgrPtr */ ;;; ClientData dummy15; /* geomData */ ;;; int reqWidth, reqHeight; ;;; int internalBorderLeft; ;;; char *dummy16; /* wmInfoPtr */ ;;; char *dummy17; /* classProcPtr */ ;;; ClientData dummy18; /* instanceData */ ;;; char *dummy19; /* privatePtr */ ;;; int internalBorderRight; ;;; int internalBorderTop; ;;; int internalBorderBottom; ;;; int minReqWidth; ;;; int minReqHeight; ) (defun tkwin-pathname (tkwin) (foreign-slot-value tkwin 'tk-fake-win 'pathname)) (defun tkwin-window (tkwin) "Get the (different!) XWindow pointer from the tkwin data structure. Note that the Xwindow structure is not allocated straight away, not until (I guess) the XWindow server has gotten involved with the widget." (foreign-slot-value tkwin 'tk-fake-win 'window)) #| typedef struct { int type; unsigned long serial; /* # of last request processed by server */ Bool send_event; /* True if this came from a SendEvent request */ Display *display; /* Display the event was read from */ Window event; /* Window on which event was requested. */ Window root; /* root window that the event occured on */ Window subwindow; /* child window */ Time time; /* milliseconds */ int x, y; /* pointer x, y coordinates in event window */ int x_root, y_root; /* coordinates relative to root */ unsigned int state; /* key or button mask */ Tk_Uid name; /* Name of virtual event. */ Bool same_screen; /* same screen flag */ Tcl_Obj *user_data; /* application-specific data reference; Tk will * decrement the reference count *once* when it * has finished processing the event. */ } XVirtualEvent; |# (defcstruct x-virtual-event "Virtual event, OK?" (type :int) (serial :unsigned-long) (send-event :boolean) (display :pointer) (event-window Window) (root-window Window) (sub-window Window) (time Time) (x :int) (y :int) (x-root :int) (y-root :int) (state :unsigned-int) (name :string) (same-screen :boolean) (user-data :pointer) ) (defmacro xsv (slot-name xptr) `(foreign-slot-value ,xptr 'X-Virtual-Event ',slot-name)) (defun xevent-type (xe) (tk-event-type (xsv type xe))) (defcenum tcl-event-flag-values (:tcl-dont-wait 2) (:tcl-window-events 4) (:tcl-file-events 8) (:tcl-timer-events 16) (:tcl-idle-events 32) (:tcl-all-events -3)) (defcenum tcl-variable-related-flag "Flags passed to getvar, setvar, tracevar, etc" (:TCL_GLOBAL_ONLY 1) (:TCL_NAMESPACE_ONLY 2) (:TCL_APPEND_VALUE 4) (:TCL_LIST_ELEMENT 8) (:TCL_TRACE_READS #x10) (:TCL_TRACE_WRITES #x20) (:TCL_TRACE_UNSETS #x40) (:TCL_TRACE_DESTROYED #x80) (:TCL_INTERP_DESTROYED #x100) (:TCL_LEAVE_ERR_MSG #x200) (:TCL_TRACE_ARRAY #x800) ;; Required to support old variable/vdelete/vinfo traces */ (:TCL_TRACE_OLD_STYLE #x1000) ;; Indicate the semantics of the result of a trace */ (:TCL_TRACE_RESULT_DYNAMIC #x8000) (:TCL_TRACE_RESULT_OBJECT #x10000)) (defun var-flags (&rest kws) (apply '+ (loop for kw in kws collecting (foreign-enum-value 'tcl-variable-related-flag kw))))

1 0

[cells-cvs] CVS Celtk
by ktilton 13 May '06

13 May '06

Update of /project/cells/cvsroot/Celtk In directory clnet:/tmp/cvs-serv26494 Added Files: Gears.lpr lotsa-widgets.lisp tk-events.lisp Log Message: --- /project/cells/cvsroot/Celtk/Gears.lpr 2006/05/13 14:36:58 NONE +++ /project/cells/cvsroot/Celtk/Gears.lpr 2006/05/13 14:36:58 1.1 ;; -*- lisp-version: "8.0 [Windows] (May 5, 2006 15:39)"; cg: "1.81"; -*- (in-package :cg-user) (defpackage :GEARS) (define-project :name :gears :modules (list (make-instance 'module :name "gears.lisp")) :projects (list (make-instance 'project-module :name "CELTK") (make-instance 'project-module :name "C:\\0devtools\\cl-opengl\\glu")) :libraries nil :distributed-files nil :internally-loaded-files nil :project-package-name :gears :main-form nil :compilation-unit t :verbose nil :runtime-modules '(:cg-dde-utils :cg.base :cg.bitmap-pane :cg.bitmap-pane.clipboard :cg.bitmap-stream :cg.button :cg.caret :cg.check-box :cg.choice-list :cg.choose-printer :cg.clipboard :cg.clipboard-stack :cg.clipboard.pixmap :cg.color-dialog :cg.combo-box :cg.common-control :cg.comtab :cg.cursor-pixmap :cg.curve :cg.dialog-item :cg.directory-dialog :cg.directory-dialog-os :cg.drag-and-drop :cg.drag-and-drop-image :cg.drawable :cg.drawable.clipboard :cg.dropping-outline :cg.edit-in-place :cg.editable-text :cg.file-dialog :cg.fill-texture :cg.find-string-dialog :cg.font-dialog :cg.gesture-emulation :cg.get-pixmap :cg.get-position :cg.graphics-context :cg.grid-widget :cg.grid-widget.drag-and-drop :cg.group-box :cg.header-control :cg.hotspot :cg.html-dialog :cg.html-widget :cg.icon :cg.icon-pixmap :cg.ie :cg.item-list :cg.keyboard-shortcuts :cg.lamp :cg.lettered-menu :cg.lisp-edit-pane :cg.lisp-text :cg.lisp-widget :cg.list-view :cg.mci :cg.menu :cg.menu.tooltip :cg.message-dialog :cg.multi-line-editable-text :cg.multi-line-lisp-text :cg.multi-picture-button :cg.multi-picture-button.drag-and-drop :cg.multi-picture-button.tooltip :cg.ocx :cg.os-widget :cg.os-window :cg.outline :cg.outline.drag-and-drop :cg.outline.edit-in-place :cg.palette :cg.paren-matching :cg.picture-widget :cg.picture-widget.palette :cg.pixmap :cg.pixmap-widget :cg.pixmap.file-io :cg.pixmap.printing :cg.pixmap.rotate :cg.printing :cg.progress-indicator :cg.project-window :cg.property :cg.radio-button :cg.rich-edit :cg.rich-edit-pane :cg.rich-edit-pane.clipboard :cg.rich-edit-pane.printing :cg.sample-file-menu :cg.scaling-stream :cg.scroll-bar :cg.scroll-bar-mixin :cg.selected-object :cg.shortcut-menu :cg.static-text :cg.status-bar :cg.string-dialog :cg.tab-control :cg.template-string :cg.text-edit-pane :cg.text-edit-pane.file-io :cg.text-edit-pane.mark :cg.text-or-combo :cg.text-widget :cg.timer :cg.toggling-widget :cg.toolbar :cg.tooltip :cg.trackbar :cg.tray :cg.up-down-control :cg.utility-dialog :cg.web-browser :cg.web-browser.dde :cg.wrap-string :cg.yes-no-list :cg.yes-no-string :dde) :splash-file-module (make-instance 'build-module :name "") :icon-file-module (make-instance 'build-module :name "") :include-flags '(:top-level :debugger) :build-flags '(:allow-runtime-debug :purify) :autoload-warning t :full-recompile-for-runtime-conditionalizations nil :default-command-line-arguments "+M +t \"Console for Debugging\"" :additional-build-lisp-image-arguments '(:read-init-files nil) :old-space-size 256000 :new-space-size 6144 :runtime-build-option :standard :on-initialization 'gears::gears :on-restart 'do-default-restart) ;; End of Project Definition --- /project/cells/cvsroot/Celtk/lotsa-widgets.lisp 2006/05/13 14:36:58 NONE +++ /project/cells/cvsroot/Celtk/lotsa-widgets.lisp 2006/05/13 14:36:58 1.1 (in-package :celtk-user) (defmodel lotsa-widgets (window) () (:default-initargs :kids (c? (the-kids (demo-all-menubar) (mk-row (:packing (c?pack-self)) (mk-label :text "aaa" :image-files (list (list 'kt (make-pathname #+lispworks :host #-lispworks :device "c" :directory '(:absolute "0dev" "Celtk") :name "kt69" :type "gif"))) :height 200 :width 300 :image (c? (format nil "~(~a.~a~)" (ctk::^path) 'kt))) (assorted-canvas-items) (mk-stack () (mk-text-widget :id :my-text :md-value (c?n "hello, world") :height 8 :width 25) (spin-package-with-symbols)) (mk-stack () (mk-row (:id :radio-ny :selection (c-in 'yes)) (mk-radiobutton-ex ("yes" 'yes)) (mk-radiobutton-ex ("no" 'no)) (mk-label :text (c? (string (selection (upper self selector)))))) (mk-row () (mk-checkbutton :id :check-me :text "Check Me" :md-value (c-in t)) (mk-label :text (c? (if (fm^v :check-me) "checked" "unchecked")))) (mk-row () (mk-button-ex ("Time now?" (setf (fm^v :push-time) (get-universal-time)))) (mk-label :text (c? (time-of-day (^md-value))) :id :push-time :md-value (c-in (get-universal-time)))) (style-by-edit-menu) (style-by-widgets) (mk-row (:layout-anchor 'sw) (mk-entry :id :enter-me) (mk-label :text (c? (conc$ "echo " (fm^v :enter-me)))))) (duelling-scrolled-lists) ))))) (defun style-by-edit-menu () (mk-row ("Style by Edit Menu") (mk-label :text "Four score and seven years ago today" :wraplength 600 :tkfont (c? (list (selection (fm^ :app-font-face)) (selection (fm^ :app-font-size)) (if (fm^v :app-font-italic) 'italic 'roman) (if (fm^v :app-font-bold) 'bold 'normal)))))) (defun spin-package-with-symbols () (mk-stack () (mk-spinbox :id :spin-pkg :md-value (cells::c?n "cells") :tk-values (mapcar 'down$ (sort (mapcar 'package-name (list-all-packages)) 'string>))) (mk-scrolled-list :id :spinpkg-sym-list :list-height 6 :list-item-keys (c? (let* ((spinner (fm^ :spin-pkg)) (item (when spinner (md-value spinner))) (pkg (find-package (string-upcase item)))) (when pkg (loop for sym being the symbols in pkg for n below 25 counting sym into symct collecting sym into syms finally (trc "syms found !!!" symct) (return syms))))) :list-item-factory (lambda (sym) (make-instance 'listbox-item :fm-parent *parent* :md-value sym :item-text (down$ (symbol-name sym))))))) (defun duelling-scrolled-lists () (mk-row () (mk-scrolled-list :id :pkg-list :selection (c-in (find-package "ASDF")) :list-height 6 :list-item-keys (list-all-packages) :list-item-factory (lambda (pkg) (make-instance 'listbox-item :fm-parent *parent* :md-value pkg :item-text (down$ (package-name pkg))))) (mk-scrolled-list :id :pkg-sym-list :list-height 6 :list-item-keys (c? (bwhen (pkg (selection (fm^ :pkg-list))) (loop for sym being the present-symbols in pkg for n below 25 collecting sym))) :list-item-factory (lambda (sym) (make-instance 'listbox-item :md-value sym :fm-parent *parent* :item-text (down$ (symbol-name sym))))))) (defun assorted-canvas-items () (mk-canvas :height 350 :kids (c? (the-kids (mk-bitmap :coords (list 140 140) :bitmap "@\\0dev\\Celtk\\x1.xbm" #+not "@\\temp\\gsl.xbm") (mk-rectangle :coords (list 10 10 100 60) :tk-fill "red") (mk-text-item :coords (list 100 80) :text "i am an item" :tk-fill 'blue) (mk-arc :coords (list 10 100 100 160) :start 45 :tk-fill "orange") (mk-line :coords (list 250 10 300 40 250 70 400 100) :width 8 :smooth 'bezier :joinstyle 'miter :arrow 'both :tk-fill 'purple) (mk-oval :coords (list 10 200 100 260) :tk-fill "yellow") (mk-polygon :coords (list 250 210 300 220 340 200 260 180) :width 4 :tk-fill 'green :smooth 'bezier :joinstyle 'miter) (mk-arc :coords (list 10 300 100 360) :start 45 :tk-fill "white") )))) (defun style-by-widgets () (mk-stack ("Style by Widgets" :id :widstyle) (mk-row (:id :stywid :packing-side 'left :layout-anchor 'sw) (mk-popup-menubutton :id :font-face :initial-value (c? (second (^entry-values))) :entry-values (c? (eko ("popup ff") (subseq (tk-eval-list "font families") 4 10)))) (mk-scale :id :font-size :md-value (c-in 14) :tk-label "Font Size" :from 7 :to 24 :orient 'horizontal)) (mk-label :text "Four score and seven years ago today, our fathers broguht forth on this continent a new nation..." :wraplength 200 :justify 'left :tkfont (c? (list (selection (fm^ :font-face)) (md-value (fm^ :font-size))))))) (defun demo-all-menubar () (mk-menubar :id 'mbar :kids (c? (the-kids (mk-menu-entry-cascade :id 'file :label "File" :kids (c? (the-kids (mk-menu :id 'filemenu :kids (c? (the-kids (mk-menu-entry-command :label "New" :command "exit") (mk-menu-entry-command :label "Open" :command "tk_getOpenFile") (mk-menu-entry-command :label "Close" :command "exit") (mk-menu-entry-separator) (mk-menu-entry-command :label "Quit" :state (c? (if t ;; (md-value (fm^ :check-me)) 'normal 'disabled)) :command "exit"))))))) (mk-menu-entry-cascade :id 'editcascade :label "Edit" :kids (c? (the-kids (mk-menu :id 'editmenu :kids (c? (the-kids (mk-menu-entry-command :label "Undo" :on-command (lambda (self) (trc "edit menu undo" self))) (mk-menu-entry-separator) (mk-menu-entry-command :label "Cut" :command "exit") (mk-menu-entry-command :label "Copy" :command "exit") (mk-menu-entry-command :label "Paste" :command "exit") (mk-menu-entry-command :label "Clear" :command "exit") (mk-menu-entry-separator) (mk-menu-radio-group :id :app-font-face :selection (c-in "courier") :kids (c? (the-kids (mk-menu-entry-radiobutton :label "Times" :value "times") (mk-menu-entry-radiobutton :label "Courier" :value "courier") (mk-menu-entry-radiobutton :label "Helvetica" :value "helvetica")))) (mk-menu-entry-separator) (mk-menu-entry-cascade :id :app-font-size :label "Font Size" :menu (c? (path (kid1 self))) :selection (c-in 12) :kids (c? (the-kids (mk-menu :id :fsztoff :tearoff 1 :kids (c? (the-kids (loop for (label value) in '(("9" 9)("12" 12)("14" 14)) collecting (mk-menu-entry-radiobutton :label label :value value)))))))) (mk-menu-entry-separator) (mk-menu-entry-checkbutton :id :app-font-italic :label "Italic") (mk-menu-entry-checkbutton :id :app-font-bold :label "Bold" :md-value (c-in t)))))))))))) --- /project/cells/cvsroot/Celtk/tk-events.lisp 2006/05/13 14:36:58 NONE +++ /project/cells/cvsroot/Celtk/tk-events.lisp 2006/05/13 14:36:58 1.1 (in-package :celtk) #| typedef struct { int type; unsigned long serial; /* # of last request processed by server */ Bool send_event; /* True if this came from a SendEvent request */ Display *display; /* Display the event was read from */ Window event; /* Window on which event was requested. */ Window root; /* root window that the event occured on */ Window subwindow; /* child window */ Time time; /* milliseconds */ int x, y; /* pointer x, y coordinates in event window */ int x_root, y_root; /* coordinates relative to root */ unsigned int state; /* key or button mask */ Tk_Uid name; /* Name of virtual event. */ Bool same_screen; /* same screen flag */ Tcl_Obj *user_data; /* application-specific data reference; Tk will * decrement the reference count *once* when it * has finished processing the event. */ } XVirtualEvent; |# (defctype Window-ptr :unsigned-long) (defctype Time :unsigned-long) (defctype Tk_Uid :string) (defcstruct x-virtual-event (type :int) (serial :unsigned-long) (send-event :boolean) (display :pointer) (event-window Window-ptr) (root-window Window-ptr) (sub-window Window-ptr) (time Time) (x :int) (y :int) (x-root :int) (y-root :int) (state :unsigned-int) (name Tk_Uid) (same-screen :boolean) (user-data :string) ) (defcenum tcl-event-flag-values (:tcl-dont-wait 2) (:tcl-window-events 4) (:tcl-file-events 8) (:tcl-timer-events 16) (:tcl-idle-events 32) (:tcl-all-events -3)) (defcfun ("Tcl_DoOneEvent" Tcl_DoOneEvent) :int (flags :int)) (defcfun ("Tcl_DoWhenIdle" tcl-do-when-idle) :void (tcl-idle-proc :pointer) (client-data :int)) (defcallback tcl-idle-proc :void ((client-data :int)) (unless (c-stopped) (print (list :idle-proc :client-data client-data)))) ;; Tk_MainLoop (defcfun ("Tk_MainLoop" Tk_MainLoop) :void) (defcfun ("Tk_CreateEventHandler" tk-create-event-handler) :void (tkwin :pointer) (mask :int) (proc :pointer) (client-data :int)) (defcallback tk-event-proc :void ((client-data :int)(XEvent :pointer)) (trc "yowza tk-event-proc" client-data XEvent (tk-event-type (mem-aref XEvent :int)) [42 lines skipped]

1 0