From fa60e0a229ccf07429187357b2c2dee1b189c5a4 Mon Sep 17 00:00:00 2001 From: espen Date: Tue, 22 Feb 2005 23:12:02 +0000 Subject: [PATCH] Misc required changes --- gtk/gtktypes.lisp | 20 ++++++-------------- gtk/gtkwidget.lisp | 40 ++++++++++++++++++++++------------------ 2 files changed, 28 insertions(+), 32 deletions(-) diff --git a/gtk/gtktypes.lisp b/gtk/gtktypes.lisp index c36d2c5..8d4eed0 100644 --- a/gtk/gtktypes.lisp +++ b/gtk/gtktypes.lisp @@ -15,8 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gtktypes.lisp,v 1.31 2005-02-04 13:15:14 espen Exp $ - +;; $Id: gtktypes.lisp,v 1.32 2005-02-22 23:12:02 espen Exp $ (in-package "GTK") @@ -133,15 +132,6 @@ (declare (ignore type args)) (reader-function 'int)) -;; Forward definitions -(defclass widget (%object) - () - (:metaclass gobject-class)) -(defclass container (widget) - () - (:metaclass gobject-class)) - - (define-types-by-introspection "Gtk" ;; Manually defined ("GtkObject" :ignore t) @@ -163,6 +153,10 @@ :getter "gtk_widget_get_window" :reader widget-window :type gdk:window) + (parent + :allocation :property :pname "parent" + :reader widget-parent + :type container) (parent-window :allocation :virtual :getter %widget-parent-window @@ -1030,9 +1024,7 @@ ;; What are these? ("GtkFileSystemModule" :ignore t) ("GtkIMModule" :ignore t) - ("GtkThemeEngine" :ignore t) - - ) + ("GtkThemeEngine" :ignore t)) (defclass text-iter (boxed) diff --git a/gtk/gtkwidget.lisp b/gtk/gtkwidget.lisp index 7f9aa5c..f7dad25 100644 --- a/gtk/gtkwidget.lisp +++ b/gtk/gtkwidget.lisp @@ -15,27 +15,27 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gtkwidget.lisp,v 1.15 2005-01-12 13:51:02 espen Exp $ +;; $Id: gtkwidget.lisp,v 1.16 2005-02-22 23:12:06 espen Exp $ (in-package "GTK") -(defmethod shared-initialize ((widget widget) names &rest initargs &key parent) - (remf initargs :parent) - (prog1 - (apply #'call-next-method widget names initargs) - (when parent - (when (slot-boundp widget 'parent) - (container-remove (widget-parent widget) widget)) - (let ((parent-widget (first (mklist parent))) - (args (rest (mklist parent)))) - (apply #'container-add parent-widget widget args))))) +(defmethod shared-initialize ((widget widget) names &key (visible nil visible-p)) + (when (and visible-p (not visible)) ; widget explicit set as not visible + (setf (user-data widget 'hidden-p) t) + (signal-connect widget 'show + #'(lambda () + (unset-user-data widget 'hidden-p)) + :remove t)) + (call-next-method)) -(defmethod shared-initialize :after ((widget widget) names &rest initargs - &key show-all all-visible) - (declare (ignore initargs names)) - (when (or all-visible show-all) - (widget-show-all widget))) +(defmethod shared-initialize :after ((widget widget) names &key parent) + (declare (ignore names)) + (when parent + (when (slot-boundp widget 'parent) + (container-remove (widget-parent widget) widget)) + (destructuring-bind (parent &rest args) (mklist parent) + (apply #'container-add parent widget args)))) (defmethod slot-unbound ((class gobject-class) (object widget) (slot (eql 'child-properties))) @@ -55,8 +55,8 @@ (slot-boundp object 'parent)) (call-next-method))) -(defmethod create-callback-function ((widget widget) function arg1) - (if (eq arg1 :parent) +(defmethod compute-signal-function ((widget widget) signal function object) + (if (eq object :parent) #'(lambda (&rest args) (if (slot-boundp widget 'parent) (apply function (widget-parent widget) (rest args)) @@ -101,6 +101,10 @@ (defbinding widget-hide () nil (widget widget)) +(defun widget-hidden-p (widget) + "Return T if WIDGET has been explicit hidden during construction." + (user-data widget 'hidden-p)) + (defbinding widget-show-all () nil (widget widget)) -- 2.11.0