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 () |
Partager