From: Stalkern 2 <stalkern2 at tin.it>
Reply-To: stalkern2 at tin.it
To: Olivier Andrieu <andrieu at ijm.jussieu.fr>
Subject: Re: About automatic column sorting and right-click detection
Date: Fri, 19 Dec 2003 22:44:31 +0100
Cc: lablgtk at kaba.or.jp
References: <200312171132.49128.stalkern2 at tin.it> <200312191550.35477.stalkern2 at tin.it> <16355.8721.795161.532146 at akasha.ijm.jussieu.fr>
In-Reply-To: <16355.8721.795161.532146 at akasha.ijm.jussieu.fr>
MIME-Version: 1.0
Content-Type: Multipart/Mixed;
  boundary="Boundary-00=_/E34/A9dNg3+3vB"
Message-Id: <200312192244.31974.stalkern2 at tin.it>


--Boundary-00=_/E34/A9dNg3+3vB
Content-Type: text/plain;
  charset="iso-8859-1"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

Il  Friday 19 December 2003 17:06, Olivier Andrieu ha scritto:
[...]
>
> let make_event w = new GObj.event_ops w#as_widget
>
> (make_event you_tree_view_widget)#connect#button_press
[...]


Yep! Here I have a sample code for an enriched GTK2 List + _I think_ a free 
bug!
The bug is IMHO in GtkTree.TreeView.get_path_at_pos when list headers are 
visible.

I join the code: if you feel like, please help clean it up so that it can be 
put it on the Internet for the sake of other Ocamlers (I am not the only one 
interested in righ-click on lists, am I?)

Thanks a lot. 

Ernesto



--Boundary-00=_/E34/A9dNg3+3vB
Content-Type: text/ocaml-src;
  charset="iso-8859-1";
  name="my_tree_as_list_w_popup.ml"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
	filename="my_tree_as_list_w_popup.ml"

(* "Enriched" List TreeView *)
(* Summarizing some teachings by Jacques Garrigue and Olivier Andrieu *)
(* code assembled by stalkern@tiscalinet.it *)

open StdLabels
open Gobject.Data

(*..........................................................................................*)

let titlesAndAuthorsList = 
  [("The Art of Computer Programming","Donald E. Knuth");
   ("The Mart of Tomputer Progapping","Vito De Zito");
   ("Peh Prat of Momputer Gropamming", "Agur Ropankanyami");
   ("The Cart of Pomputer Crogramming","Zemilyankatkinin Yvan");
   ("Che Part of Procuter Mogramming", "Chow Li") ];;

let aCheckedRowPixbuf = GdkPixbuf.from_file "roundledchecked22x22.xpm";;
let aUncheckedRowPixbuf = GdkPixbuf.from_file "roundledunchecked22x22.xpm";;

let activatedRows = ref [];;


type myTreeCellRendererType = 
    StringCellRendererBuild of (string GTree.column ) 
  | PixbufCellRendererBuild of (GdkPixbuf.pixbuf GTree.column);;

(*..........................................................................................*)

