X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/f5c99598e1a12d82a1e3223d4fdc90b3ceb144ad..3494da2a2fe7551426d4fbdbce7dc21200423772:/gtk/gtkwidget.lisp diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp index 64aabe4..100b0e2 100644 --- a/gtk/gtkwidget.lisp +++ b/gtk/gtkwidget.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: gtkwidget.lisp,v 1.28 2007-06-20 10:20:47 espen Exp $ +;; $Id: gtkwidget.lisp,v 1.30 2008-04-11 18:42:40 espen Exp $ (in-package "GTK") @@ -60,8 +60,7 @@ (defmethod slot-unbound ((class gobject-class) (object widget) ((slot-boundp object 'parent) (with-slots (parent child-properties) object (setf child-properties - (make-instance - (gethash (class-of parent) *container-to-child-class-mappings*) + (make-instance (find-child-class (class-of parent)) :parent parent :child object)))) ((call-next-method)))) @@ -525,9 +524,21 @@ (defbinding widget-remove-mnemonic-label () nil ;;; Additional bindings and functions -(defbinding (widget-mapped-p "gtk_widget_mapped_p") () boolean +(defbinding %widget-flags () int (widget widget)) +(defun widget-flags (widget) + (let ((flags (%widget-flags widget))) + (nconc + (int-to-object-flags flags) + (int-to-widget-flags flags)))) + +(defun widget-mapped-p (widget) + (find :mapped (widget-flags widget))) + +(defun widget-realized-p (widget) + (find :realized (widget-flags widget))) + (defbinding widget-get-size-allocation () nil (widget widget) (width int :out)