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
|
(*************************************************************************)
(* *)
(* OCaml LablTk library *)
(* *)
(* Jacques Garrigue, Kyoto University RIMS *)
(* *)
(* Copyright 1999 Institut National de Recherche en Informatique et *)
(* en Automatique and Kyoto University. All rights reserved. *)
(* This file is distributed under the terms of the GNU Library *)
(* General Public License, with the special exception on linking *)
(* described in file ../../../LICENSE. *)
(* *)
(*************************************************************************)
(* $Id$ *)
open StdLabels
open Tk
(* Listboxes *)
let update_hooks = ref []
let add_update_hook f = update_hooks := f :: !update_hooks
let exec_update_hooks () =
update_hooks := List.filter !update_hooks ~f:
begin fun f ->
try f (); true
with Protocol.TkError _ -> false
end
let set_load_path l =
Load_path.init ~visible:l ~auto_include:Load_path.no_auto_include ~hidden:[];
exec_update_hooks ();
Env.reset_cache ()
let get_load_path () = Load_path.get_path_list ()
let renew_dirs box ~var ~dir =
Textvariable.set var dir;
Listbox.delete box ~first:(`Num 0) ~last:`End;
Listbox.insert box ~index:`End
~texts:(Useunix.get_directories_in_files ~path:dir
(Useunix.get_files_in_directory dir));
Jg_box.recenter box ~index:(`Num 0)
let renew_path box =
Listbox.delete box ~first:(`Num 0) ~last:`End;
Listbox.insert box ~index:`End ~texts:(Load_path.get_path_list ());
Jg_box.recenter box ~index:(`Num 0)
let add_to_path ~dirs ?(base="") box =
let dirs =
if base = "" then dirs else
if dirs = [] then [base] else
List.map dirs ~f:
begin function
"." -> base
| ".." -> Filename.dirname base
| x -> Filename.concat base x
end
in
set_load_path
(dirs @ List.fold_left dirs ~init:(get_load_path ())
~f:(fun acc x -> List2.exclude x acc))
let remove_path box ~dirs =
set_load_path
(List.fold_left dirs ~init:(get_load_path ())
~f:(fun acc x -> List2.exclude x acc))
(* main function *)
let f ~dir =
let current_dir = ref dir in
let tl = Jg_toplevel.titled "Edit Load Path" in
Jg_bind.escape_destroy tl;
let var_dir = Textvariable.create ~on:tl () in
let caplab = Label.create tl ~text:"Path"
and dir_name = Entry.create tl ~textvariable:var_dir
and browse = Frame.create tl in
let dirs = Frame.create browse
and path = Frame.create browse in
let dirframe, dirbox, dirsb = Jg_box.create_with_scrollbar dirs
and pathframe, pathbox, pathsb = Jg_box.create_with_scrollbar path
in
add_update_hook (fun () -> renew_path pathbox);
Listbox.configure pathbox ~width:40 ~selectmode:`Multiple;
Listbox.configure dirbox ~selectmode:`Multiple;
Jg_box.add_completion dirbox ~action:
begin fun index ->
begin match Listbox.get dirbox ~index with
"." -> ()
| ".." -> current_dir := Filename.dirname !current_dir
| x -> current_dir := !current_dir ^ "/" ^ x
end;
renew_dirs dirbox ~var:var_dir ~dir:!current_dir;
Listbox.selection_clear dirbox ~first:(`Num 0) ~last:`End
end;
Jg_box.add_completion pathbox ~action:
begin fun index ->
current_dir := Listbox.get pathbox ~index;
renew_dirs dirbox ~var:var_dir ~dir:!current_dir
end;
bind dir_name ~events:[`KeyPressDetail"Return"]
~action:(fun _ ->
let dir = Textvariable.get var_dir in
if Useunix.is_directory dir then begin
current_dir := dir;
renew_dirs dirbox ~var:var_dir ~dir
end);
(* Avoid space being used by the completion mechanism *)
let bind_space_toggle lb =
bind lb ~events:[`KeyPressDetail "space"] ~extend:true ~action:ignore in
bind_space_toggle dirbox;
bind_space_toggle pathbox;
let add_paths _ =
add_to_path pathbox ~base:!current_dir
~dirs:(List.map (Listbox.curselection dirbox)
~f:(fun x -> Listbox.get dirbox ~index:x));
Listbox.selection_clear dirbox ~first:(`Num 0) ~last:`End
and remove_paths _ =
remove_path pathbox
~dirs:(List.map (Listbox.curselection pathbox)
~f:(fun x -> Listbox.get pathbox ~index:x))
in
bind dirbox ~events:[`KeyPressDetail "Insert"] ~action:add_paths;
bind pathbox ~events:[`KeyPressDetail "Delete"] ~action:remove_paths;
let dirlab = Label.create dirs ~text:"Directories"
and pathlab = Label.create path ~text:"Load path"
and addbutton = Button.create dirs ~text:"Add to path" ~command:add_paths
and pathbuttons = Frame.create path in
let removebutton =
Button.create pathbuttons ~text:"Remove from path" ~command:remove_paths
and ok =
Jg_button.create_destroyer tl ~parent:pathbuttons
in
renew_dirs dirbox ~var:var_dir ~dir:!current_dir;
renew_path pathbox;
pack [dirsb] ~side:`Right ~fill:`Y;
pack [dirbox] ~side:`Left ~fill:`Y ~expand:true;
pack [pathsb] ~side:`Right ~fill:`Y;
pack [pathbox] ~side:`Left ~fill:`Both ~expand:true;
pack [dirlab] ~side:`Top ~anchor:`W ~padx:10;
pack [addbutton] ~side:`Bottom ~fill:`X;
pack [dirframe] ~fill:`Y ~expand:true;
pack [pathlab] ~side:`Top ~anchor:`W ~padx:10;
pack [removebutton; ok] ~side:`Left ~fill:`X ~expand:true;
pack [pathbuttons] ~fill:`X ~side:`Bottom;
pack [pathframe] ~fill:`Both ~expand:true;
pack [dirs] ~side:`Left ~fill:`Y;
pack [path] ~side:`Right ~fill:`Both ~expand:true;
pack [caplab] ~side:`Top ~anchor:`W ~padx:10;
pack [dir_name] ~side:`Top ~anchor:`W ~fill:`X;
pack [browse] ~side:`Bottom ~expand:true ~fill:`Both;
tl
let set ~dir = ignore (f ~dir);;
|
