X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/7ecf52b3a8b7814e8d3301262e957d49bce61198..902760f593caa9da7e4a59d15a28446c87eade8a:/gtk/gtkobject.lisp diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp index 2444c08..0f40e66 100644 --- a/gtk/gtkobject.lisp +++ b/gtk/gtkobject.lisp @@ -20,7 +20,7 @@ ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -;; $Id: gtkobject.lisp,v 1.41 2007-05-10 20:13:42 espen Exp $ +;; $Id: gtkobject.lisp,v 1.44 2007-09-06 14:22:19 espen Exp $ (in-package "GTK") @@ -29,9 +29,7 @@ ;;;; Superclass for the gtk class hierarchy (eval-when (:compile-toplevel :load-toplevel :execute) - (init-types-in-library - #.(concatenate 'string (pkg-config:pkg-variable "gtk+-2.0" "libdir") - "/libgtk-x11-2.0." asdf:*dso-extension*)) + (init-types-in-library gtk "libgtk-2.0") (defclass %object (gobject) () @@ -82,6 +80,19 @@ #+clisp 0) +(define-callback fd-source-callback-marshal nil + ((callback-id unsigned-int) (fd unsigned-int)) + (glib::invoke-source-callback callback-id fd)) + +(defbinding (input-add "gtk_input_add_full") (fd condition function) unsigned-int + (fd unsigned-int) + (condition gdk:input-condition) + (fd-source-callback-marshal callback) + (nil null) + ((register-callback-function function) unsigned-long) + (user-data-destroy-callback callback)) + + ;;;; Metaclass for child classes (defvar *container-to-child-class-mappings* (make-hash-table)) @@ -245,3 +256,23 @@ (mapcar #'param-value-type (query-container-class-child-properties type))))) (register-derivable-type 'container "GtkContainer" 'expand-container-type 'container-dependencies) + + +(defmacro define-callback-setter (name arg return-type &rest rest-args) + (let ((callback (gensym))) + (if arg + `(progn + (define-callback-marshal ,callback ,return-type + ,(cons arg rest-args)) + (defbinding ,name () nil + ,arg + (,callback callback) + (function user-callback) + (user-data-destroy-callback callback))) + `(progn + (define-callback-marshal ,callback ,return-type ,rest-args) + (defbinding ,name () nil + (,callback callback) + (function user-callback) + (user-data-destroy-callback callback)))))) +