[cells-gtk-cvs] CVS update: root/gtk-ffi/gtk-ffi.asd root/gtk-ffi/gtk-ffi.lisp root/gtk-ffi/gtk-ffi.lpr root/gtk-ffi/gtk-menu.lisp root/gtk-ffi/gtk-other.lisp root/gtk-ffi/gtk-utilities.lisp
Kenny Tilton
ktilton at common-lisp.net
Tue Dec 14 04:02:12 UTC 2004
Update of /project/cells-gtk/cvsroot/root/gtk-ffi
In directory common-lisp.net:/tmp/cvs-serv11104/gtk-ffi
Modified Files:
gtk-ffi.asd gtk-ffi.lisp gtk-ffi.lpr gtk-menu.lisp
gtk-other.lisp gtk-utilities.lisp
Log Message:
Locking in fixes which make AllegroCL and Lispworks largely work OK before trashing code again.
Date: Tue Dec 14 05:02:05 2004
Author: ktilton
Index: root/gtk-ffi/gtk-ffi.asd
diff -u root/gtk-ffi/gtk-ffi.asd:1.4 root/gtk-ffi/gtk-ffi.asd:1.5
--- root/gtk-ffi/gtk-ffi.asd:1.4 Mon Dec 6 21:03:00 2004
+++ root/gtk-ffi/gtk-ffi.asd Tue Dec 14 05:02:05 2004
@@ -1,6 +1,6 @@
(asdf:defsystem :gtk-ffi
:name "gtk-ffi"
- :depends-on (:cells :uffi :ffi-extender)
+ :depends-on (:cells :hello-c)
:components
((:file "gtk-ffi")
(:file "gtk-core" :depends-on ("gtk-ffi"))
Index: root/gtk-ffi/gtk-ffi.lisp
diff -u root/gtk-ffi/gtk-ffi.lisp:1.4 root/gtk-ffi/gtk-ffi.lisp:1.5
--- root/gtk-ffi/gtk-ffi.lisp:1.4 Mon Dec 6 21:03:00 2004
+++ root/gtk-ffi/gtk-ffi.lisp Tue Dec 14 05:02:05 2004
@@ -126,8 +126,7 @@
collect `(if ,(car arg) 1 0) into pass-args
else if (eql 'c-pointer (cadr arg))
collect `(or ,(car arg) c-null) into pass-args
- else
- collect (car arg) into pass-args
+ else collect (car arg) into pass-args
finally (return (list (mapcar 'list gsyms arg$s)
pass-args)))))
`(progn
@@ -149,8 +148,9 @@
(if (eql return-type 'boolean)
`(not (zerop ,bodyform))
bodyform))
- (print (list ,(symbol-name name) :after
- ,@(mapcar 'car arguments)))))
+ (when *gtk-debug*
+ (print (list ,(symbol-name name) :after
+ ,@(mapcar 'car arguments))))))
(eval-when (compile load eval)
(export ',name))))))
@@ -305,6 +305,10 @@
(type long)
(val double-float)
(val2 double-float))
+
+(def-c-struct gslist
+ (data c-pointer)
+ (next c-pointer))
(def-c-struct gtk-tree-iter
(stamp int)
Index: root/gtk-ffi/gtk-ffi.lpr
diff -u root/gtk-ffi/gtk-ffi.lpr:1.2 root/gtk-ffi/gtk-ffi.lpr:1.3
--- root/gtk-ffi/gtk-ffi.lpr:1.2 Mon Dec 6 21:03:00 2004
+++ root/gtk-ffi/gtk-ffi.lpr Tue Dec 14 05:02:05 2004
@@ -7,13 +7,15 @@
(define-project :name :gtk-ffi
: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-core.lisp")
+ (make-instance 'module :name "gtk-button.lisp")
+ (make-instance 'module :name "gtk-list-tree.lisp")
+ (make-instance 'module :name "gtk-menu.lisp")
+ (make-instance 'module :name "gtk-tool.lisp")
+ (make-instance 'module :name "gtk-other.lisp")
(make-instance 'module :name "gtk-utilities.lisp"))
:projects (list (make-instance 'project-module :name
- "c:\\000000\\uffi\\uffi")
- (make-instance 'project-module :name
- "c:\\cell-cultures\\ffi-extender\\ffi-extender"))
+ "c:\\cell-cultures\\hello-c\\hello-c"))
:libraries nil
:distributed-files nil
:project-package-name :gtk-ffi
Index: root/gtk-ffi/gtk-menu.lisp
diff -u root/gtk-ffi/gtk-menu.lisp:1.1 root/gtk-ffi/gtk-menu.lisp:1.2
--- root/gtk-ffi/gtk-menu.lisp:1.1 Mon Dec 6 21:03:00 2004
+++ root/gtk-ffi/gtk-menu.lisp Tue Dec 14 05:02:05 2004
@@ -18,6 +18,17 @@
(in-package :gtk-ffi)
+(def-gtk-function :gtk gtk-check-menu-item-set-active :arguments
+ ((check-menu c-pointer) (active boolean))
+ :return-type nil :call-direct t)
+
+#+test
+(def-gtk-lib-functions :gtk
+ (gtk-check-menu-item-set-active ((check-menu c-pointer)
+ (active boolean))))
+
+
+
(def-gtk-lib-functions :gtk
;;menu
(gtk-menu-shell-append ((menu-shell c-pointer)
@@ -76,7 +87,7 @@
c-pointer)
(gtk-check-menu-item-new-with-label ((label c-string))
c-pointer)
- (gtk-check-menu-item-set-active ((check-menu c-pointer)
+ #+above (gtk-check-menu-item-set-active ((check-menu c-pointer)
(active boolean)))
(gtk-check-menu-item-get-active ((check-menu c-pointer))
boolean)
Index: root/gtk-ffi/gtk-other.lisp
diff -u root/gtk-ffi/gtk-other.lisp:1.1 root/gtk-ffi/gtk-other.lisp:1.2
--- root/gtk-ffi/gtk-other.lisp:1.1 Mon Dec 6 21:03:00 2004
+++ root/gtk-ffi/gtk-other.lisp Tue Dec 14 05:02:05 2004
@@ -18,6 +18,7 @@
(in-package :gtk-ffi)
+
(def-gtk-lib-functions :gtk
;; main-loop
(gtk-init ((argc (c-ptr-null int))
Index: root/gtk-ffi/gtk-utilities.lisp
diff -u root/gtk-ffi/gtk-utilities.lisp:1.2 root/gtk-ffi/gtk-utilities.lisp:1.3
--- root/gtk-ffi/gtk-utilities.lisp:1.2 Mon Dec 6 21:03:00 2004
+++ root/gtk-ffi/gtk-utilities.lisp Tue Dec 14 05:02:05 2004
@@ -20,6 +20,7 @@
(in-package :gtk-ffi)
(defun gtk-signal-connect (widget signal fun &key (after t) data destroy-data)
+ #+shhtk (print (list "passing fun to gtk-signal-connect" signal fun))
(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)
@@ -28,9 +29,7 @@
(g_signal_connect_data
self
c-detailed-signal
- (if c-handler
- (uffi:make-pointer c-handler '(* :void))
- c-null)
+ (wrap-func c-handler)
p4
(or destroy-data c-null)
(if after 1 0)))))
@@ -40,9 +39,17 @@
(c-handler (* :void)) (data (* :void))(destroy-data (* :void)) (after :int))
:returning :unsigned-long :call-direct nil)
+(defun wrap-func (func-address)
+ (or func-address 0)
+ ;;(assert (or (null func-address) (numberp func-address)))
+ #+nahh
+ (if func-address
+ (uffi:make-pointer func-address '(* :void))
+ c-null))
+
(defun gtk-signal-connect-swap (widget signal fun &key (after t) data destroy-data)
(g-signal-connect-closure widget signal
- (g-cclosure-new-swap fun data destroy-data) after))
+ (g-cclosure-new-swap (wrap-func fun) data destroy-data) after))
(defun gtk-object-set-property (obj property val-type val)
(with-g-value (value)
@@ -85,7 +92,9 @@
(defun gtk-widget-set-popup (widget menu)
(gtk-signal-connect-swap widget "button-press-event"
- (ffx:ff-register-callable 'button-press-event-handler)
+ (let ((cbl (ffx:ff-register-callable 'button-press-event-handler)))
+ #+shhtk (print (list "gtk-widget-set-popup connecting callable" widget cbl))
+ cbl)
:data menu))
(defun gtk-list-store-new (col-types)
@@ -160,7 +169,7 @@
for type in types-lst
for str-ptr = (when (find type '(:string :icon))
(to-gtk-string data))
- do (print (list value type (as-gtk-type type)))
+ do (print (list :tree-store-set value type (as-gtk-type type)))
(g-value-init value (as-gtk-type type))
(funcall (intern (format nil "G-VALUE-SET-~a" (case type
(:date 'float)
More information about the Cells-gtk-cvs
mailing list