Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv17778/Backends/gtkairo
Modified Files: event.lisp frame-manager.lisp gadgets.lisp gtk-ffi.lisp Log Message:
Native list panes.
* event.lisp (VIEW-SELECTION-CALLBACK): New. * frame-manager.lisp ((MAKE-PANE-2 GENERIC-LIST-PANE)): New. * gadgets.lisp (GTK-LIST, LIST-SELECTION-EVENT, +G-TYPE-STRING+, UNINSTALL-SCROLLER-PANE, LIST-PANE-SELECTION, (REALIZE-NATIVE-WIDGET GTK-LIST), GTK-LIST-SELECT-VALUE, GTK-LIST-RESET-SELECTION, ((SETF GADGET-VALUE) GTK-LIST), (CONNECT-NATIVE-SIGNALS GTK-LIST), *LIST-SELECTION-RESULT*, LIST-SELECTION-CALLBACK, (HANDLE-EVENT LIST-SELECTION-EVENT)): New.
* gtk-ffi.lisp (gtktreeiter, gvalue): New structs. (gtkselectionmode): New enum. (gtk_tree_view_new_with_model, gtk_list_store_newv, gtk_list_store_append, gtk_list_store_set_value, g_value_init, g_value_set_string, gtk_cell_renderer_text_new, gtk_tree_view_column_new, gtk_tree_view_column_get_widget, gtk_tree_view_column_set_widget, gtk_tree_view_column_pack_start, gtk_tree_view_insert_column, gtk_tree_view_column_add_attribute, gtk_tree_view_column_set_title, gtk_scrolled_window_new, gtk_tree_view_get_hadjustment, gtk_tree_view_get_vadjustment, gtk_tree_view_get_selection, gtk_tree_selection_set_mode, gtk_tree_selection_unselect_all, gtk_tree_selection_select_path, gtk_tree_path_new_from_indices, gtk_tree_path_free, gtk_tree_selection_set_select_function, gtk_tree_path_get_indices, gtk_tree_selection_selected_foreach): New declarations.
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/11/12 13:46:08 1.12 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/11/12 20:12:19 1.13 @@ -411,3 +411,15 @@ (remhash data *later-table*) (funcall fun)) 0) + +(cffi:defcallback view-selection-callback :int + ((selection :pointer) + (model :pointer) + (path :pointer) + (isselected :int) + (data :pointer)) + selection model path isselected + (when (boundp '*port*) ;kludge + (let ((sheet (widget->sheet data *port*))) + (enqueue (make-instance 'list-selection-event :sheet sheet)))) + 1) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/frame-manager.lisp 2006/11/12 13:46:08 1.5 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/frame-manager.lisp 2006/11/12 20:12:19 1.6 @@ -93,6 +93,9 @@ ((:some-of nil) 'gtk-check-button)) initargs))
+(defmethod make-pane-2 ((type (eql 'clim:generic-list-pane)) &rest initargs) + (apply #'make-instance 'gtk-list initargs)) + (defmethod adopt-frame :after ((fm gtkairo-frame-manager) (frame application-frame)) ()) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/11/12 13:46:08 1.7 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/11/12 20:12:19 1.8 @@ -35,6 +35,8 @@
(defclass context-menu-cancelled-event (gadget-event) ())
+(defclass list-selection-event (gadget-event) ()) +
;;;; Classes
@@ -45,6 +47,10 @@ (defclass gtk-check-button (native-widget-mixin toggle-button) ()) (defclass gtk-radio-button (native-widget-mixin toggle-button) ())
+(defclass gtk-list (native-widget-mixin list-pane climi::meta-list-pane) + ((title :initarg :title :initform "" :accessor list-pane-title) + (tree-view :accessor list-pane-tree-view))) + (defclass native-slider (native-widget-mixin climi::slider-gadget) ((climi::show-value-p :type boolean :initform nil @@ -80,6 +86,104 @@ (gtk_toggle_button_set_active widget (if (gadget-value sheet) 1 0)) widget))
+(defconstant +g-type-string+ (ash 16 2)) + +(defun uninstall-scroller-pane (pane) + (with-slots (climi::scroll-bar + climi::vscrollbar climi::hscrollbar + climi::x-spacing climi::y-spacing) + pane + (setf scroll-bar nil) + (when climi::vscrollbar + (sheet-disown-child pane climi::vscrollbar) + (setf climi::vscrollbar nil)) + (when climi::hscrollbar + (sheet-disown-child pane climi::hscrollbar) + (setf climi::hscrollbar nil)) + (setf climi::x-spacing 0) + (setf climi::y-spacing 0) + (let ((r (sheet-region pane))) + (allocate-space pane + (bounding-rectangle-width r) + (bounding-rectangle-height r))))) + +(defun list-pane-selection (sheet) + (gtk_tree_view_get_selection (list-pane-tree-view sheet))) + +(defmethod realize-native-widget ((sheet gtk-list)) + (cffi:with-foreign-object (types :ulong 2) + (setf (cffi:mem-aref types :long 0) +g-type-string+) + (setf (cffi:mem-aref types :long 1) 0) + (let* ((model (gtk_list_store_newv 1 types)) + (tv (gtk_tree_view_new_with_model model)) + (name-key (climi::list-pane-name-key sheet)) + (column (gtk_tree_view_column_new)) + (renderer (gtk_cell_renderer_text_new))) + (setf (list-pane-tree-view sheet) tv) + (gtk_tree_view_column_pack_start column renderer 1) + (gtk_tree_view_insert_column tv column -1) + (gtk_tree_view_column_add_attribute column renderer "text" 0) + (gtk_tree_view_column_set_title column (list-pane-title sheet)) + (cffi:with-foreign-object (&iter 'gtktreeiter) + (dolist (i (climi::list-pane-items sheet)) + (gtk_list_store_append model &iter) + (cffi:with-foreign-string (n (funcall name-key i)) + (cffi:with-foreign-object (&value 'gvalue) + (setf (cffi:foreign-slot-value &value 'gvalue 'type) 0) + (g_value_init &value +g-type-string+) + (g_value_set_string &value n) + (gtk_list_store_set_value model &iter 0 &value))))) + (gtk_tree_selection_set_mode + (list-pane-selection sheet) + (if (eq (climi::list-pane-mode sheet) :exclusive) + :browse + :multiple)) + (gtk-list-reset-selection sheet) + (let ((ancestor + (and (sheet-parent sheet) (sheet-parent (sheet-parent sheet)))) + (result tv)) + (when (typep ancestor 'scroller-pane) + (uninstall-scroller-pane ancestor)) + (let ((wrapper (gtk_scrolled_window_new + (gtk_tree_view_get_hadjustment tv) + (gtk_tree_view_get_vadjustment tv)))) + (gtk_container_add wrapper tv) + (setf result wrapper)) + (setf (list-pane-tree-view sheet) tv) ;?! + (gtk_tree_selection_set_select_function + (list-pane-selection sheet) + (cffi:get-callback 'view-selection-callback) + result + (cffi:null-pointer)) + result)))) + +(defun gtk-list-select-value (sheet value) + (let ((path + (gtk_tree_path_new_from_indices + (position value + (climi::list-pane-items sheet) + :key (climi::list-pane-value-key sheet) + :test (climi::list-pane-test sheet)) + :int -1))) + (gtk_tree_selection_select_path (list-pane-selection sheet) path) + (gtk_tree_path_free path))) + +(defun gtk-list-reset-selection (sheet) + (gtk_tree_selection_unselect_all (list-pane-selection sheet)) + (let ((value (gadget-value sheet))) + (if (eq (climi::list-pane-mode sheet) :exclusive) + (gtk-list-select-value sheet value) + (dolist (v value) + (gtk-list-select-value sheet v))))) + +(defmethod (setf gadget-value) :after + (value (gadget gtk-list) &key invoke-callback) + (declare (ignore invoke-callback)) + (with-gtk () + (let ((mirror (sheet-direct-mirror gadget))) + (when mirror + (gtk-list-reset-selection gadget))))) + (defun make-scale (fn sheet) (let* ((min (df (gadget-min-value sheet))) (max (df (gadget-max-value sheet))) @@ -232,6 +336,10 @@ ;; no signals )
+(defmethod connect-native-signals ((sheet gtk-list) widget) + ;; no signals + ) +
;;;; Event handling
@@ -285,6 +393,40 @@ ((pane gtk-nonmenu) (event magic-gadget-event)) (funcall (gtk-nonmenu-callback pane) pane nil))
+(defvar *list-selection-result*) + +(cffi:defcallback list-selection-callback :void + ((model :pointer) + (path :pointer) + (iter :pointer) + (data :pointer)) + model iter data + (setf (gethash (cffi:mem-ref (gtk_tree_path_get_indices path) :int 0) + *list-selection-result*) + t)) + +(defmethod handle-event + ((pane gtk-list) (event list-selection-event)) + (with-gtk () + (let ((*list-selection-result* (make-hash-table)) + (value-key (climi::list-pane-value-key pane))) + (gtk_tree_selection_selected_foreach + (list-pane-selection pane) + (cffi:get-callback 'list-selection-callback) + (cffi:null-pointer)) + (setf (gadget-value pane :invoke-callback t) + (if (eq (climi::list-pane-mode pane) :exclusive) + (loop + for i being each hash-key in *list-selection-result* + do (return + (funcall value-key + (elt (climi::list-pane-items pane) i)))) + (loop + for i from 0 + for value in (climi::list-pane-items pane) + when (gethash i *list-selection-result*) + collect (funcall value-key value))))))) +
;;; COMPOSE-SPACE
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/11/12 13:46:08 1.13 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/11/12 20:12:19 1.14 @@ -290,6 +290,17 @@ (max_aspect :double) (win_gravity :int))
+(cffi:defcstruct gtktreeiter + (stamp :int) + (user_data :pointer) + (user_data2 :pointer) + (user_data3 :pointer)) + +(cffi:defcstruct gvalue + (type :ulong) + (data0 :uint64) + (data1 :uint64)) + (cffi:defcenum gdkfunction :copy :invert :xor :clear :and :and_reverse :and_invert :noop :or :equiv :or_reverse :copy_invert :or_invert :nand :nor :set) @@ -299,6 +310,9 @@ :step_up :step_down :page_up :page_down :step_left :step_right :page_left :page_right :start :end)
+(cffi:defcenum gtkselectionmode + :none :single :browse :multiple) +
;;; GTK functions
@@ -783,6 +797,131 @@ ;; (data :pointer) (data :long))
+(defcfun "gtk_tree_view_new_with_model" + :pointer + (model :pointer)) + +(defcfun "gtk_list_store_newv" + :pointer + (columns :int) + (types :pointer)) + +(defcfun "gtk_list_store_append" + :void + (list_store :pointer) + (iter :pointer)) + +(defcfun "gtk_list_store_set_value" + :void + (list_store :pointer) + (iter :pointer) + (column :int) + (value :pointer)) + +(defcfun "g_value_init" + :pointer + (gvalue :pointer) + (gtype :ulong)) + +(defcfun "g_value_set_string" + :void + (gvalue :pointer) + (string :pointer)) + +(defcfun "gtk_cell_renderer_text_new" :pointer) + +(defcfun "gtk_tree_view_column_new" :pointer) + +(defcfun "gtk_tree_view_column_get_widget" + :pointer + (column :pointer)) + +(defcfun "gtk_tree_view_column_set_widget" + :void + (column :pointer) + (widget :pointer)) + +(defcfun "gtk_tree_view_column_pack_start" + :void + (column :pointer) + (cell :pointer) + (expand :int)) + +(defcfun "gtk_tree_view_insert_column" + :int + (treeview :pointer) + (column :pointer) + (position :int)) + +(defcfun "gtk_tree_view_column_add_attribute" + :void + (column :pointer) + (renderer :pointer) + (attribute :string) + (column-index :int)) + +(defcfun "gtk_tree_view_column_set_title" + :void + (column :pointer) + (title :string)) + +(defcfun "gtk_scrolled_window_new" + :pointer + (hadjustment :pointer) + (vadjustment :pointer)) + +(defcfun "gtk_tree_view_get_hadjustment" + :pointer + (tv :pointer)) + +(defcfun "gtk_tree_view_get_vadjustment" + :pointer + (tv :pointer)) + +(defcfun "gtk_tree_view_get_selection" + :pointer + (tv :pointer)) + +(defcfun "gtk_tree_selection_set_mode" + :void + (selection :pointer) + (mode gtkselectionmode)) + +(defcfun "gtk_tree_selection_unselect_all" + :void + (selection :pointer)) + +(defcfun "gtk_tree_selection_select_path" + :void + (selection :pointer) + (path :pointer)) + +(defcfun "gtk_tree_path_new_from_indices" + :pointer + (index :int) + &rest) + +(defcfun "gtk_tree_path_free" + :void + (path :pointer)) + +(defcfun "gtk_tree_selection_set_select_function" + :void + (selection :pointer) + (fun :pointer) + (data :pointer) + (destroynotify :pointer)) + +(defcfun "gtk_tree_path_get_indices" + :pointer + (path :pointer)) + +(defcfun "gtk_tree_selection_selected_foreach" + :void + (selection :pointer) + (fun :pointer) + (data :pointer)) + (defconstant GDK_EXPOSURE_MASK (ash 1 1)) (defconstant GDK_POINTER_MOTION_MASK (ash 1 2)) (defconstant GDK_POINTER_MOTION_HINT_MASK (ash 1 3))