Re: gtk-menu-popup [guile-gnome2 2.16.1-4]

[David Pirotte <david@altosw.be>]

[-- Attachment #1: Type: text/plain, Size: 981 bytes --]

Hello Andy,

Sure, attached [feel free to add it to the examples]

As it is, it works. But if you uncomment the line 162 [and comment the line 163],
then you get the following message:

	ERROR: No applicable method for #<<generic> get-path-at-pos (1)> in call
	(get-path-at-pos #<<gtk-tree-view> b6320540> 118 30)

Cheers,
David

ps: the reason i am using this type of coding to bring the popup is because in my
'real code', the popup content depends on the row content, and although gtk selects
the row even on a right button click, it is done after the button-press-event signal
callback, which prevents me to use the 'normal' get-path method.

;; --

Le Thu, 01 Jul 2010 11:49:43 +0100,
Andy Wingo <wingo@pobox.com> a écrit :

> On Tue 29 Jun 2010 15:42, David Pirotte <david@altosw.be> writes:
> 
> > 	did you see my message about get-path-at-pos?
> 
> Can you please mail a complete and concise description of the problem?
> 
> Thanks,
> 
> A

[-- Attachment #2: get-path-at-pos.scm --]
[-- Type: text/x-scheme, Size: 5681 bytes --]

#! /bin/sh
# -*- scheme -*-
exec guile-gnome-2 -s $0 "$@"
!#

;; guile-gnome
;; Copyright (C) 2003,2004 Free Software Foundation, Inc.

;; This program is free software; you can redistribute it and/or    
;; modify it under the terms of the GNU General Public License as   
;; published by the Free Software Foundation; either version 2 of   
;; the License, or (at your option) any later version.              
;;                                                                  
;; This program is distributed in the hope that it will be useful,  
;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
;; GNU General Public License for more details.                     
;;                                                                  
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation           Voice:  +1-617-542-5942
;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
;; Boston, MA  02111-1307,  USA       gnu@gnu.org

(read-set! keywords 'prefix)

(use-modules (ice-9 receive)
	     (oop goops) 
	     (gnome gobject)
	     (gnome gtk)
	     (gnome gtk gdk-event))


(define *model* #f)
(define *selection* #f)

(define (pack-tv-column tv column renderer pos)
  (pack-start column renderer #t)
  (add-attribute column renderer "text" pos)
  (append-column tv column))

(define (add-columns treeview)
  (let* ((renderer1 (make <gtk-cell-renderer-text>))
	 (column1   (make <gtk-tree-view-column>
		      :title       "Column 1"
		      :sizing      'fixed
		      :fixed-width 65
					;:clickable   #f
					;:resizable   #f
					;:reorderable #f
		      :alignment   .5
		      ))
	 (renderer2 (make <gtk-cell-renderer-text>))
	 (column2   (make <gtk-tree-view-column>
		      :title       "Column 2"
		      :sizing      'fixed
		      :fixed-width 65
					;:clickable   #f
					;:resizable   #f
					;:reorderable #f
		      :alignment   .5
		      ))
	 (renderer3 (make <gtk-cell-renderer-text>))
	 (column3   (make <gtk-tree-view-column>
		      :title       "Column 3"
		      :expand      #t
		      :alignment   .5
		      )))
    (pack-tv-column treeview column1 renderer1 0)
    (pack-tv-column treeview column2 renderer2 1)
    (pack-tv-column treeview column3 renderer3 2)
    ;; (set-search-column treeview 1)
    ))

(define (ocs/add-model treeview)
  (let* ((column-types (list <gchararray>
			     <gchararray>
			     <gchararray>
			     <gchararray>
			     <gchararray>
			     <gchararray>))
	 (model (gtk-list-store-new column-types)))
    (set-model treeview model)
    (values model
	    (get-selection treeview))
    ))

(define (setup-treeview treeview)
  (add-columns treeview)
  (receive (model selection)
      (ocs/add-model treeview)
    (set-mode selection 'single)
    (values model selection)))

(define (populate-model model)
  (for-each (lambda (row)
	      (let ((iter (gtk-list-store-append model)))
		(set-value model iter 0 (car row))
		(set-value model iter 1 (cadr row))
		(set-value model iter 2 (caddr row))))
      '(("r1c1" "r1c2" "r1c3")
	("r2c1" "r2c2" "r2c3")
	("r3c1" "r3c2" "r3c3"))
    ))

(define (make-simple-popup-menu entries)
  (let ((menu (make <gtk-menu>)))
    (for-each (lambda (entry)
		(if (pair? entry)
		    (let* ((label     (car entry))
			   (callback  (cdr entry))
			   (menu-item (gtk-menu-item-new-with-label label)))
		      (connect menu-item
			       'activate
			       (lambda (widget)
				 (callback)))
		      (gtk-menu-shell-append menu menu-item)
		      (show menu-item))
		    (let ((menu-item (gtk-separator-menu-item-new)))
		      (gtk-menu-shell-append menu menu-item)
		      (show menu-item))))
	entries)
    menu))

(define (make-popup-menu)
  (make-simple-popup-menu `(("popup option 1" . ,(lambda () (display "popup option 1\n")))
			    ("popup option 2" . ,(lambda () (display "popup option 2\n")))
			    separator
			    ("popup option 3" . ,(lambda () (display "popup option 3\n"))))
			  ))

(define (animate)
  (let* ((window (make <gtk-window> 
		   :type 'toplevel
		   :title "Get path at pos test"
		   ))
	 (treeview (make <gtk-tree-view>))
	 (popup-menu (make-popup-menu)))
    (set-default-size window 300 100)
    (receive (model selection)
	(setup-treeview treeview)
      (populate-model model)
      (add window treeview)

      (connect window
	       'delete-event
	       (lambda (widget event)
		 (destroy widget)
		 (gtk-main-quit)
		 #f))

    (connect treeview
	     'button-press-event
	     (lambda (w ev)
	       (case (gdk-event:type ev)
		 ((button-press)
		  (let* ((button      (gdk-event-button:button ev))
			 (time        (gdk-event-button:time ev))
			 (x-pos       (inexact->exact (gdk-event-button:x ev)))
			 (y-pos       (inexact->exact (gdk-event-button:y ev)))
			 (path-values ;; (get-path-at-pos w x-pos y-pos)
				      (values (list 1) #t 10 10)
				      ))
		    (case button
		      ((3)
		       (receive (indices bool x y)
			   path-values
			 (let* ((row      (car indices))
				(iter     (get-iter model row)))
			   (gtk-menu-popup popup-menu
					   #f  ;; parent-menu-shell or #f
					   #f  ;; parent-menu-item or #f
					   #f  ;; user supplied func to position the menu or #f
					   ;; #f  - no more user supplied data to pass to func
					   button
					   time
					   )))))))
		 ((2button-press)
		  (simple-format #t "ignoring 2button-press events...~%"))
		 ((3button-press)
		  (simple-format #t "ignoring 3button-press events...~%"))
		 )
	       #f
	       ))

      )

    (show-all window)

    (gtk-main)))

(animate)