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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
| open GMain
open GtkTree
open Gobject.Data
open StdLabels
(*let abrLex = new Arbre_lexical.abrLex *)
let toplevel = ref [""]
type data = {
col_text : string GTree.column;
list_store : GTree.list_store; (* List store. *)
}
type area = {
frame : GObj.widget; (* Popup frame. *)
scroll : GBin.scrolled_window;
tree_view : GTree.view;
}
type t = {
data : data;
area : area;
vcol : GTree.view_column;
source : GSourceView2.source_view;
buffer : GSourceView2.source_buffer
}
(* Some getters to hide the implementation in the code below. *)
let col_text t = t.data.col_text
let source t = t.source
let buffer t = t.buffer
let frame t = t.area.frame
let scroll t = t.area.scroll
let tree_view t = t.area.tree_view
let list_store t = t.data.list_store
let view_col t = t.vcol
module Popup =
struct
(* Show popup *)
let show =
fun t (x, y) ->
let child = frame t in
(source t)#move_child ~child ~x ~y;
child#misc#show ()
(* Hide popup and clear contents.*)
let hide t _ =
(frame t)#misc#hide ();
false
end
let cols = new GTree.column_list
let name = cols#add string
let create_store () =
let list_store = GTree.list_store cols in
List.iter !toplevel ~f:
begin fun n ->
let row = list_store#append () in
list_store#set ~row ~column:name n;
end;
list_store
let failure n fmt =
Printf.ksprintf (fun msg ->
Printf.eprintf "%s.\n%!" msg;
exit n
) ("(Aurora) Error: " ^^ fmt)
(* Get selected iter. *)
let get_selected_iter t =
match (tree_view t)#selection#get_selected_rows with
| path :: _ -> (list_store t)#get_iter path
| [] ->
match (list_store t)#get_iter_first with
| Some iter -> iter
| _ -> failure 8 "empty"
let add_columns ~(view : GTree.view) =
let renderer = GTree.cell_renderer_text [`XALIGN 0.] in
let vc =
GTree.view_column ~renderer:(renderer, ["text", name]) ()
in
view#append_column vc
(* Try to determine the best popup coordinates. *)
let best_coord t =
let r1 = (source t)#get_iter_location ((buffer t)#get_iter `INSERT)
and r2 = (source t)#visible_rect in
if Gdk.Rectangle.width r2 > 300 && Gdk.Rectangle.height r2 > 100 then (
let x = Gdk.Rectangle.x r1 - Gdk.Rectangle.x r2
and y = Gdk.Rectangle.y r1 - Gdk.Rectangle.y r2 + 14 in
Some ((x - if x + 280 >= Gdk.Rectangle.width r2 then 280 else 0),
(y - if y + 100 >= Gdk.Rectangle.height r2 then 114 else 0))
) else None
(* show popup. *)
let word = ref ""
let replace = ref ""
let check_input t=
let stop = (buffer t)#get_iter `INSERT in
if stop#ends_word
then
(
let start = stop#backward_word_start#backward_char in
word := (buffer t)#get_text ~start ~stop ();
(
if((String.get !word 0) = ' ')
then word := String.sub !word 1 ((String.length !word)-1)
);
if((List.length !toplevel) <> 0)
then(Gaux.may (Popup.show t) (best_coord t))
)
else if (frame t)#misc#visible then ignore (Popup.hide t ())
(* hide popup. *)
let finalize t _ =
let row = get_selected_iter t in
let stop = (buffer t)#get_iter `INSERT in
let start = stop#backward_word_start#backward_char in
(buffer t)#delete ~start ~stop;
replace := (list_store t)#get ~row ~column:(col_text t);
(* c'est sur la ligne précédente que j'ai un problème *)
(buffer t)#insert (" "^(!replace));
Popup.hide t ()
let add_word word t=
let row = (list_store t)#append () in
(list_store t)#set ~row ~column:name word
let addArbreLex t =
(list_store t)#clear ();
toplevel := ["test";"toto";"why this fucking row is unreachable ?"];
List.iter (fun e -> add_word e t) !toplevel
(*let on_row_activated t (view:GTree.view) path column =
let model = view#model in
let row = model#get_iter path in
replace := model#get ~row ~column:name;
print_endline !replace;
let _ = (finalize t ()) in ()
*)
(* Choose action when a key is pressed. *)
let select_action t ev =
addArbreLex t;
if ((List.length !toplevel <> 0) && (frame t)#misc#visible) then (
let here = (list_store t)#get_path (get_selected_iter t) in
match GdkEvent.Key.keyval ev with
| 0xFF52 (* Up arrow *) -> let _ = GTree.Path.prev here in
let _ = (tree_view t)#set_cursor here (view_col t) in true
| 0xFF54 (* Down arrow *) ->let _ = GTree.Path.next here in
let _ = (tree_view t)#set_cursor here (view_col t) in
let _ = GTree.Path.next here in true
| 0xFF0D | 0xFF8D (* Entry *) -> not (finalize t ())
| 0xFF1B | 0xFF08 | 0xFF9A | 0xFF9B | 0xFF95
| 0xFF96 | 0xFF98 | 0xFF51 | 0xFF53 -> Popup.hide t ()
| _ -> false
) else false
(* Tree view data. *)
let get_data () =
let cols = new GTree.column_list in
let col_text = cols#add Gobject.Data.string in
let store = create_store () in
{col_text = col_text; list_store = store }
(* Tree view cell renderers and columns. *)
let get_view data =
let cell_text = GTree.cell_renderer_text [`XPAD 5] in
let vcol = GTree.view_column () in
vcol#pack cell_text;
vcol#add_attribute cell_text "markup" data.col_text;
vcol
let get_area data vcol =
let scroll = GBin.scrolled_window ~width:250 ~height:150 ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC
~vpolicy:`AUTOMATIC ~show:false () in
let view = GTree.view
~model:data.list_store
~headers_visible:false
~rules_hint:true
~packing:scroll#add () in
let _ = view#append_column vcol in
let _ = view#set_hover_selection true in
{ frame = scroll#coerce; scroll = scroll; tree_view = view }
(* Main function. *)
let add edit (source : GSourceView2.source_view) =
let data = get_data () in
let vcol = get_view data in
let area = get_area data vcol in
source#add_child_in_window ~child:area.frame ~which_window:`TEXT ~x:0 ~y:0;
let buffer = source#source_buffer in
let t = { data = data; vcol = vcol; area = area; source = source; buffer = buffer } in
(* let _ = (tree_view t)#connect#row_activated ~callback:
(on_row_activated t (tree_view t)) in*)
let _ = buffer#connect#changed (fun () -> check_input t) in
let _ = (tree_view t)#event#connect#button_release (finalize t) in
let connect = source#event#connect in
let _ = connect#key_press (select_action t) in
let _ = connect#button_press (Popup.hide t) in
let _ =connect#scroll (Popup.hide t) in
t
let mainWindow = GWindow.window
~width:800
~height:600
~position:`CENTER
~resizable:true
~title:"Aurora" ()
let source_view = GSourceView2.source_view
~packing:mainWindow#add ()
let _ =
GMain.init ();
mainWindow#show ();
add false source_view;
GMain.main () |
Popup personnalisé en LablGtk
Répondre avec citation
Partager