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