[cells-gtk-devel] container widget

Matthew Swank akopa.gmane.poster at gmail.com
Wed Jul 11 01:37:14 UTC 2007


This patch adds preliminary support for the container widget.
Feedback would be welcome.

Matt
-- 
"You do not really understand something unless you can
 explain it to your grandmother." - Albert Einstein.


Index: cells-gtk/buttons.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/cells-gtk/buttons.lisp,v
retrieving revision 1.6
diff -u -r1.6 buttons.lisp
--- cells-gtk/buttons.lisp	16 Feb 2006 18:10:10 -0000	1.6
+++ cells-gtk/buttons.lisp	11 Jul 2007 01:27:13 -0000
@@ -18,7 +18,7 @@
 
 (in-package :cgtk)
 
-(def-widget button ()
+(def-widget button (container)
   ((stock :accessor stock :initarg :stock :initform (c-in nil))
    (markup :accessor markup :initarg :markup :initform nil)
    (label :accessor label :initarg :label :initform (c-in nil)))
Index: cells-gtk/layout.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/cells-gtk/layout.lisp,v
retrieving revision 1.10
diff -u -r1.10 layout.lisp
--- cells-gtk/layout.lisp	11 Aug 2006 13:07:55 -0000	1.10
+++ cells-gtk/layout.lisp	11 Jul 2007 01:27:14 -0000
@@ -18,7 +18,7 @@
 
 (in-package :cgtk)
 
-(def-widget box ()
+(def-widget box (container)
   ()
   (homogeneous spacing)
   ()
@@ -40,7 +40,7 @@
   () () ()
   :new-args (c? (list (homogeneous self) (spacing self))))
 
-(def-widget table ()
+(def-widget table (container)
   ((elements :accessor elements :initarg :elements :initform (c-in nil))
    (homogeneous :accessor homogeneous :initarg :homogeneous :initform nil)
    (rows-count :accessor rows-count :initarg :rows-count :initform (c? (length (elements self))))
@@ -116,7 +116,7 @@
   #+clisp (call-next-method))
   
 
-(def-widget frame ()
+(def-widget frame (container)
   ((shadow :accessor shadow? :initarg :shadow :initform nil)
    (label :accessor label :initarg :label :initform (c-in nil)))
   (label-widget label-align shadow-type)
@@ -163,7 +163,7 @@
 (def-widget vseparator ()
   () () ())
 
-(def-widget expander ()
+(def-widget expander (container)
   ((label :accessor label :initarg :label :initform (c-in nil)))
   (expanded spacing use-underline use-markup label-widget)
   ()
@@ -179,7 +179,7 @@
     (gtk-container-add (id self) (id kid)))
   #+clisp (call-next-method))
 
-(def-widget scrolled-window ()
+(def-widget scrolled-window (container)
   ()
   (policy placement shadow-type)
   ()
@@ -195,7 +195,7 @@
 	(gtk-scrolled-window-add-with-viewport (id self) (id kid))))
   #+clisp (call-next-method))
 
-(def-widget notebook ()
+(def-widget notebook (container)
   ((tab-labels :accessor tab-labels :initarg :tab-labels :initform (c-in nil))
    (tab-labels-widgets :accessor tab-labels-widgets :initform (c-in nil))
    (show-page :accessor show-page :initarg :show-page :initform (c-in 0))
@@ -251,7 +251,7 @@
 (def-c-output show-border ((self notebook))
  (gtk-notebook-set-show-border (id self) new-value))
 
-(def-widget alignment ()
+(def-widget alignment (container)
   ((xalign :accessor xalign :initarg :xalign :initform 0.5)
    (yalign :accessor yalign :initarg :yalign :initform 0.5)
    (xscale :accessor xscale :initarg :xscale :initform 0)
Index: cells-gtk/menus.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/cells-gtk/menus.lisp,v
retrieving revision 1.16
diff -u -r1.16 menus.lisp
--- cells-gtk/menus.lisp	11 Aug 2006 13:07:55 -0000	1.16
+++ cells-gtk/menus.lisp	11 Jul 2007 01:27:14 -0000
@@ -27,7 +27,7 @@
 ;;; ============= Combo-box ============================
 ;;; User should specify exactly one of :items or :roots 
 ;;; If specify :roots, specify :children-fn too.
-(def-widget combo-box ()
+(def-widget combo-box (container)
   ((items :accessor items :initarg :items :initform nil)
    (print-fn :accessor print-fn :initarg :print-fn
      :initform #'(lambda (item) (format nil "~a" item))) ; see below if :roots
@@ -110,7 +110,7 @@
 (def-object tooltips ()
   () () ())
 
-(def-widget toolbar ()
+(def-widget toolbar (container)
   ((orientation :accessor orientation :initarg :orientation :initform (c-in nil))
    (style :accessor style :initarg :style :initform (c-in nil)))
   (show-arrow tooltips)
@@ -141,7 +141,7 @@
 	    (:both-horiz 3)
 	    (t 0)))))
 
-(def-widget tool-item ()
+(def-widget tool-item (container)
   ()
   (homogeneous expand is-important)
   ())
@@ -188,7 +188,7 @@
     (setf (stock-id self) (string-downcase (format nil "gtk-~a" new-value)))))
 
 ;;; ============= Menu ============================	
-(def-widget menu-shell ()
+(def-widget menu-shell (container)
   () () ()
   :padding 0)
 
@@ -206,7 +206,7 @@
   (title)
   ())
 
-(def-widget menu-item ()
+(def-widget menu-item (item)
   ((label :accessor label :initarg :label :initform (c-in nil))
    (label-widget :accessor label-widget :initarg :label-widget :initform nil)
    (accel-label-widget :accessor accel-label-widget :initform (c? (and (label self)
Index: cells-gtk/textview.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/cells-gtk/textview.lisp,v
retrieving revision 1.11
diff -u -r1.11 textview.lisp
--- cells-gtk/textview.lisp	19 Feb 2007 17:08:21 -0000	1.11
+++ cells-gtk/textview.lisp	11 Jul 2007 01:27:14 -0000
@@ -35,7 +35,7 @@
     ;; It can even reset it, if you don't like this arrangement.
     (gtk-text-buffer-set-modified buf nil)))
 
-(def-widget text-view ()
+(def-widget text-view (container)
   ((buffer :accessor buffer :initarg :buffer :initform (mk-text-buffer))
    (populate-popup :accessor populate-popup :initarg :populate-popup :initform (c-in nil))
    (depopulate-popup :accessor depopulate-popup :initarg :depopulate-popup :initform (c-in nil))
Index: cells-gtk/tree-view.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/cells-gtk/tree-view.lisp,v
retrieving revision 1.17
diff -u -r1.17 tree-view.lisp
--- cells-gtk/tree-view.lisp	11 Aug 2006 13:09:28 -0000	1.17
+++ cells-gtk/tree-view.lisp	11 Jul 2007 01:27:14 -0000
@@ -37,7 +37,7 @@
 
 (defun fail (&rest args) (declare (ignore args)) nil)
 
-(def-widget tree-view ()
+(def-widget tree-view (container)
   ((columns-def :accessor columns-def :initarg :columns :initform nil)
    (column-types :accessor column-types :initform (c? (mapcar #'first (columns-def self))))
    (column-inits :accessor  column-inits :initform (c? (mapcar #'second (columns-def self))))
Index: cells-gtk/widgets.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp,v
retrieving revision 1.19
diff -u -r1.19 widgets.lisp
--- cells-gtk/widgets.lisp	7 Jun 2006 16:50:15 -0000	1.19
+++ cells-gtk/widgets.lisp	11 Jul 2007 01:27:15 -0000
@@ -309,7 +309,17 @@
 	  ()
 	  "~a is a bin container, must have only one kid" container))
 
-(def-widget window ()
+(def-widget container ()
+  ()
+  (border-width resize-mode)
+  ())
+
+(def-widget item (container)
+  ()
+  ()
+  ())
+
+(def-widget window (container)
   ((wintype :accessor wintype :initarg wintype :initform 0)
    (title :accessor title :initarg :title
      :initform (c? (string (class-name (class-of self)))))
@@ -368,7 +378,7 @@
     (gtk-container-add (id self) (id kid)))
   #+clisp (call-next-method))
 
-(def-widget event-box ()
+(def-widget event-box (container)
   ((visible-window :accessor visible-window :initarg :visible-window :initform nil))
   (above-child)
   ()
Index: gtk-ffi/gtk-other.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/gtk-ffi/gtk-other.lisp,v
retrieving revision 1.13
diff -u -r1.13 gtk-other.lisp
--- gtk-ffi/gtk-other.lisp	16 Feb 2006 18:06:06 -0000	1.13
+++ gtk-ffi/gtk-other.lisp	11 Jul 2007 01:27:16 -0000
@@ -42,7 +42,16 @@
   (gtk-container-remove :void
 			((container :pointer)
 			 (widget :pointer)))
-
+  (gtk-container-set-border-width :void
+				  ((container :pointer)
+				   (width :unsigned-int)))
+  (gtk-container-get-border-width :unsigned-int
+				  ((container :pointer)))
+  (gtk-container-set-resize-mode :void
+				  ((container :pointer)
+				   (mode :unsigned-int)))
+  (gtk-container-get-resize-mode :unsigned-int
+				  ((container :pointer)))
   ;;box
   (gtk-box-pack-start :void
 		      ((box :pointer)





More information about the cells-gtk-devel mailing list