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
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
let languages = [ "fr_FR"; "en_US"; "de_DE"; "ja_JP" ]
let report_error view msg =
let message = "<b><big>GtkSpell error:</big></b>\n" ^ (Glib.Markup.escape_text msg) in
let dlg = GWindow.message_dialog
~message ~use_markup:true ~message_type:`ERROR ~buttons:GWindow.Buttons.close
?parent:(GWindow.toplevel view) ~destroy_with_parent:true () in
ignore (dlg#run ()) ;
dlg#destroy ()
let set_lang_cb view lang =
prerr_endline "GtkSpell.set_language" ;
try GtkSpell.set_language view lang ; true
with GtkSpell.Error (_, msg) -> report_error view msg ; false
type button_state = {
mutable lang_id : int ;
mutable error : bool
}
let build_language_list view packing =
let (combo, _) as c = GEdit.combo_box_text ~strings:languages ~packing () in
let state = { lang_id = -1 ; error = false } in
ignore (combo#connect#changed
(fun () ->
if state.error
then state.error <- false
else
if set_lang_cb view (GEdit.text_combo_get_active c)
then state.lang_id <- combo#active
else begin
state.error <- true ;
combo#set_active state.lang_id
end)) ;
c
let attach_cb button view lang_list () =
try
if button#active
then begin
prerr_endline "GtkSpell.attach" ;
GtkSpell.attach ?lang:(GEdit.text_combo_get_active lang_list) view end
else begin
prerr_endline "GtkSpell.detach" ;
GtkSpell.detach view end
with GtkSpell.Error (_, msg) ->
button#set_active false ;
report_error view msg
let setup packing =
let box = GPack.vbox ~spacing:5 ~packing () in
let scroll = GBin.scrolled_window
~hpolicy:`AUTOMATIC
~vpolicy:`AUTOMATIC
~shadow_type:`IN
~packing:(box#pack ~expand:true) () in
let view = GText.view ~wrap_mode:`WORD ~packing:scroll#add () in
let hbox = GPack.hbox ~spacing:5 ~packing:box#pack () in
let attached = GButton.toggle_button ~label:"Attached" ~packing:hbox#pack () in
let lang_list = build_language_list view (hbox#pack ~from:`END) in
ignore (attached#connect#toggled (attach_cb attached view lang_list)) ;
()
let main =
let w = GWindow.window
~title:"GtkSpell demo"
~border_width:10
~width:400 ~height:300 () in
ignore (w#connect#destroy GMain.quit) ;
setup w#add ;
w#show () ;
GMain.main ()
|