class popupMenu () = 
object (self)
  val theMenu = GMenu.menu ()
  val mutable thePrintedString = "DEFAULT STRING"
  method menu = theMenu
  method add_menuitem label =
    let menuItem =
      GMenu.menu_item
	~label
	~packing: theMenu#append
	()
    in
      (menuItem#connect#activate ~callback:(fun () -> (print_endline thePrintedString; flush stdout)))
  method enhancedpopup ~button ~time content =
    let () = thePrintedString <- content in
    theMenu#popup ~button ~time 
end
;;

(*..........................................................................................*)

class treeViewWithPopup () =

  let window = GWindow.window () in

  let columnList = new GTree.column_list in

  let (flagColumn, flagColumnIndex) = 
    ((columnList#add Gobject.Data.gobject), 0) 
  in
  let (titleColumn, titleColumnIndex) = 
    ((columnList#add Gobject.Data.string), 1)
  in
  let (authorColumn,  authorColumnIndex) =  
    ((columnList#add Gobject.Data.string), 2)
  in

  let populate_tree (aTitleAndAuthorList: (string *string) list)  (aTreeStore: GTree.tree_store) =
    List.iter
      (fun (aTitle, aAuthor) -> 
	 let lastFilledRow = aTreeStore#append () in
	 let () = 
	   aTreeStore#set ~row:lastFilledRow ~column:flagColumn aUncheckedRowPixbuf in
	 let () = 
	   aTreeStore#set ~row:lastFilledRow ~column:titleColumn aTitle in
	 let () = 
	   aTreeStore#set ~row:lastFilledRow ~column:authorColumn aAuthor in
	   ()
      )
      titlesAndAuthorsList
  in
    
  let treeStore =GTree.tree_store columnList in  

  let firstTreeView = 
    GTree.view 
      ~model:treeStore 
    ~headers_clickable:true
    ~headers_visible:true
    ()
  in

  let create_vwColumn ?(appendto = firstTreeView)?(resizable = true)  ?(sortingfor = None) (aTitle:string) (aRendererType:myTreeCellRendererType) =

    let aVwCol =
      match aRendererType with
	| StringCellRendererBuild aColumn ->
	    (
	      GTree.view_column 
	       ~title:aTitle 
	       ~renderer:((GTree.cell_renderer_text []), 
			  ["text",aColumn])
	       ()
	    )
	| PixbufCellRendererBuild aColumn ->
	    
	    (
	      GTree.view_column 
	       ~title:aTitle 
	       ~renderer:((GTree.cell_renderer_pixbuf []),
			  [("pixbuf",aColumn)])
	       ()
	    )	   
    in

    let colNum= appendto #append_column aVwCol in 
    
    let () = if resizable then (aVwCol#set_resizable true) else () in
    
    (* we set the column of the column list of the tree store to sort this column according to*)
    let () =
      match sortingfor with
	| Some num -> 
	      (aVwCol#set_sort_column_id num)
	| None -> () 
    in
    aVwCol
  in
    

  let menuObj = new popupMenu () in

  let aCallbackID = menuObj#add_menuitem "Print Content of Row" 
  in


  (* Quoting http://mail.gnome.org/archives/gtk-list/1999-March/msg00697.html:
   *
   * "basically, incomming X events get translated to gdk events which 
   * will then cause signal emissions on the widgets taht these gdk events belong to.
   * signals are introduced per widget class and provide (simply speaking) a
   * generic mechanism to hook callback functions into the call sequence upon
   * execution of an object method."
   *
   *)

  (* right-clicking detection, after Olivier Andrieu*)
  let make_event w = 
    new GObj.event_ops w#as_widget 
  in

  let aCallbackID =
    (make_event firstTreeView)#connect#button_press
    ~callback:(fun event ->
	 
		 (* We are intercepting the signal, 
		  * and the other effects that it may cause
		  * wil take place AFTER this callback.
		  * But we can not miss the change in selection: 
		  * so, we'll try to recover it
		  *)

		 let () = firstTreeView#selection#unselect_all () in

		 (* One technique to select the row that we were above
		  * at the time of the button_press event, 
		  * is to detect what path corresponds to the 
		  * "current" mouse position
		  *)
		 let x, y = (firstTreeView#coerce)#misc#pointer in
		 (*let () = Printf.printf "Pointer is at %i, %i : "  x y in*)
		 let optPathColXY = 
		   GtkTree.TreeView.get_path_at_pos ~x ~y 
		     (GtkTree.TreeView.cast (firstTreeView#as_widget)) 
		 in

		 let () = 
		   match optPathColXY with
		     | Some (pathWherePointer,_,_,_) -> 
			 (
			   (* Unfortunately there is a kind of oddity, maybe a bug, since 
			    * the GtkTree.TreeView.get_path_at_pos function seems 
			    * not to take into account the presence of the headers.
			   *)
			   (*let's try to take into consideration the presence of headers ;-( *)
			   let () = GtkTree.TreePath.prev pathWherePointer in

			   (*let () = 
			   print_endline 
			     ("Mouse Is Over Row: "^
			      (GtkTree.TreePath.to_string pathWherePointer))
			   in*)
			     (*let's select our path by hand*)
			   firstTreeView#selection#select_path pathWherePointer
			 )
		     | None -> ()
		 in
		   
		 
		 (*Now, we'll check out that the mouse button pressed was the 3rd one*)
		 let () =
		   if ((GdkEvent.Button.button event) = 3) then 

		     let stringToPrint =
		       match (firstTreeView#selection#get_selected_rows) with
			 | [] -> ""
			 | firstSelectedPath::tail -> 
			     (Format.sprintf 
				"Welcome to \"%s\" by %s."
				(treeStore#get 
				   ~row:(treeStore#get_iter firstSelectedPath) 
				   ~column:titleColumn)
				(treeStore#get 
				   ~row:(treeStore#get_iter firstSelectedPath) 
				   ~column:authorColumn)
			     )
		     in
		       (* this popup call wraps menu#popup by modifying the
			* string to print on-the-fly
			*)
		     (menuObj#enhancedpopup
			~button:3
			~time:(GdkEvent.get_time event)
			stringToPrint
		     )
		   else
		     ()
		    
		 in	   
		   (false) (*let's NOT stop the signal*)
	      )
  in
    

    (* Callback for the row_activated signal: 
     * after Jacques Garrigue's tree.ml example, plus changing flag pixmap *)
  let _ = 
    firstTreeView#connect#after#row_activated 
      ~callback:
      (fun path vcol ->
	 let selectionIter = treeStore#get_iter path in
	   
	 (*unflag previous activations*)
	 let () = 
	   List.iter 
	     (fun eliter -> 
		treeStore#set 
		~row:eliter 
		~column:(flagColumn)
		aUncheckedRowPixbuf	  
	     )
	     !activatedRows
	 in
	 let () = activatedRows := [] 
	 in

	   (*keep track of this activation*)
	 let () = activatedRows := selectionIter::!activatedRows in
	 let () = 
	   if (treeStore#iter_is_valid selectionIter)  then
	     (
	       let () = 
		 print_endline 
		   ("You've been activating \""^
		    (treeStore#get ~row:selectionIter ~column:(titleColumn))^
		   "\"") 
	       in
	       let () = 
		 treeStore#set 
		   ~row:selectionIter 
		   ~column:(flagColumn) 
		   aCheckedRowPixbuf  
	       in
		 ()	 
	     )
	   else
	     ()
	 in	   
	   ()
      )
  in


object (self)
  method window = window
  method columnlist = columnList
  method flagcolumn = flagColumn 
  method titlecolumn = titleColumn
  method titlecolumnindex = titleColumnIndex
  method authorcolumn = authorColumn	 
  method authorcolumnindex = authorColumnIndex	 
  method populate aTAList () = populate_tree aTAList treeStore
  method treestore = treeStore
  method treeview = firstTreeView
  method treevwcol ?appendto ?resizable ?sortingfor aTitle aRendererDescription = 
    create_vwColumn 
      ?appendto
      ?resizable
      ?sortingfor
      aTitle 
      (aRendererDescription:myTreeCellRendererType)
end
;;

(*..........................................................................................*)

let main () =

  let treeObj = new treeViewWithPopup () in

  let window = treeObj#window in

  let vbox = GPack.vbox ~packing:window#add () in

  let _ = window#connect#destroy ~callback:GMain.quit in


  let () = treeObj#populate titlesAndAuthorsList () in

  let treeView = treeObj#treeview in

  (* set view columns *)
  let flagVwColumn = 
    treeObj#treevwcol
      "Double-clicked" 
      (PixbufCellRendererBuild  (treeObj#flagcolumn)) 
  in
 
  let titleVwColumn =   
    treeObj#treevwcol
      ~sortingfor:(Some treeObj#titlecolumnindex )
      "Title" 
      (StringCellRendererBuild  (treeObj#titlecolumn)) 
  in

  let title2VwColumn =   
    treeObj#treevwcol
     ~sortingfor:(Some treeObj#titlecolumnindex)
      "Another View Column for Title" 
      (StringCellRendererBuild  (treeObj#titlecolumn)) 
  in

  let authorVwColumn =   
    treeObj#treevwcol
      ~sortingfor:(Some treeObj#authorcolumnindex)
      "Author" 
      (StringCellRendererBuild  (treeObj#authorcolumn)) 
  in  

  let () = vbox#add (treeView#coerce) 
  in

  let clearButton = 
    GButton.button 
      ~label: "Clear"  
      ~packing: vbox#add 
      ()
  in
  let aCbID =
    clearButton #connect#clicked 
      ~callback:(fun () -> treeObj#treestore#clear ()) 
  in

  let populateButton = 
    GButton.button 
      ~label: "Populate"  
      ~packing: vbox#add 
      ()
  in
  let aCbID =populateButton #connect#clicked 
	       ~callback:(fun () -> treeObj#populate titlesAndAuthorsList () )
  in


  let closeButton = 
    GButton.button 
      ~label: "Close"  
      ~packing: vbox#add 
      ()
  in
  let aCbID =
    closeButton #connect#clicked 
      ~callback:(fun () -> window#destroy ())
  in

  let () = 
    window#show () 
  in
    GMain.main ()
;;

(*..........................................................................................*)

let _ = main ();;

(*...........................................................................................*)







--Boundary-00=_/E34/A9dNg3+3vB
Content-Type: image/x-xpm;
  name="roundledchecked22x22.xpm"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
	filename="roundledchecked22x22.xpm"

/* XPM */
static char * roundledchecked22x22_xpm[] = {
"22 22 121 2",
"  	c None",
". 	c #4EA04E",
"+ 	c #60AE60",
"@ 	c #6DB86D",
"# 	c #6EB96E",
"$ 	c #63B063",
"% 	c #50A250",
"& 	c #3D923D",
"* 	c #62B262",
"= 	c #84C784",
"- 	c #ABD9AB",
"; 	c #C3E4C3",
"> 	c #C4E4C4",
", 	c #B0DBB0",
"' 	c #89C989",
") 	c #6AB76A",
"! 	c #3F953F",
"~ 	c #368E36",
"{ 	c #58B058",
"] 	c #87C887",
"^ 	c #8ECC8E",
"/ 	c #9CD29C",
"( 	c #A6D6A6",
"_ 	c #9ED39E",
": 	c #8FCC8F",
"< 	c #89CA89",
"[ 	c #61B661",
"} 	c #369036",
"| 	c #3DA13D",
"1 	c #57B357",
"2 	c #80C580",
"3 	c #88C988",
"4 	c #8ACA8A",
"5 	c #82C782",
"6 	c #5EB65E",
"7 	c #40A540",
"8 	c #318731",
"9 	c #389538",
"0 	c #40A840",
"a 	c #41A841",
"b 	c #4CAD4C",
"c 	c #55B155",
"d 	c #5BB35B",
"e 	c #5EB45E",
"f 	c #5CB35C",
"g 	c #56B156",
"h 	c #4EAD4E",
"i 	c #42A942",
"j 	c #389638",
"k 	c #3A9B3A",
"l 	c #3EA63E",
"m 	c #3DA43D",
"n 	c #3BA23B",
"o 	c #3AA13A",
"p 	c #3AA03A",
"q 	c #39A039",
"r 	c #3CA43C",
"s 	c #3CA03C",
"t 	c #3B9F3B",
"u 	c #389F38",
"v 	c #379C37",
"w 	c #369C36",
"x 	c #369B36",
"y 	c #389E38",
"z 	c #3BA13B",
"A 	c #3CA23C",
"B 	c #399C39",
"C 	c #389D38",
"D 	c #399F39",
"E 	c #3CA33C",
"F 	c #359B35",
"G 	c #379D37",
"H 	c #3A9E3A",
"I 	c #349234",
"J 	c #47B047",
"K 	c #4EB84E",
"L 	c #52BC52",
"M 	c #53BC53",
"N 	c #4FB94F",
"O 	c #49B249",
"P 	c #3FA73F",
"Q 	c #359735",
"R 	c #318631",
"S 	c #48B148",
"T 	c #59C359",
"U 	c #67CF67",
"V 	c #6ED56E",
"W 	c #6ED66E",
"X 	c #69D169",
"Y 	c #5CC55C",
"Z 	c #4BB44B",
"` 	c #2F882F",
" .	c #329232",
"..	c #4AB34A",
"+.	c #5EC85E",
"@.	c #6FD76F",
"#.	c #78DE78",
"$.	c #79DE79",
"%.	c #71D871",
"&.	c #61CA61",
"*.	c #4DB64D",
"=.	c #349634",
"-.	c #277727",
";.	c #297C29",
">.	c #369936",
",.	c #42AA42",
"'.	c #51BB51",
").	c #60C960",
"!.	c #62CB62",
"~.	c #53BD53",
"{.	c #44AC44",
"].	c #389C38",
"^.	c #2A7D2A",
"/.	c #359635",
"(.	c #379937",
"_.	c #2C832C",
":.	c #329032",
"<.	c #379A37",
"[.	c #339233",
"}.	c #2D842D",
"|.	c #257325",
"                                            ",
"                                            ",
"                                            ",
"                                            ",
"                . + @ # $ %                 ",
"            & * = - ; > , ' ) !             ",
"          ~ { ] ^ / ( ( _ : < [ }           ",
"          | 1 2 3 4 4 4 4 3 5 6 7 8         ",
"        9 0 a b c d e e f g h i 0 j         ",
"        k l m n o p p q p o n r l s         ",
"        t n u v w x x x x x v y z A         ",
"        B C x w D n E E n D v F G H         ",
"        I x G l J K L M N O P y x Q         ",
"        R F z S T U V W X Y Z E x `         ",
"           .n ..+.@.#.$.%.&.*.m =.-.        ",
"          ;.>.,.'.).X X !.~.{.].^.          ",
"            ;./.P J *.*.S 0 (.^.            ",
"                _.:.(.<.[.}.|.              ",
"                                            ",
"                                            ",
"                                            ",
"                                            "};

--Boundary-00=_/E34/A9dNg3+3vB
Content-Type: image/x-xpm;
  name="roundledunchecked22x22.xpm"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
	filename="roundledunchecked22x22.xpm"

/* XPM */
static char * roundledunchecked22x22_xpm[] = {
"22 22 33 1",
" 	c None",
".	c #DCDCDC",
"+	c #E0E0E0",
"@	c #E3E3E3",
"#	c #E1E1E1",
"$	c #DDDDDD",
"%	c #D8D8D8",
"&	c #E8E8E8",
"*	c #EFEFEF",
"=	c #F4F4F4",
"-	c #F0F0F0",
";	c #E9E9E9",
">	c #E2E2E2",
",	c #D9D9D9",
"'	c #D7D7D7",
")	c #DFDFDF",
"!	c #EAEAEA",
"~	c #ECECEC",
"{	c #EEEEEE",
"]	c #EDEDED",
"^	c #DADADA",
"/	c #E7E7E7",
"(	c #DBDBDB",
"_	c #D5D5D5",
":	c #DEDEDE",
"<	c #E5E5E5",
"[	c #E6E6E6",
"}	c #E4E4E4",
"|	c #D2D2D2",
"1	c #D3D3D3",
"2	c #D4D4D4",
"3	c #D6D6D6",
"4	c #D1D1D1",
"                      ",
"                      ",
"                      ",
"                      ",
"        .+@@#$        ",
"      %#&*==-;>,      ",
"     ')&!~{{]!;#'     ",
"     ^+/;;;;;;&#(_    ",
"    %(($)+##+):.(%    ",
"    ,(^^^^^,^^^^(^    ",
"    ^^,,,%%%%%,,^^    ",
"    ,,%,,^^^^,,%,,    ",
"    '%,($)++):(,%%    ",
"    _%^$><//[>:^%_    ",
"     '^:@/;;&})^'|    ",
"     1%.+@[[}+.,1     ",
"      1'($))$(%1      ",
"        23%%'24       ",
"                      ",
"                      ",
"                      ",
"                      "};

--Boundary-00=_/E34/A9dNg3+3vB--