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
|
open Tk
open Printf
open Common
let prologue = Lstrings.get `prologue
class window toplevel text =
object (self)
val mutable widget = None
val on_startup = Textvariable.create ()
method display ?(title=Lstrings.get `help) ?geometry () =
match widget with
None ->
debug_msg "Creating help window from scratch";
let topwin = Toplevel.create toplevel in
let frame1 = Frame.create topwin in
let frame2 = Frame.create topwin in
let frame3 = Frame.create topwin in
let textw = Text.create frame1 in
let vscrollbar = Scrollbar.create ~command:(Text.yview textw)
~orient:`Vertical frame1 in
let hscrollbar = Scrollbar.create ~command:(Text.xview textw)
~orient:`Horizontal frame2 in
let cbutton =
Checkbutton.create ~text:(Lstrings.get `at_startup)
~variable:on_startup frame3
~command:(fun () -> SaveState.set_help_start
(Textvariable.get on_startup = "1"))
in
Text.insert ~index:(`Atxy (0,0),[]) ~text:(prologue ^ text) textw;
Text.configure ~state:`Disabled ~wrap:`None ~width:65
~yscrollcommand:(Scrollbar.set vscrollbar)
~xscrollcommand:(Scrollbar.set hscrollbar) textw;
widget <- Some topwin;
bind ~events:[`Destroy] ~action:(fun ev -> widget <- None) topwin;
Pack.configure [frame1] ~side:`Top ~fill:`Both ~expand:true;
Pack.configure [frame2] ~fill:`X ~side:`Top;
Pack.configure [frame3] ~fill:`X ~side:`Top;
Pack.configure [textw] ~side:`Left ~fill:`Both ~expand:true;
Pack.configure [vscrollbar] ~side:`Right ~fill:`Y;
Pack.configure [hscrollbar] ~fill:`X;
Pack.configure [cbutton];
Wm.title_set topwin title;
(match geometry with
None -> ()
| Some geometry -> Wm.geometry_set topwin geometry)
| Some widget ->
debug_msg "Raising help window";
Tk.raise_window widget
initializer
if SaveState.help_start
then Textvariable.set on_startup "1"
else Textvariable.set on_startup "0"
end
let help_window = ref None
let create_window toplevel text =
let window =
(match !help_window with
None ->
let win = new window toplevel text in
help_window := Some win;
win
| Some win -> win)
in
window#display ~geometry:"+0+0" ()
|
