June 2006 - cells-gtk-cvs@common-lisp.net

[cells-gtk-cvs] CVS cells
by pdenno 07 Jun '06

07 Jun '06

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

1 0

[cells-gtk-cvs] CVS root/pod-utils
by pdenno 01 Jun '06

01 Jun '06

Update of /project/cells-gtk/cvsroot/root/pod-utils In directory clnet:/tmp/cvs-serv2395/root/pod-utils Modified Files: utils.lisp Log Message: Marco's patch http://common-lisp.net/pipermail/cells-gtk-devel/2006-May/000171.html and also moved trc routines to kt-trace.lisp --- /project/cells-gtk/cvsroot/root/pod-utils/utils.lisp 2006/02/19 20:09:12 1.1 +++ /project/cells-gtk/cvsroot/root/pod-utils/utils.lisp 2006/06/01 14:24:40 1.2 @@ -469,7 +469,7 @@ (format nil "~D.~2,'0D.~2,'0D ~2,'0D:~2,'0D:~2,'0D" y month d h m s))) ;;; Norvig's search routines -(defun tree-search (states goal-p successors combiner) +(defun tree-search (states goal-p successors combiner &optional do-fn) "Find a state that satisfies GOAL-P. Start with STATES, and search according to successors and combiners." (cond ((null states) :fail) @@ -705,65 +705,3 @@ (and (funcall fn x) (funcall chain x)))))) -;;; Kenny Tilton trace stuff --------------- - -(defparameter *trcdepth* 0) -(defvar *count* nil) -(defvar *counting* nil) -(defvar *dbg*) -(defvar *stop* nil) - -(defun utils-kt-reset () - (setf *count* nil - *stop* nil - *dbg* nil - *trcdepth* 0)) - -;----------- trc ------------------------------------------- - -(defparameter *trcdepth* 0) -(defvar *counting* nil) - -(defmacro count-it (&rest keys) - `(when *counting* - (call-count-it ,@keys))) - -(defmacro trc (tgt-form &rest os - &aux (wrapper (if (macro-function 'without-c-dependency) - 'without-c-dependency 'progn))) - (if (eql tgt-form 'nil) - '(progn) - (if (stringp tgt-form) - `(,wrapper - (call-trc t ,tgt-form ,@os)) - (let ((tgt (gensym))) - `(,wrapper - (bif (,tgt ,tgt-form) - (if (trcp ,tgt) - (progn - (assert (stringp ,(car os))) - (call-trc t ,@os)) ;;,(car os) ,tgt ,@(cdr os))) - (progn - ;;(break "trcfailed") - (count-it :trcfailed))) - (count-it :tgtnileval))))))) - -(defun call-trc (stream s &rest os) - (if #+cormanlisp nil #-cormanlisp (and (boundp '*trcdepth*) - *trcdepth*) - (format stream "~&~v,,,'.<~d~>> " (mod *trcdepth* 100) *trcdepth*) - (format stream "~&")) - (format stream "~a" s) - (let (pkwp) - (dolist (o os) - (format stream (if pkwp " ~s" " | ~s") o) - (setf pkwp (keywordp o)))) - (values)) - -(defun call-count-it (&rest keys) - (declare (ignorable keys)) - ;;; (when (eql :TGTNILEVAL (car keys))(break)) - (let ((entry (assoc keys *count* :test #'equal))) - (if entry - (setf (cdr entry) (1+ (cdr entry))) - (push (cons keys 1) *count*))))

1 0

[cells-gtk-cvs] CVS root/pod-utils
by pdenno 01 Jun '06

01 Jun '06

