December 2004 - cells-gtk-cvs@common-lisp.net

06 Dec '04

Update of /project/cells-gtk/cvsroot/clisp-cgtk/cells-gtk In directory common-lisp.net:/tmp/cvs-serv26581/cells-gtk Added Files: actions.lisp addon.lisp buttons.lisp callback.lisp cells-gtk.asd cells-gtk.lisp dialogs.lisp display.lisp entry.lisp gtk-app.lisp layout.lisp menus.lisp textview.lisp tree-view.lisp widgets.lisp Log Message: Moving Vasilis's original for CLisp from Cells project to Cells-gtk Date: Mon Dec 6 21:23:21 2004 Author: ktilton

1 0

[cells-gtk-cvs] CVS update: clisp-cgtk/INSTALL.TXT clisp-cgtk/load.lisp
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/clisp-cgtk In directory common-lisp.net:/tmp/cvs-serv26581 Added Files: INSTALL.TXT load.lisp Log Message: Moving Vasilis's original for CLisp from Cells project to Cells-gtk Date: Mon Dec 6 21:23:19 2004 Author: ktilton

1 0

[cells-gtk-cvs] CVS update: Directory change: clisp-cgtk/cells-gtk/test-gtk
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/clisp-cgtk/cells-gtk/test-gtk In directory common-lisp.net:/tmp/cvs-serv26550/test-gtk Log Message: Directory /project/cells-gtk/cvsroot/clisp-cgtk/cells-gtk/test-gtk added to the repository Date: Mon Dec 6 21:21:50 2004 Author: ktilton New directory clisp-cgtk/cells-gtk/test-gtk added

1 0

[cells-gtk-cvs] CVS update: Directory change: clisp-cgtk/test-images
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/clisp-cgtk/test-images In directory common-lisp.net:/tmp/cvs-serv26517/test-images Log Message: Directory /project/cells-gtk/cvsroot/clisp-cgtk/test-images added to the repository Date: Mon Dec 6 21:21:34 2004 Author: ktilton New directory clisp-cgtk/test-images added

1 0

[cells-gtk-cvs] CVS update: Directory change: clisp-cgtk/gtk-ffi
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/clisp-cgtk/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv26517/gtk-ffi Log Message: Directory /project/cells-gtk/cvsroot/clisp-cgtk/gtk-ffi added to the repository Date: Mon Dec 6 21:21:30 2004 Author: ktilton New directory clisp-cgtk/gtk-ffi added

1 0

[cells-gtk-cvs] CVS update: Directory change: clisp-cgtk/cells-gtk
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/clisp-cgtk/cells-gtk In directory common-lisp.net:/tmp/cvs-serv26517/cells-gtk Log Message: Directory /project/cells-gtk/cvsroot/clisp-cgtk/cells-gtk added to the repository Date: Mon Dec 6 21:21:25 2004 Author: ktilton New directory clisp-cgtk/cells-gtk added

1 0

