blob: 2477e9acc4effcf03c6a431b92e0ef1c2412465a (
plain)
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
|
(* $Id$ *)
open Tk
open Jg_tk
let get_all tw = Text.get tw start:tstart end:(tposend 1)
let tag_and_see tw :tag :start end:e =
Text.tag_remove tw start:(tpos 0) end:tend :tag;
Text.tag_add tw :start end:e :tag;
try
Text.see tw index:(`Tagfirst tag, []);
Text.mark_set tw mark:"insert" index:(`Tagfirst tag, [])
with Protocol.TkError _ -> ()
let output tw :buffer :pos :len =
Text.insert tw index:tend text:(String.sub buffer :pos :len)
let add_scrollbar tw =
let sb = Scrollbar.create parent:(Winfo.parent tw) command:(Text.yview tw) ()
in Text.configure tw yscrollcommand:(Scrollbar.set sb); sb
let create_with_scrollbar :parent =
let frame = Frame.create :parent () in
let tw = Text.create parent:frame () in
frame, tw, add_scrollbar tw
let goto_tag tw :tag =
let index = (`Tagfirst tag, []) in
try Text.see tw :index;
Text.mark_set tw :index mark:"insert"
with Protocol.TkError _ -> ()
let search_string tw =
let tl = Jg_toplevel.titled "Search" in
Wm.transient_set tl master:Widget.default_toplevel;
let fi = Frame.create parent:tl ()
and fd = Frame.create parent:tl ()
and fm = Frame.create parent:tl ()
and buttons = Frame.create parent:tl ()
and direction = Textvariable.create on:tl ()
and mode = Textvariable.create on:tl ()
and count = Textvariable.create on:tl ()
in
let label = Label.create parent:fi text:"Pattern:" ()
and text = Entry.create parent:fi width:20 ()
and back = Radiobutton.create parent:fd variable:direction
text:"Backwards" value:"backward" ()
and forw = Radiobutton.create parent:fd variable:direction
text:"Forwards" value:"forward" ()
and exact = Radiobutton.create parent:fm variable:mode
text:"Exact" value:"exact" ()
and nocase = Radiobutton.create parent:fm variable:mode
text:"No case" value:"nocase" ()
and regexp = Radiobutton.create parent:fm variable:mode
text:"Regexp" value:"regexp" ()
in
let search = Button.create parent:buttons text:"Search" () command:
begin fun () ->
try
let pattern = Entry.get text in
let dir, ofs = match Textvariable.get direction with
"forward" -> `Forwards, 1
| "backward" -> `Backwards, -1
and mode = match Textvariable.get mode with "exact" -> [`Exact]
| "nocase" -> [`Nocase] | "regexp" -> [`Regexp] | _ -> []
in
let ndx =
Text.search tw :pattern switches:([dir;`Count count] @ mode)
start:(`Mark "insert", [`Char ofs])
in
tag_and_see tw tag:"sel" start:(ndx,[])
end:(ndx,[`Char(int_of_string (Textvariable.get count))])
with Invalid_argument _ -> ()
end
and ok = Jg_button.create_destroyer tl parent:buttons text:"Cancel" in
Focus.set text;
Jg_bind.return_invoke text button:search;
Jg_bind.escape_destroy tl;
Textvariable.set direction to:"forward";
Textvariable.set mode to:"nocase";
pack [label] side:`Left;
pack [text] side:`Right fill:`X expand:true;
pack [back; forw] side:`Left;
pack [exact; nocase; regexp] side:`Left;
pack [search; ok] side:`Left fill:`X expand:true;
pack [fi; fd; fm; buttons] side:`Top fill:`X
|
