X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/c3721a64d3c6f7e491e186dbb8ef8ceb7a1f84fb..b4f60db71841677abd1c0fb6b3afd94b5b7370e2:/gtk/gtkobject.lisp

diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp
index ae7f422..6171c5b 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.43 2007-06-25 13:56:56 espen Exp $
+;; $Id: gtkobject.lisp,v 1.45 2008-02-28 18:33:12 espen Exp $
 
 
 (in-package "GTK")
@@ -181,7 +181,7 @@
 	  value))))
 
 
-(defmethod add-reader-method ((class container-child-class) generic-function slot-name #?(sbcl>= 1 0 2)slot-documentation)
+(defmethod add-reader-method ((class container-child-class) generic-function slot-name #?(sbcl>= 1 0 2)slot-documentation #?(sbcl>= 1 0 14)source-location)
   (add-method
    generic-function
    (make-instance 'standard-method
@@ -192,7 +192,7 @@
 		  (declare (ignore next-methods))
 		  (child-property-value (first args) slot-name)))))
 
-(defmethod add-writer-method ((class container-child-class) generic-function slot-name #?(sbcl>= 1 0 2)slot-documentation)
+(defmethod add-writer-method ((class container-child-class) generic-function slot-name #?(sbcl>= 1 0 2)slot-documentation #?(sbcl>= 1 0 14)source-location)
   (add-method
    generic-function
    (make-instance 'standard-method
@@ -256,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))))))
+