1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
(* This file demonstrates how one can use the tooltip API
* introduced with GTK+ 2.12.
* Do:
* ocamlc -c -I ../src tooltip.ml
* ocamlc -o tooltip.tpo -g -I . -I ../src lablgtk.cma tooltip.cmo
* ./main.tpo
*
*)
class contact
~(name: string)
() =
object (self)
method name = name
end
class account
~(name: string)
~(contacts: contact list)
() =
object (self)
method name = name
method contacts = contacts
end
let model () =
let cols = new GTree.column_list in
let column = cols#add Gobject.Data.caml in
let model = GTree.tree_store cols in
List.iter begin fun account ->
let row = model#append () in
model#set ~row ~column (`Account account);
List.iter begin fun contact ->
let row = model#append ~parent: row () in
model#set ~row ~column (`Contact contact)
end account#contacts
end
[ new account ()
~name: "Fernand Naudin"
~contacts: [ new contact () ~name: "Maître Folace"
; new contact () ~name: "Jean" ]
; new account ()
~name: "Raoul Volfoni"
~contacts: [ new contact () ~name: "Paul Volfoni" ]
];
(model, column)
let window () =
let (model, column) = model () in
let window = GWindow.window () ~title: "TreeView" in
let vbox = GPack.vbox ()
~border_width: 0
~spacing: 8
~packing: window#add in
let button = GButton.button ()
~label: "Tontons flingueurs"
~packing: vbox#add in
button#misc#set_tooltip_text "I am a tooltip text";
let sw = GBin.scrolled_window ()
~shadow_type: `ETCHED_IN
~hpolicy: `NEVER
~vpolicy: `AUTOMATIC
~packing: vbox#add in
let _ = window#connect#destroy
~callback: GMain.quit in
let treeview = GTree.view ()
~model ~packing: sw#add in
let col = GTree.view_column ()
~title: "Put the mouse over here too" in
let renderer_name = GTree.cell_renderer_text [] in
col#set_sizing `FIXED;
col#set_fixed_width 50;
col#pack renderer_name;
col#set_cell_data_func renderer_name
begin fun model row ->
match model#get ~row ~column with
| `Account account ->
let text = account#name in
renderer_name#set_properties
[ `TEXT text
; `WEIGHT `BOLD ]
| `Contact contact ->
renderer_name#set_properties
[ `TEXT contact#name
; `WEIGHT `NORMAL ] end;
ignore (treeview#append_column col);
let view_col = treeview#get_column 0 in
let button = new GButton.button
(GtkTree.TreeViewColumn.get_button view_col#as_column) in
button#misc#set_tooltip_text
"I am a tooltip on the button of a column header";
treeview#misc#set_has_tooltip true;
ignore (treeview#misc#connect#query_tooltip
~callback: begin fun ~x ~y ~kbd tooltip ->
match GtkTree.TreeView.Tooltip.get_context
treeview#as_tree_view ~x ~y ~kbd with
| (x, y, Some (model, path, row)) ->
let get ~model ~row ~column =
let v = Gobject.Value.create_empty () in
GtkTree.TreeModel.get_value
model v ~row ~column: column.GTree.index;
Gobject.Data.of_value column.GTree.conv v in
let path_string = GtkTree.TreePath.to_string path in
let name =
(* XXX: be careful to do a match on the good thing: no static type checking *)
match get ~model ~row ~column with
| `Account o -> o#name
| `Contact o -> o#name in
let str = "path=<b>" ^ path_string ^ "</b> name=<b>" ^ name ^ "</b>" in
GtkBase.Tooltip.set_markup tooltip str;
GtkTree.TreeView.Tooltip.set_row
treeview#as_tree_view tooltip path;
true
| _ -> false
end);
let _ = treeview#selection#connect#changed
~callback: begin fun () ->
GtkBase.Widget.Tooltip.trigger_query treeview#as_tree_view
end in
window#set_default_size ~width: 162 ~height: 242;
window#show ();
window#move ~x: 10 ~y: 10
let locale = GMain.init ()
let main () =
window ();
GMain.main ()
;;
main ()
|
