;; 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.39 2006/09/05 13:23:40 espen Exp $
+;; $Id: gtkobject.lisp,v 1.43 2007/06/25 13:56:56 espen Exp $
(in-package "GTK")
;;;; 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)
()
#+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))
value))))
-(defmethod add-reader-method ((class container-child-class) generic-function slot-name)
+(defmethod add-reader-method ((class container-child-class) generic-function slot-name #?(sbcl>= 1 0 2)slot-documentation)
(add-method
generic-function
(make-instance 'standard-method
:specializers (list (find-class 'widget))
:lambda-list '(widget)
+ :documentation (or #?(sbcl>= 1 0 2)slot-documentation "automatically generated reader method")
:function #'(lambda (args next-methods)
(declare (ignore next-methods))
(child-property-value (first args) slot-name)))))
-(defmethod add-writer-method ((class container-child-class) generic-function slot-name)
+(defmethod add-writer-method ((class container-child-class) generic-function slot-name #?(sbcl>= 1 0 2)slot-documentation)
(add-method
generic-function
(make-instance 'standard-method
:specializers (list (find-class t) (find-class 'widget))
:lambda-list '(value widget)
+ :documentation (or #?(sbcl>= 1 0 2)slot-documentation "automatically generated reader method")
:function #'(lambda (args next-methods)
(declare (ignore next-methods))
(destructuring-bind (value widget) args
(defun container-child-class (container-class)
(gethash container-class *container-to-child-class-mappings*))
-(register-derivable-type 'container "GtkContainer" 'expand-container-type 'gobject-dependencies)
+(defun container-dependencies (type options)
+ (delete-duplicates
+ (append
+ (gobject-dependencies type options)
+ (mapcar #'param-value-type (query-container-class-child-properties type)))))
+
+(register-derivable-type 'container "GtkContainer" 'expand-container-type 'container-dependencies)