This patch  adds current-pos slot in combo-box model.
This allows to set and get current position in flat model.
Index: cells-gtk/menus.lisp
===================================================================
RCS file: /project/cells-gtk/cvsroot/root/cells-gtk/menus.lisp,v
retrieving revision 1.14
diff -u -r1.14 menus.lisp
--- cells-gtk/menus.lisp        7 Jun 2006 16:41:38 -0000       1.14
+++ cells-gtk/menus.lisp        31 Jul 2006 00:12:02 -0000
@@ -34,7 +34,8 @@
    (init :accessor init :initarg :init :initform nil)
    (roots :accessor roots :initarg :roots :initform nil)
    (children-fn :accessor children-fn :initarg :children-fn :initform 
#'(lambda (x) (declare (ignore x)) nil))
-   (tree-model :cell nil :accessor tree-model :initform nil))
+   (tree-model :cell nil :accessor tree-model :initform nil)
+   (current-pos :accessor current-pos :initarg :current-pos :initform (c-in 
nil)))
   (active)
   (changed)
   :new-tail '-text
@@ -46,7 +47,8 @@
        (let ((pos (gtk-combo-box-get-active (id self))))
          ;;(trc nil "combo-box pos" pos)
          (setf (md-value self) (and (not (= pos -1))
-                                    (nth pos (items self)))))
+                                    (nth pos (items self))))
+         (setf (current-pos self) pos))
       ;; non-flat tree-model (:roots specified)
       (with-tree-iters (iter)
         (when (gtk-combo-box-get-active-iter (id self) iter)
@@ -57,6 +59,9 @@
                 (read-from-string
                  (gtk-tree-model-get-cell (id (tree-model self)) iter 1 
:string)))))))))
 
+(def-c-output current-pos ((self combo-box))
+  (when new-value (gtk-combo-box-set-active (id self) new-value)))
+
 ;;; When user specifies :roots, he is using a tree-model.
 ;;; POD There is probably no reason he has to use :strings for the "columns"
 (def-c-output roots ((self combo-box))
_______________________________________________
cells-gtk-devel site list
[email protected]
http://common-lisp.net/mailman/listinfo/cells-gtk-devel

Reply via email to