December 2005 - lambda-gtk-cvs@common-lisp.net

[lambda-gtk-cvs] CVS update: lambda-gtk/lambda-gtk-common.lisp
by htaube＠common-lisp.net 06 Dec '05

06 Dec '05

Update of /project/lambda-gtk/cvsroot/lambda-gtk In directory common-lisp.net:/tmp/cvs-serv12088 Modified Files: lambda-gtk-common.lisp Log Message: put generated package exports inside eval-when Date: Tue Dec 6 18:42:53 2005 Author: htaube Index: lambda-gtk/lambda-gtk-common.lisp diff -u lambda-gtk/lambda-gtk-common.lisp:1.2 lambda-gtk/lambda-gtk-common.lisp:1.3 --- lambda-gtk/lambda-gtk-common.lisp:1.2 Mon Dec 13 03:51:23 2004 +++ lambda-gtk/lambda-gtk-common.lisp Tue Dec 6 18:42:52 2005 @@ -595,6 +595,7 @@ (let ((*print-case* ':downcase)) (terpri fil) (format fil postlude-string) + (format fil "~%(eval-when (:load-toplevel :execute)~%") (when g-exports (pprint `(export ',(reverse g-exports) :g) fil)) @@ -612,5 +613,5 @@ fil)) (terpri fil) (pprint '(pushnew ':gtk *features*) fil) - (format fil "~%~%;;; end generated output~%~%") + (format fil "~%)~%~%;;; end generated output~%~%") (values)))

1 0

[lambda-gtk-cvs] CVS update: lambda-gtk/lambda-gtk-openmcl.lisp
by htaube＠common-lisp.net 06 Dec '05

06 Dec '05

Update of /project/lambda-gtk/cvsroot/lambda-gtk In directory common-lisp.net:/tmp/cvs-serv12006 Modified Files: lambda-gtk-openmcl.lisp Log Message: added trailing semicolon detect presence of ccl:darwin-headers;gtk2; directory Date: Tue Dec 6 18:42:10 2005 Author: htaube Index: lambda-gtk/lambda-gtk-openmcl.lisp diff -u lambda-gtk/lambda-gtk-openmcl.lisp:1.4 lambda-gtk/lambda-gtk-openmcl.lisp:1.5 --- lambda-gtk/lambda-gtk-openmcl.lisp:1.4 Fri Dec 31 22:18:04 2004 +++ lambda-gtk/lambda-gtk-openmcl.lisp Tue Dec 6 18:42:10 2005 @@ -338,7 +338,7 @@ (dolist (l *gtk-libfiles*) (open-shared-library (libpath l))))) (eval-when (:compile-toplevel :load-toplevel :execute) - (if (probe-file \"ccl:darwin-headers;gtk2\" ) + (if (probe-file \"ccl:darwin-headers;gtk2;\" ) (use-interface-dir :gtk2) (error \"Interface directory ccl:darwin-headers;gtk2; does not exist.\"))) ")

1 0

[lambda-gtk-cvs] CVS update: lambda-gtk/lambda-gtk-cmusbcl.lisp
by htaube＠common-lisp.net 06 Dec '05

06 Dec '05

Update of /project/lambda-gtk/cvsroot/lambda-gtk In directory common-lisp.net:/tmp/cvs-serv11986 Modified Files: lambda-gtk-cmusbcl.lisp Log Message: implemented cstring->string, converted to SBCL native callbalcs (requires sbcl 0.9.7 or higher) Date: Tue Dec 6 18:40:11 2005 Author: htaube Index: lambda-gtk/lambda-gtk-cmusbcl.lisp diff -u lambda-gtk/lambda-gtk-cmusbcl.lisp:1.2 lambda-gtk/lambda-gtk-cmusbcl.lisp:1.3 --- lambda-gtk/lambda-gtk-cmusbcl.lisp:1.2 Fri Dec 31 22:18:03 2004 +++ lambda-gtk/lambda-gtk-cmusbcl.lisp Tue Dec 6 18:40:10 2005 @@ -550,6 +550,7 @@ (in-package :cl-user) (eval-when (:compile-toplevel :load-toplevel :execute) + #+sbcl (setq sb-alien::*values-type-okay* t) (export '(*gtk-libdir* *gtk-libfiles*) :cl-user) (defvar *gtk-libdir* #+:darwin \"/sw/lib/\" #-:darwin \"/usr/lib/\") (defvar *gtk-libfiles* @@ -634,7 +635,17 @@ (defgluecode (:export :gtk) (defun struct-free (x) (free-alien x))) (defgluecode (:export :gtk) - (defun cstring->string (str) (error "\"Fix me: not yet implemented.\""))) + (defun cstring->string (ptr) + (if ("g::nullptr?" ptr) + nil + (let ((p (if (typep ptr '(alien (* (unsigned 8)))) + ptr (cast ptr (* (unsigned 8)))))) + (declare (type (alien (* (unsigned 8))) p)) + (with-output-to-string (s) + (loop for i from 0 + for c = (deref p i) + until (zerop c) + do (write-char (code-char c) s))))))) (defgluecode (:export :gtk) (defun string->cstring (str) (if (= (length str) 0) @@ -681,13 +692,14 @@ `(,p (* t))))) (type (parse-alien-type return))) "#+:sbcl" - `(define-alien-function ,name , (cons type args) ,@body) + `(defparameter ,name + (sb-alien::alien-sap + (sb-alien::alien-lambda ,type ,args ,@body))) "#+:cmu" `(def-callback ,name ,(cons type args) ,@body)))) (defgluecode (:export :g) (defmacro "g-callback" (x) - "#+:sbcl" - `(alien-function-sap ,x) + "#+:sbcl" x "#+:cmu `(alien::callback ,x)")) (defgluecode (:export :g) (defun "g-signal-connect" (instance detailed-signal c-handler data)

1 0