[mcclim-cvs] CVS mcclim/Backends/gtkairo

[dlichteblau]

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