[cells-gtk-cvs] CVS update: root/cells-gtk/layout.lisp

[Peter Denno]

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp.net:/tmp/cvs-serv29248/root/cells-gtk

Modified Files:
	layout.lisp 
Log Message:
Stuff for divider position and checking whether page already is displayed (or something like that).
Date: Tue Jan  3 19:58:55 2006
Author: pdenno

Index: root/cells-gtk/layout.lisp
diff -u root/cells-gtk/layout.lisp:1.5 root/cells-gtk/layout.lisp:1.6
--- root/cells-gtk/layout.lisp:1.5	Sun May 29 23:08:22 2005
+++ root/cells-gtk/layout.lisp	Tue Jan  3 19:58:54 2006
@@ -76,7 +76,13 @@
 				(y-pad kid))))))
 
 (def-widget hpaned ()
-  () () ())
+  ((divider-pos :accessor divider-pos :initarg :divider-pos :initform (c-in 0)))
+  ()
+  ())
+
+(def-c-output divider-pos ((self hpaned))
+  (when new-value
+    (gtk-paned-set-position (id self) new-value)))
 
 (def-c-output .kids ((self hpaned))
   (when new-value
@@ -90,7 +96,13 @@
   #+clisp (call-next-method))
 
 (def-widget vpaned ()
-  () () ())
+  ((divider-pos :accessor divider-pos :initarg :divider-pos :initform (c-in 0)))
+  ()
+  ())
+
+(def-c-output divider-pos ((self vpaned))
+  (when new-value
+    (gtk-paned-set-position (id self) new-value)))
 
 (def-c-output .kids ((self vpaned))
   (when new-value
@@ -184,7 +196,7 @@
   #+clisp (call-next-method))
 
 (def-widget notebook ()
-  ((tab-labels :accessor tab-labels :initarg :tab-labels :initform nil)
+  ((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))
    (tab-pos :accessor tab-pos :initarg :tab-pos :initform (c-in nil)))
@@ -205,16 +217,22 @@
        (:bottom 3)
        (t 2)))))
 
+(defun notebook-contains-page-p (notebook widget &aux (wid (pointer-address (id widget))))
+  (loop for i from 1 to (gtk-notebook-get-n-pages (id notebook))
+	for page = (gtk-notebook-get-nth-page (id notebook) (1- i))
+	when (= wid (pointer-address page)) return t))
+
 (def-c-output show-page ((self notebook))
   (when (and new-value (>= new-value 0) (< new-value (length (kids self))))
     (setf (current-page self) new-value)))
     
 (def-c-output .kids ((self notebook))
-  (dolist (widget (tab-labels-widgets self))
-    (not-to-be widget))
+  ;(dolist (widget (tab-labels-widgets self)) ;; This was from the original code. 
+  ;      (not-to-be widget))                  ;; It causes errors. 
   (loop for kid in new-value
 	for pos from 0
-	for label = (nth pos (tab-labels self)) do
+	for label = (nth pos (tab-labels self)) 
+	unless (notebook-contains-page-p self kid) do
 	(let ((lbl (and label (make-be 'label :text label))))
 	  (when lbl (push lbl (tab-labels-widgets self)))
 	  (gtk-notebook-append-page (id self) (id kid) (and lbl (id lbl)))))