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)))))