+
+
+;;; Builder
+
+#?(pkg-exists-p "gtk+-2.0" :atleast-version "2.12.0")
+(progn
+ (defmethod initialize-instance ((builder builder) &key interface
+ (connect-signals t) (package *package*))
+ (call-next-method)
+ (etypecase interface
+ (null)
+ (string (builder-add-from-string builder interface))
+ (pathname (builder-add-from-file builder interface)))
+ (when connect-signals
+ (builder-connect-signals builder package)))
+
+
+ (defbinding builder-add-from-file () boolean
+ builder
+ pathname
+ (nil gerror-signal :out))
+
+ (defbinding builder-add-from-string () boolean
+ builder
+ (buffer string)
+ (-1 int) ; TODO: add gsize type
+ (nil gerror-signal :out))
+
+ (defbinding builder-get-object () gobject
+ builder
+ (name string))
+
+ (defbinding builder-get-objects () (gslist gobject)
+ builder)
+
+ (defun intern-with-package-prefix (name default-package)
+ (let ((pos (position #\: name)))
+ (if pos
+ (intern
+ (string-upcase (subseq name (1+ pos)))
+ (string-upcase (subseq name 0 pos)))
+ (intern (string-upcase name) default-package))))
+
+ (define-callback %builder-connect-function nil
+ (builder (object gobject) (signal-name string) (handler-name string)
+ (connect-object gobject) connect-flags (package user-data-id))
+ (format t "Connect signal ~A for ~A to ~A in default package ~A with flags ~A~%" signal-name object handler-name (find-user-data package) connect-flags)
+ (signal-connect
+ object signal-name
+ (intern-with-package-prefix handler-name (find-user-data package))
+ :object (or connect-object object) :after (find :after connect-flags)))
+
+ (defbinding %builder-connect-signals-full (builder package) nil
+ builder
+ (%builder-connect-function callback)
+ (package user-data-id))
+
+ (defun builder-connect-signals (builder &optional (package *package*))
+ (with-user-data (id package)
+ (%builder-connect-signals-full builder id))))
+