Update of /project/cells-gtk/cvsroot/root/pod-utils In directory clnet:/tmp/cvs-serv2368/root/pod-utils Added Files: kt-trace.lisp Log Message: New file. Kenny Tilton's trace routines. --- /project/cells-gtk/cvsroot/root/pod-utils/kt-trace.lisp 2006/06/01 14:22:45 NONE +++ /project/cells-gtk/cvsroot/root/pod-utils/kt-trace.lisp 2006/06/01 14:22:45 1.1 ;;; Copyright (c) 2004 Kenny 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. ;;;----------------------------------------------------------------------- ;;; ;;; Kenny Tilton trace stuff. ;;; (in-package :pod-utils) (defparameter *trcdepth* 0) (defvar *count* nil) (defvar *counting* nil) (defvar *dbg*) (defvar *stop* nil) (defun utils-kt-reset () (setf *count* nil *stop* nil *dbg* nil *trcdepth* 0)) ;----------- trc ------------------------------------------- (defparameter *trcdepth* 0) (defvar *counting* nil) (defmacro count-it (&rest keys) `(when *counting* (call-count-it ,@keys))) (defmacro trc (tgt-form &rest os &aux (wrapper (if (macro-function 'without-c-dependency) 'without-c-dependency 'progn))) (if (eql tgt-form 'nil) '(progn) (if (stringp tgt-form) `(,wrapper (call-trc t ,tgt-form ,@os)) (let ((tgt (gensym))) `(,wrapper (bif (,tgt ,tgt-form) (if (trcp ,tgt) (progn (assert (stringp ,(car os))) (call-trc t ,@os)) ;;,(car os) ,tgt ,@(cdr os))) (progn ;;(break "trcfailed") (count-it :trcfailed))) (count-it :tgtnileval))))))) (defun call-trc (stream s &rest os) (if #+cormanlisp nil #-cormanlisp (and (boundp '*trcdepth*) *trcdepth*) (format stream "~&~v,,,'.<~d~>> " (mod *trcdepth* 100) *trcdepth*) (format stream "~&")) (format stream "~a" s) (let (pkwp) (dolist (o os) (format stream (if pkwp " ~s" " | ~s") o) (setf pkwp (keywordp o)))) (values)) (defun call-count-it (&rest keys) (declare (ignorable keys)) ;;; (when (eql :TGTNILEVAL (car keys))(break)) (let ((entry (assoc keys *count* :test #'equal))) (if entry (setf (cdr entry) (1+ (cdr entry))) (push (cons keys 1) *count*)))) (export '(trc))

1 0

[cells-gtk-cvs] CVS root/pod-utils
by pdenno 01 Jun '06

01 Jun '06

Update of /project/cells-gtk/cvsroot/root/pod-utils In directory clnet:/tmp/cvs-serv2330/root/pod-utils Modified Files: pod-utils.asd Log Message: Added kt-trace to what is loaded. --- /project/cells-gtk/cvsroot/root/pod-utils/pod-utils.asd 2006/02/19 20:09:12 1.1 +++ /project/cells-gtk/cvsroot/root/pod-utils/pod-utils.asd 2006/06/01 14:20:56 1.2 @@ -2,4 +2,5 @@ (asdf:defsystem :pod-utils :name "pod-utils" :components - ((:file "utils"))) + ((:file "utils") + (:file "kt-trace")))

1 0

[cells-gtk-cvs] CVS root/gtk-ffi
by pdenno 01 Jun '06

01 Jun '06

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory clnet:/tmp/cvs-serv2195/root/gtk-ffi Modified Files: gtk-utilities.lisp Log Message: Marco's patch http://common-lisp.net/pipermail/cells-gtk-devel/2006-May/000171.html --- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp 2006/02/19 20:18:27 1.19 +++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-utilities.lisp 2006/06/01 14:18:22 1.20 @@ -88,7 +88,7 @@ (when (or (eql (event-type event) :button_press) (eql (event-type event) :button_release)) (when (= (gdk-event-button-button signal) 3) - (gtk-menu-popup widget nil nil nil nil 3 + (gtk-menu-popup widget +c-null+ +c-null+ +c-null+ +c-null+ 3 (gdk-event-button-time signal))))) 0) @@ -264,7 +264,7 @@ (defun gtk-file-chooser-get-filenames-strs (file-chooser) (let ((glist (gtk-file-chooser-get-filenames file-chooser))) (loop for lst-address = glist then (cffi:foreign-slot-value lst-address 'gslist 'next) - while (and lst-address (not (zerop lst-address))) + while (and lst-address (not (cffi:null-pointer-p lst-address))) collect (cffi:foreign-slot-value lst-address 'gslist 'data) finally (g-slist-free glist))))

1 0

[cells-gtk-cvs] CVS root/gtk-ffi
by pdenno 01 Jun '06

01 Jun '06

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory clnet:/tmp/cvs-serv2145/root/gtk-ffi Modified Files: gtk-ffi.lisp Log Message: Marco's patch http://common-lisp.net/pipermail/cells-gtk-devel/2006-May/000171.html --- /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp 2006/02/19 20:17:41 1.19 +++ /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-ffi.lisp 2006/06/01 14:16:28 1.20 @@ -16,7 +16,10 @@ |# -(defpackage :gtk-ffi (:use :common-lisp :pod)) +(eval-when (:compile-toplevel :load-toplevel :execute) + (unless (find-package :gtk-ffi) + (defpackage :gtk-ffi + (:use :common-lisp :pod)))) (in-package :gtk-ffi) @@ -138,7 +141,7 @@ #+macosx "libcellsgtk.dylib"))) ) ; eval -(eval-when (:compile-toplevel :execute) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(+c-null+ int-slot-indexed load-gtk-libs)) (defun gtk-function-name (lisp-name) (substitute #\_ #\- lisp-name))

1 0

[cells-gtk-cvs] CVS public_html
by pdenno 01 Jun '06

01 Jun '06

Update of /project/cells-gtk/cvsroot/public_html In directory clnet:/tmp/cvs-serv605/public_html Modified Files: index.html Log Message: News about Marco's update. --- /project/cells-gtk/cvsroot/public_html/index.html 2006/03/17 05:18:23 1.26 +++ /project/cells-gtk/cvsroot/public_html/index.html 2006/06/01 14:14:21 1.27 @@ -74,6 +74,11 @@ <h1 id='news'>News</h1> <ul> + <li> <strong>2006-06-01</strong> Patches from Marco Gidde make Cells-GTK work better under SBCL. + These patches were applied to the CVS repository, but are not in any snapshot yet. See the repository + versions of gtk-ffi/gtk-utilities.lisp pod-utils/utils.lisp and gtk-ffi/gtk-ffi.lisp for + the fixes, or read the <a href='http://common-lisp.net/pipermail/cells-gtk-devel/2006-May/000171.html'> + mail</a> from Marco. It includes the patches. <li> <strong>2006-02-16</strong> Native CFFI now used in most of the code. There is a <a href="ftp://common-lisp.net/pub/project/cells-gtk/cells-gtk-2006-02-16.tgz">snapshot release</a>. <li> <strong>2006-01-03</strong> BIG NEWS! cells-gtk now runs under <a href="http://clisp.cons.org">CLISP</a> @@ -111,8 +116,6 @@ capabilities otherwise not available through the FFI.</li> </ul> - -  <h1 id='download'>Download</h1> @@ -166,8 +169,6 @@ Follow instructions in the include INSTALL.TXT.</li> </ul> - -  <h1 id='mailinglist'>Mailing List</h1> @@ -175,10 +176,8 @@ mailing list</a> where questions are always welcome. <hr/> - <address><a href="mailto:peter.denno@nist.gov">Peter Denno</a></address> - - -Last modified: 2006-01-04 +<address><a href="mailto:peter.denno@nist.gov">Peter Denno</a></address> +Last modified: 2006-06-01  <a href="http://validator.w3.org/check?uri=referer"><img src="http://www.w3.org/Icons/valid-xhtml10"

1 0