[cells-gtk-cvs] CVS update: Module imported: clisp-cgtk
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/clisp-cgtk In directory common-lisp.net:/tmp/cvs-serv25811 Log Message: Vasilis Margioulas's original cells-gtk for clisp, using the clisp FFI. Status: Vendor Tag: tcvs-vendor Release Tags: tcvs-release No conflicts created by this import Date: Mon Dec 6 21:11:08 2004 Author: ktilton New module clisp-cgtk added

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/test-gtk/test-buttons.lisp root/cells-gtk/test-gtk/test-gtk.lisp
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/root/cells-gtk/test-gtk In directory common-lisp.net:/tmp/cvs-serv25746/cells-gtk/test-gtk Modified Files: test-buttons.lisp test-gtk.lisp Log Message: Ongoing port to Lispworks Date: Mon Dec 6 21:04:18 2004 Author: ktilton Index: root/cells-gtk/test-gtk/test-buttons.lisp diff -u root/cells-gtk/test-gtk/test-buttons.lisp:1.2 root/cells-gtk/test-gtk/test-buttons.lisp:1.3 --- root/cells-gtk/test-gtk/test-buttons.lisp:1.2 Sun Dec 5 07:33:31 2004 +++ root/cells-gtk/test-gtk/test-buttons.lisp Mon Dec 6 21:04:17 2004 @@ -1,10 +1,5 @@ (in-package :test-gtk) -;;;(ff-defun-callable :cdecl :void button-toggled-cb (self event data) -;;; (declare (ignorable event data)) -;;; (let ((state (gtk-toggle-button-get-active self))) -;;; (setf (md-value self) state))) - (defmodel test-buttons (vbox) ((nclics :accessor nclics :initform (c-in 0))) (:default-initargs Index: root/cells-gtk/test-gtk/test-gtk.lisp diff -u root/cells-gtk/test-gtk/test-gtk.lisp:1.2 root/cells-gtk/test-gtk/test-gtk.lisp:1.3 --- root/cells-gtk/test-gtk/test-gtk.lisp:1.2 Sun Dec 5 07:33:31 2004 +++ root/cells-gtk/test-gtk/test-gtk.lisp Mon Dec 6 21:04:17 2004 @@ -13,10 +13,10 @@ :position :center :splash-screen-image "/000000/root/test-images/splash.png" :width 550 :height 550 - :kids (let ((tabs '("Buttons" "Display" "Layout" "Menus" - "Entry" - "Textview" "Dialogs" "Addon" - "Tree-view" + :kids (let ((tabs '("Buttons" ;"Display" "Layout" "Menus" + ;"Entry" + ;"Textview" "Dialogs" "Addon" + ;"Tree-view" ))) (list (mk-notebook :tab-labels nil #+not '("Buttons") @@ -31,8 +31,8 @@ #+clisp (ext:exit)) -(defun gtk-demo () +(defun gtk-demo (&optional dbg) (cells-gtk-init) - (cells-gtk:start-app 'test-gtk::test-gtk :debug nil)) + (cells-gtk:start-app 'test-gtk::test-gtk :debug dbg)) ;(ext:saveinitmem "test-gtk.mem" :init-function 'test-gtk::test-gtk-app)

1 0

[cells-gtk-cvs] CVS update: root/cells-gtk/addon.lisp root/cells-gtk/buttons.lisp root/cells-gtk/callback.lisp root/cells-gtk/gtk-app.lisp root/cells-gtk/menus.lisp root/cells-gtk/tree-view.lisp root/cells-gtk/widgets.lisp
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv25746/cells-gtk Modified Files: addon.lisp buttons.lisp callback.lisp gtk-app.lisp menus.lisp tree-view.lisp widgets.lisp Log Message: Ongoing port to Lispworks Date: Mon Dec 6 21:04:13 2004 Author: ktilton Index: root/cells-gtk/addon.lisp diff -u root/cells-gtk/addon.lisp:1.2 root/cells-gtk/addon.lisp:1.3 --- root/cells-gtk/addon.lisp:1.2 Sun Dec 5 07:33:22 2004 +++ root/cells-gtk/addon.lisp Mon Dec 6 21:04:12 2004 @@ -24,8 +24,7 @@ () (day-selected) :on-day-selected (callback (widg signal data) - (setf (md-value self) (get-date self)))) - + (setf (md-value self) (get-date self)))) (defmethod get-date ((self calendar)) (with-foreign-objects ((year :int)(month :int)(day :int)) Index: root/cells-gtk/buttons.lisp diff -u root/cells-gtk/buttons.lisp:1.2 root/cells-gtk/buttons.lisp:1.3 --- root/cells-gtk/buttons.lisp:1.2 Sun Dec 5 07:33:22 2004 +++ root/cells-gtk/buttons.lisp Mon Dec 6 21:04:12 2004 @@ -51,9 +51,23 @@ (toggled) :active (c-in nil) :on-toggled (callback (widget event data) + (print (list :toggle-button :on-toggled-cb widget)) (let ((state (gtk-toggle-button-get-active widget))) + (print (list :toggledstate state)) (setf (md-value self) state)))) +#+test +(DEF-GTK WIDGET TOGGLE-BUTTON (BUTTON) ((INIT :ACCESSOR INIT :INITARG :INIT :INITFORM NIL)) + (MODE ACTIVE) (TOGGLED) :ACTIVE (C-IN NIL) :ON-TOGGLED + (CALLBACK (WIDGET EVENT DATA) + (LET ((STATE (GTK-TOGGLE-BUTTON-GET-ACTIVE WIDGET))) + (SETF (MD-VALUE SELF) STATE)))) + +#+test +(DEF-C-OUTPUT ACTIVE ((SELF TOGGLE-BUTTON)) + (WHEN (OR NEW-VALUE OLD-VALUE) + (CONFIGURE SELF #'GTK-TOGGLE-BUTTON-SET-ACTIVE NEW-VALUE))) + (def-c-output init ((self toggle-button)) (setf (active self) new-value) (setf (md-value self) new-value)) @@ -73,8 +87,9 @@ c-null (id (first (kids (fm-parent self)))))))) :on-toggled (callback (widget event data) - (let ((state (gtk-toggle-button-get-active widget))) - (setf (md-value self) state)))) + (print (list :radio-button widget event data)) + (let ((state (gtk-toggle-button-get-active widget))) + (setf (md-value self) state)))) (def-c-output .md-value ((self radio-button)) (when (and new-value (upper self box)) Index: root/cells-gtk/callback.lisp diff -u root/cells-gtk/callback.lisp:1.2 root/cells-gtk/callback.lisp:1.3 --- root/cells-gtk/callback.lisp:1.2 Sun Dec 5 07:33:22 2004 +++ root/cells-gtk/callback.lisp Mon Dec 6 21:04:12 2004 @@ -13,15 +13,15 @@ ;(format t "sym:~S fun:~A~%" sym func-self) ;(force-output) (when (not func-self) - (when *gtk-debug* - (format t "~&callback ~a, type ~a, pkg ~a, not found. known callbacks:" - callback-id (type-of callback-id) (when (typep callback-id 'symbol) - (symbol-package callback-id))) - (maphash (lambda (key func-self) - (declare (ignore func-self)) - (format t "~&known callback key ~a, type ~a, pkg ~a" - key (type-of key)(when (typep key 'symbol) (symbol-package key)))) - (callbacks gtk-app)))) + (when *gtk-debug* + (format t "~&callback ~a, type ~a, pkg ~a, not found. known callbacks:" + callback-id (type-of callback-id) (when (typep callback-id 'symbol) + (symbol-package callback-id))) + (maphash (lambda (key func-self) + (declare (ignore func-self)) + (format t "~&known callback key ~a, type ~a, pkg ~a" + key (type-of key)(when (typep key 'symbol) (symbol-package key)))) + (callbacks gtk-app)))) (when (car func-self) (apply (car func-self) (cdr func-self) callback callback-args))))) Index: root/cells-gtk/gtk-app.lisp diff -u root/cells-gtk/gtk-app.lisp:1.2 root/cells-gtk/gtk-app.lisp:1.3 --- root/cells-gtk/gtk-app.lisp:1.2 Sun Dec 5 07:33:22 2004 +++ root/cells-gtk/gtk-app.lisp Mon Dec 6 21:04:12 2004 @@ -25,8 +25,9 @@ (tooltips-delay :accessor tooltips-delay :initarg :tooltips-delay :initform (c-in nil))) (:default-initargs :on-delete-event (lambda (self widget event data) - (declare (ignore self widget event data)) - (gtk-main-quit)))) + (declare (ignore self widget event data)) + (gtk-main-quit) + 0))) (def-c-output tooltips-enable ((self gtk-app)) (when (tooltips self) @@ -56,11 +57,10 @@ (trc "GTK INITIALIZATION") (force-output)) (g-thread-init c-null) (gdk-threads-init) - (assert (gtk-init-check c-null c-null)) + (assert (gtk-init-check c-null-int c-null)) (setf *gtk-initialized* t)) (with-gdk-threads - ;(gvi :withread) (let ((app (make-instance app-name :visible (c-in nil))) (splash)) (when (splash-screen-image app) @@ -71,12 +71,11 @@ (setf (visible splash) t) (loop while (gtk-events-pending) do (gtk-main-iteration))) - (gvi :splashup) + (to-be app) - (gvi :appup) + (when splash (not-to-be splash) - (gvi :splashdown) (gtk-window-set-auto-startup-notification t)) (setf (visible app) t) Index: root/cells-gtk/menus.lisp diff -u root/cells-gtk/menus.lisp:1.2 root/cells-gtk/menus.lisp:1.3 --- root/cells-gtk/menus.lisp:1.2 Sun Dec 5 07:33:22 2004 +++ root/cells-gtk/menus.lisp Mon Dec 6 21:04:12 2004 @@ -20,7 +20,8 @@ (def-widget combo-box () ((items :accessor items :initarg :items :initform nil) - (items-factory :accessor items-factory :initarg :items-factory :initform #'(lambda (item) (format nil "~a" item))) + (items-factory :accessor items-factory :initarg :items-factory + :initform #'(lambda (item) (format nil "~a" item))) (init :accessor init :initarg :init :initform nil)) (active) (changed) Index: root/cells-gtk/tree-view.lisp diff -u root/cells-gtk/tree-view.lisp:1.2 root/cells-gtk/tree-view.lisp:1.3 --- root/cells-gtk/tree-view.lisp:1.2 Sun Dec 5 07:33:23 2004 +++ root/cells-gtk/tree-view.lisp Mon Dec 6 21:04:12 2004 @@ -102,7 +102,7 @@ (ff-defun-callable :cdecl :int tree-view-select-handler ((column-widget (* :void)) (event (* :void)) (data (* :void))) - (let ((tree-view (gtk-object-find column-widget))) + (let ((tree-view (gtk-object-find column-widget t))) (let ((cb (callback-recover tree-view :on-select))) (funcall cb tree-view column-widget event data)))) @@ -173,11 +173,10 @@ (ff-defun-callable :cdecl :int tree-view-render-call-callback ((tree-column (* :void)) (cell-renderer (* :void)) (tree-model (* :void)) (iter (* :void)) (data (* :void))) - (let ((self (gtk-object-find tree-column))) - (assert self) - (let ((cb (callback-recover self :render-cell))) - (assert cb () "No :render-cell callback for ~a" self) - (funcall cb tree-column cell-renderer tree-model iter data)))) + (let* ((self (gtk-object-find tree-column t)) + (cb (callback-recover self :render-cell))) + (assert cb () "No :render-cell callback for ~a" self) + (funcall cb tree-column cell-renderer tree-model iter data))) (def-c-output columns ((self tree-view)) (when new-value Index: root/cells-gtk/widgets.lisp diff -u root/cells-gtk/widgets.lisp:1.2 root/cells-gtk/widgets.lisp:1.3 --- root/cells-gtk/widgets.lisp:1.2 Sun Dec 5 07:33:23 2004 +++ root/cells-gtk/widgets.lisp Mon Dec 6 21:04:12 2004 @@ -52,37 +52,41 @@ (defun gtk-objects-init () (setf *gtk-objects* (make-hash-table :size 100 :rehash-size 100))) -(defun gtk-object-store (id gtk-object) +(defun gtk-object-store (gtk-id gtk-object &aux (hash-id (pointer-address gtk-id))) (unless *gtk-objects* (gtk-objects-init)) - (let ((known (gethash id *gtk-objects*))) + (let ((known (gethash hash-id *gtk-objects*))) (cond ((not known) - (setf (gethash id *gtk-objects*) gtk-object)) + (setf (gethash hash-id *gtk-objects*) gtk-object)) ((eql known gtk-object)) (t (break "gtk-object-store id ~a already known as ~a, not ~a" - id known gtk-object))))) + hash-id known gtk-object))))) -(defun gtk-object-forget (id gtk-object) +(defun gtk-object-forget (gtk-id gtk-object &aux (hash-id (pointer-address gtk-id))) (assert *gtk-objects*) - (let ((known (gethash id *gtk-objects*))) + (let ((known (gethash hash-id *gtk-objects*))) (cond ((not known)) ((eql known gtk-object) - (setf (gethash id *gtk-objects*) nil)) + (setf (gethash hash-id *gtk-objects*) nil)) (t (break "gtk-object-store id ~a known as ~a, not forgettable ~a" - id known gtk-object))))) + hash-id known gtk-object))))) #+shhh (maphash (lambda (k v) (print (list k v))) *gtk-objects*) -(defun gtk-object-find (id &optional must-find-p) +(defun gtk-object-find (gtk-id &optional must-find-p &aux (hash-id (pointer-address gtk-id))) (when *gtk-objects* - (let ((clos-widget (gethash id *gtk-objects*))) - (when must-find-p - (assert clos-widget)) + (let ((clos-widget (gethash hash-id *gtk-objects*))) + (when (and must-find-p (not clos-widget)) + (format t "~&gtk-object-find> ID ~a not found!!!!!!!" hash-id) + (maphash (lambda (key value) + (format t "~& known: ~a | ~a" key value)) + *gtk-objects*) + (break "gtk-object-find ID not found ~a" hash-id)) clos-widget))) ;; ----- fake callbackable closures ------------ @@ -112,11 +116,11 @@ (defmacro def-gtk-event-handler (event) `(ff-defun-callable :cdecl :int ,(intern (string-upcase (format nil "~a-handler" event))) - ((widget (* :void)) (event (* :void)) (data (* :void))) - (let ((self (gtk-object-find widget))) - (assert self) - (let ((cb (callback-recover self ,(intern (symbol-name event) :keyword)))) - (funcall cb self widget event data))))) + ((widget (* :void)) (event (* :void)) (data (* :void))) + (print (list :def-gtk-event-handler ,(symbol-name event))) + (let ((self (gtk-object-find widget t))) + (let ((cb (callback-recover self ,(intern (symbol-name event) :keyword)))) + (funcall cb self widget event data))))) (def-gtk-event-handler clicked) (def-gtk-event-handler toggled) @@ -203,8 +207,13 @@ ,@body t))) #-clisp `(lambda (self ,widg ,event ,data) - (declare (ignorable self ,widg ,event ,data)) - ,@body t)) + (declare (ignorable self ,widg ,event ,data)) + (print (list :callback self ,widg ,event ,data)) + (prog1 + (progn + ,@body + 1) ;; a boolean which indicates, IIRC, "handled" + #+shhh (print (list :callback-finis self ,widg ,event ,data))))) (defmacro callback-if (condition (widg event data) &body body) `(c? (and ,condition @@ -213,18 +222,22 @@ ,@body t)) #-clisp (lambda (self ,widg ,event ,data) (declare (ignorable self ,widg ,event ,data)) - ,@body t)))) + (print (list :callback self ,widg ,event ,data)) + ,@body + 1)))) (ff-defun-callable :cdecl :int timeout-handler-callback ((data (* :void))) + (print :timeout-handler-callback) (let ((id (elti data 0))) (gtk-global-callback-funcall id))) (defun timeout-add (milliseconds function) (let ((id (gtk-global-callback-register (lambda () - (with-gdk-threads - (funcall function))))) + (print :timeout-add-global) + (with-gdk-threads + (funcall function))))) (c-id (fgn-alloc :int 1))) (setf (elti c-id 0) id) (g-timeout-add milliseconds (ff-register-callable 'timeout-handler-callback) c-id)))

1 0

[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-button.lisp root/gtk-ffi/gtk-core.lisp root/gtk-ffi/gtk-list-tree.lisp root/gtk-ffi/gtk-menu.lisp root/gtk-ffi/gtk-other.lisp root/gtk-ffi/gtk-tool.lisp root/gtk-ffi/gtk-ffi.asd root/gtk-ffi/gtk-ffi.lisp root/gtk-ffi/gtk-ffi.lpr root/gtk-ffi/gtk-utilities.lisp root/gtk-ffi/gtk-lib-gtk.lisp
by ktilton＠common-lisp.net 06 Dec '04

06 Dec '04

Update of /project/cells-gtk/cvsroot/root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv25707/gtk-ffi Modified Files: gtk-ffi.asd gtk-ffi.lisp gtk-ffi.lpr gtk-utilities.lisp Added Files: gtk-button.lisp gtk-core.lisp gtk-list-tree.lisp gtk-menu.lisp gtk-other.lisp gtk-tool.lisp Removed Files: gtk-lib-gtk.lisp Log Message: Ongoing port to Lispworks Date: Mon Dec 6 21:03:00 2004 Author: ktilton Index: root/gtk-ffi/gtk-ffi.asd diff -u root/gtk-ffi/gtk-ffi.asd:1.3 root/gtk-ffi/gtk-ffi.asd:1.4 --- root/gtk-ffi/gtk-ffi.asd:1.3 Sun Dec 5 07:31:14 2004 +++ root/gtk-ffi/gtk-ffi.asd Mon Dec 6 21:03:00 2004 @@ -3,6 +3,10 @@ :depends-on (:cells :uffi :ffi-extender) :components ((:file "gtk-ffi") - (:file "gtk-definitions" :depends-on ("gtk-ffi")) - (:file "gtk-lib-gtk" :depends-on ("gtk-ffi")) - (:file "gtk-utilities" :depends-on ("gtk-definitions" "gtk-lib-gtk")))) \ No newline at end of file + (:file "gtk-core" :depends-on ("gtk-ffi")) + (:file "gtk-other" :depends-on ("gtk-ffi")) + (:file "gtk-button" :depends-on ("gtk-ffi")) + (:file "gtk-tool" :depends-on ("gtk-ffi")) + (:file "gtk-menu" :depends-on ("gtk-ffi")) + (:file "gtk-list-tree" :depends-on ("gtk-ffi")) + (:file "gtk-utilities" :depends-on ("gtk-core" "gtk-other")))) \ No newline at end of file Index: root/gtk-ffi/gtk-ffi.lisp diff -u root/gtk-ffi/gtk-ffi.lisp:1.3 root/gtk-ffi/gtk-ffi.lisp:1.4 --- root/gtk-ffi/gtk-ffi.lisp:1.3 Sun Dec 5 07:31:14 2004 +++ root/gtk-ffi/gtk-ffi.lisp Mon Dec 6 21:03:00 2004 @@ -23,6 +23,7 @@ (in-package :gtk-ffi) (defconstant c-null #+clisp nil #-clisp (make-null-pointer '(* void))) +(defconstant c-null-int #+clisp nil #-clisp (make-null-pointer :int)) (defvar *gtk-debug* nil) @@ -45,7 +46,7 @@ new-value)) (eval-when (:compile-toplevel :load-toplevel :execute) - (export '(c-null int-slot-indexed)) + (export '(c-null c-null-int int-slot-indexed)) (defun gtk-function-name (lisp-name) (substitute #\_ #\- lisp-name)) @@ -77,7 +78,7 @@ (c-ptr-null '*) (c-array-ptr '*) (c-ptr '*) - (c-string :pointer-void) + (c-string :cstring) (sint32 :int) (uint32 :unsigned-int) (uint8 :unsigned-byte) @@ -148,7 +149,7 @@ (if (eql return-type 'boolean) `(not (zerop ,bodyform)) bodyform)) - #+shhhh (print (list ,(symbol-name name) :after + (print (list ,(symbol-name name) :after ,@(mapcar 'car arguments))))) (eval-when (compile load eval) (export ',name)))))) Index: root/gtk-ffi/gtk-ffi.lpr diff -u root/gtk-ffi/gtk-ffi.lpr:1.1 root/gtk-ffi/gtk-ffi.lpr:1.2 --- root/gtk-ffi/gtk-ffi.lpr:1.1 Sun Dec 5 06:11:38 2004 +++ root/gtk-ffi/gtk-ffi.lpr Mon Dec 6 21:03:00 2004 @@ -8,6 +8,7 @@ :application-type (intern "Standard EXE" (find-package :keyword)) :modules (list (make-instance 'module :name "gtk-ffi.lisp") (make-instance 'module :name "gtk-definitions.lisp") + (make-instance 'module :name "gtk-lib-gtk.lisp") (make-instance 'module :name "gtk-utilities.lisp")) :projects (list (make-instance 'project-module :name "c:\\000000\\uffi\\uffi") Index: root/gtk-ffi/gtk-utilities.lisp diff -u root/gtk-ffi/gtk-utilities.lisp:1.1 root/gtk-ffi/gtk-utilities.lisp:1.2 --- root/gtk-ffi/gtk-utilities.lisp:1.1 Sun Dec 5 06:11:38 2004 +++ root/gtk-ffi/gtk-utilities.lisp Mon Dec 6 21:03:00 2004 @@ -16,9 +16,10 @@ |# + (in-package :gtk-ffi) -(defun gtk-signal-connect (widget signal fun &key (after t) data (destroy-data 0)) +(defun gtk-signal-connect (widget signal fun &key (after t) data destroy-data) (g-signal-connect-data widget signal fun data destroy-data after)) (defun g-signal-connect-data (self detailed-signal c-handler data destroy-data after) @@ -27,14 +28,16 @@ (g_signal_connect_data self c-detailed-signal - (or c-handler c-null) + (if c-handler + (uffi:make-pointer c-handler '(* :void)) + c-null) p4 (or destroy-data c-null) (if after 1 0))))) (uffi:def-function ("g_signal_connect_data" g_signal_connect_data) - ((instance (* :void)) (detailed-signal (* :void)) - (c-handler :long) (data (* :void))(destroy-data (* :void)) (after :int)) + ((instance (* :void)) (detailed-signal :cstring) + (c-handler (* :void)) (data (* :void))(destroy-data (* :void)) (after :int)) :returning :unsigned-long :call-direct nil) (defun gtk-signal-connect-swap (widget signal fun &key (after t) data destroy-data)

1 0