Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv17453/Backends/gtkairo
Modified Files: event.lisp gadgets.lisp Log Message:
As an extension, recognize an initarg :PRESENTATION-TYPE-KEY to the list pane. Like :VALUE-KEY and :NAME-KEY, it can specify a function to be called for each list item. The presentation type key can return NIL, or a presentation type to be used for the item.
If such a type is returned, selection of the item will throw a presentation of that type before the value-change callback is called.
In addition, right click will be recognized on the list pane and open a presentation menu.
* gadgets.lisp (META-LIST-PANE): New slot presentation-type-key. ((VALUE-CHANGED-CALLBACK :BEFORE META-LIST-PANE)): Optionally throw a presentation. (AD-HOC-PRESENTATION, OUTPUT-RECORD-HIT-DETECTION-RECTANGLE*): New class and method. (GENERIC-LIST-PANE-HANDLE-RIGHT-CLICK, META-LIST-PANE-CALL-PRESENTATION-MENU): New functions. ((HANDLE-EVENT GENERIC-LIST-PANE)): Handle right clicks. * Examples/demodemo.lisp (list-pane-test): Modified to demonstrate presentation-type-key. * Backends/gtkairo/event.lisp (HANDLE-EVENT-P): New generic function. (BUTTON-HANDLER): Trap the event only if handle-event-p returns true. * Backends/gtkairo/gadgets.lisp ((HANDLE-EVENT-P GTK-LIST), (CONNECT-NATIVE-SIGNALS GTK-LIST)): Handle right clicks. (GTK-LIST-ONE-VALUE): New function. ((HANDLE-EVENT GTK-LIST)): Call meta-list-pane-call-presentation-menu.
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/12/10 19:33:05 1.17 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/12/27 14:47:24 1.18 @@ -269,31 +269,43 @@
(defvar *last-seen-button* 3)
-(define-signal button-handler (widget event) +(defgeneric handle-event-p (sheet event)) + +(defmethod handle-event-p (sheet event) + t) + +(define-signal (button-handler :return-type :int) (widget event) (cffi:with-foreign-slots ((type time button state x y x_root y_root) event gdkeventbutton) (when (eql type GDK_BUTTON_PRESS) ;; Hack alert: Menus don't work without this. (gdk_pointer_ungrab GDK_CURRENT_TIME)) (setf *last-seen-button* button) - (enqueue - (make-instance (if (eql type GDK_BUTTON_PRESS) - 'pointer-button-press-event - 'pointer-button-release-event) - :pointer 0 - :button (ecase button - (1 +pointer-left-button+) - (2 +pointer-middle-button+) - (3 +pointer-right-button+) - (4 +pointer-wheel-up+) - (5 +pointer-wheel-down+)) - :x (truncate x) - :y (truncate y) - :graft-x (truncate x_root) - :graft-y (truncate y_root) - :sheet (widget->sheet widget *port*) - :modifier-state (gdkmodifiertype->modifier-state state) - :timestamp time)))) + (let* ((sheet (widget->sheet widget *port*)) + (event + (make-instance (if (eql type GDK_BUTTON_PRESS) + 'pointer-button-press-event + 'pointer-button-release-event) + :pointer 0 + :button (ecase button + (1 +pointer-left-button+) + (2 +pointer-middle-button+) + (3 +pointer-right-button+) + (4 +pointer-wheel-up+) + (5 +pointer-wheel-down+)) + :x (truncate x) + :y (truncate y) + :graft-x (truncate x_root) + :graft-y (truncate y_root) + :sheet sheet + :modifier-state (gdkmodifiertype->modifier-state state) + :timestamp time))) + (cond + ((handle-event-p sheet event) + (enqueue event) + 1) + (t + 0)))))
(define-signal enter-handler (widget event) (cffi:with-foreign-slots --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/12/25 19:41:46 1.19 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp 2006/12/27 14:47:24 1.20 @@ -250,6 +250,33 @@ (mapcar (climi::list-pane-value-key pane) (climi::list-pane-items pane)))
+(defmethod handle-event-p + ((pane gtk-list) (event pointer-button-press-event)) + (eql (pointer-event-button event) +pointer-right-button+)) + +(defun gtk-list-one-value (pane) + (if (eq (climi::list-pane-mode pane) :exclusive) + (if (and (slot-boundp pane 'climi::value) + ;; FIXME: we still assume NIL == no value + (gadget-value pane)) + (values (gadget-value pane) t) + (values nil nil)) + (if (and (slot-boundp pane 'climi::value) + (eql 1 (length (gadget-value pane)))) + (values (car (gadget-value pane)) t) + (values nil nil)))) + +(defmethod handle-event ((pane gtk-list) (event pointer-button-press-event)) + (multiple-value-bind (value valuep) (gtk-list-one-value pane) + (when valuep + (let* ((i (position value (climi::generic-list-pane-item-values pane))) + (item (elt (climi::list-pane-items pane) i))) + (climi::meta-list-pane-call-presentation-menu pane item))))) + +(defmethod handle-event-p + ((pane gtk-list) (event pointer-button-release-event)) + nil) + (defun option-pane-set-active (sheet widget) (gtk_combo_box_set_active widget @@ -422,8 +449,10 @@ )
(defmethod connect-native-signals ((sheet gtk-list) widget) - ;; no signals - ) + (setf (widget->sheet (list-pane-tree-view sheet) (port sheet)) sheet) + (connect-signal (list-pane-tree-view sheet) + "button-press-event" + 'button-handler))
(defmethod connect-native-signals ((sheet gtk-label-pane) widget) ;; no signals