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
|
open Tk
open Hyper
let dial hlink err =
let t = Toplevel.create Widget.default_toplevel [Class "Dialog"] in
Focus.set t;
Wm.title_set t (I18n.sprintf "Malformed link error");
let vuri = Textvariable.create_temporary t
and vcontext = Textvariable.create_temporary t in
Textvariable.set vuri hlink.h_uri;
(match hlink.h_context with
Some s -> Textvariable.set vcontext s
| None -> ());
let msg = match err with
LinkResolve s -> s
| UrlLexing (s,_) -> s in
let tit = Label.create t [Text (I18n.sprintf "Malformed link error")]
and fc,ec = Frx_entry.new_labelm_entry t "Context" vcontext
and fu,eu = Frx_entry.new_labelm_entry t "Relative" vuri
and lmsg = Label.create t [Text msg]
in
let cancelled = ref false in
let fb = Frame.create t [] in
let bok = Button.create fb
[Text "Ok"; Command (fun _ -> Grab.release t; destroy t)]
and bcancel = Button.create fb
[Text "Cancel"; Command (fun _ -> cancelled := true;
Grab.release t; destroy t)]
in
pack [bok] [Side Side_Left; Expand true];
pack [bcancel] [Side Side_Right; Expand true];
pack [tit;fc;fu;lmsg;fb] [Fill Fill_X];
Tkwait.visibility t;
Focus.set eu;
Grab.set t;
Tkwait.window t;
(* because the window gets destroyed, the variables too. *)
if !cancelled then None
else Some
{h_uri = Textvariable.get vuri;
h_context = (match Textvariable.get vcontext with
"" -> None
| s -> Some s);
h_method = hlink.h_method}
(* Utility for catching link resolving errors *)
let rec make hlink =
try
Www.make hlink
with
Invalid_link msg ->
match dial hlink msg with
None -> raise (Invalid_link msg)
| Some hlink -> make hlink
|
