Blame browser/fileselect.ml

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
(* file selection box *)
Packit bd2e5d
Packit bd2e5d
open StdLabels
Packit bd2e5d
open Str
Packit bd2e5d
open Filename
Packit bd2e5d
open Tk
Packit bd2e5d
Packit bd2e5d
open Useunix
Packit bd2e5d
Packit bd2e5d
(**** Memoized rexgexp *)
Packit bd2e5d
Packit bd2e5d
let (~!) = Jg_memo.fast ~f:Str.regexp
Packit bd2e5d
Packit bd2e5d
(************************************************************ Path name *)
Packit bd2e5d
Packit bd2e5d
(* Convert Windows-style directory separator '\' to caml-style '/' *)
Packit bd2e5d
let caml_dir path =
Packit bd2e5d
  if Sys.os_type = "Win32" then
Packit bd2e5d
    global_replace ~!"\\\\" "/" path
Packit bd2e5d
  else path
Packit bd2e5d
Packit bd2e5d
let parse_filter s =
Packit bd2e5d
  let s = caml_dir s in
Packit bd2e5d
  (* replace // by / *)
Packit bd2e5d
  let s = global_replace ~!"/+" "/" s in
Packit bd2e5d
  (* replace /./ by / *)
Packit bd2e5d
  let s = global_replace ~!"/\\./" "/" s in
Packit bd2e5d
  (* replace hoge/../ by "" *)
Packit bd2e5d
  let s = global_replace
Packit bd2e5d
          ~!"\\([^/]\\|[^\\./][^/]\\|[^/][^\\./]\\|[^/][^/]+\\)/\\.\\./" "" s in
Packit bd2e5d
  (* replace hoge/..$ by *)
Packit bd2e5d
  let s = global_replace
Packit bd2e5d
          ~!"\\([^/]\\|[^\\./][^/]\\|[^/][^\\./]\\|[^/][^/]+\\)/\\.\\.$" "" s in
Packit bd2e5d
  (* replace ^/hoge/../ by / *)
Packit bd2e5d
  let s = global_replace ~!"^\\(/\\.\\.\\)+/" "/" s in
Packit bd2e5d
  if string_match ~!"^\\([^\\*?[]*[/:]\\)\\(.*\\)" s 0 then
Packit bd2e5d
    let dirs = matched_group 1 s
Packit bd2e5d
    and ptrn = matched_group 2 s
Packit bd2e5d
    in
Packit bd2e5d
      dirs, ptrn
Packit bd2e5d
  else "", s
Packit bd2e5d
Packit bd2e5d
let rec fixpoint ~f v =
Packit bd2e5d
  let v' = f v in
Packit bd2e5d
  if v = v' then v else fixpoint ~f v'
Packit bd2e5d
Packit bd2e5d
let unix_regexp s =
Packit bd2e5d
  let s = Str.global_replace ~!"[$^.+]" "\\\\\\0" s in
Packit bd2e5d
  let s = Str.global_replace ~!"\\*" ".*" s in
Packit bd2e5d
  let s = Str.global_replace ~!"\\?" ".?" s in
Packit bd2e5d
  let s =
Packit bd2e5d
    fixpoint s
Packit bd2e5d
      ~f:(Str.replace_first ~!"\\({.*\\),\\(.*}\\)" "\\1\\|\\2") in
Packit bd2e5d
  let s =
Packit bd2e5d
    Str.global_replace ~!"{\\(.*\\)}" "\\(\\1\\)" s in
Packit bd2e5d
  Str.regexp s
Packit bd2e5d
Packit bd2e5d
let exact_match ~pat s =
Packit bd2e5d
  Str.string_match pat s 0 && Str.match_end () = String.length s
Packit bd2e5d
Packit bd2e5d
let ls ~dir ~pattern =
Packit bd2e5d
  let files = get_files_in_directory dir in
Packit bd2e5d
  let regexp = unix_regexp pattern in
Packit bd2e5d
  List.filter files ~f:(exact_match ~pat:regexp)
Packit bd2e5d
Packit bd2e5d
(********************************************* Creation *)
Packit bd2e5d
let load_in_path = ref false
Packit bd2e5d
Packit bd2e5d
let search_in_path ~name = Misc.find_in_path !Config.load_path name
Packit bd2e5d
Packit bd2e5d
let f ~title ~action:proc ?(dir = Unix.getcwd ())
Packit bd2e5d
    ?filter:(deffilter ="*") ?file:(deffile ="")
Packit bd2e5d
    ?(multi=false) ?(sync=false) ?(usepath=true) () =
Packit bd2e5d
Packit bd2e5d
  let current_pattern = ref ""
Packit bd2e5d
  and current_dir = ref (caml_dir dir) in
Packit bd2e5d
Packit bd2e5d
  let may_prefix name =
Packit bd2e5d
    if Filename.is_relative name then concat !current_dir name else name in
Packit bd2e5d
Packit bd2e5d
  let tl = Jg_toplevel.titled title in
Packit bd2e5d
  Focus.set tl;
Packit bd2e5d
Packit bd2e5d
  let new_var () = Textvariable.create ~on:tl () in
Packit bd2e5d
  let filter_var = new_var ()
Packit bd2e5d
  and selection_var = new_var ()
Packit bd2e5d
  and sync_var = new_var () in
Packit bd2e5d
  Textvariable.set filter_var deffilter;
Packit bd2e5d
Packit bd2e5d
  let frm = Frame.create tl ~borderwidth:1 ~relief:`Raised in
Packit bd2e5d
    let df = Frame.create frm in
Packit bd2e5d
      let dfl = Frame.create df in
Packit bd2e5d
        let dfll = Label.create dfl ~text:"Directories" in
Packit bd2e5d
        let dflf, directory_listbox, directory_scrollbar =
Packit bd2e5d
            Jg_box.create_with_scrollbar dfl in
Packit bd2e5d
      let dfr = Frame.create df in
Packit bd2e5d
        let dfrl = Label.create dfr ~text:"Files" in
Packit bd2e5d
        let dfrf, filter_listbox, filter_scrollbar =
Packit bd2e5d
            Jg_box.create_with_scrollbar dfr in
Packit bd2e5d
  let cfrm = Frame.create tl ~borderwidth:1 ~relief:`Raised in
Packit bd2e5d
Packit bd2e5d
  let configure ~filter =
Packit bd2e5d
    let filter = may_prefix filter in
Packit bd2e5d
    let dir, pattern = parse_filter filter in
Packit bd2e5d
    let dir = if !load_in_path && usepath then "" else
Packit bd2e5d
              (current_dir := Filename.dirname dir; dir)
Packit bd2e5d
    and pattern = if pattern = "" then "*" else pattern in
Packit bd2e5d
      current_pattern := pattern;
Packit bd2e5d
    let filter =
Packit bd2e5d
        if !load_in_path && usepath then pattern else dir ^ pattern in
Packit bd2e5d
    let directories = get_directories_in_files ~path:dir
Packit bd2e5d
          (get_files_in_directory dir) in
Packit bd2e5d
    let matched_files = (* get matched file by subshell call. *)
Packit bd2e5d
      if !load_in_path && usepath then
Packit bd2e5d
      List.fold_left !Config.load_path ~init:[] ~f:
Packit bd2e5d
      begin fun acc dir ->
Packit bd2e5d
        let files = ls ~dir ~pattern in
Packit bd2e5d
        List.merge compare files
Packit bd2e5d
          (List.fold_left files ~init:acc
Packit bd2e5d
           ~f:(fun acc name -> List2.exclude name acc))
Packit bd2e5d
      end
Packit bd2e5d
      else
Packit bd2e5d
        List.fold_left directories ~init:(ls ~dir ~pattern)
Packit bd2e5d
          ~f:(fun acc dir -> List2.exclude dir acc)
Packit bd2e5d
    in
Packit bd2e5d
      Textvariable.set filter_var filter;
Packit bd2e5d
      Textvariable.set selection_var (dir ^ deffile);
Packit bd2e5d
      Listbox.delete filter_listbox ~first:(`Num 0) ~last:`End;
Packit bd2e5d
      Listbox.insert filter_listbox ~index:`End ~texts:matched_files;
Packit bd2e5d
      Jg_box.recenter filter_listbox ~index:(`Num 0);
Packit bd2e5d
      if !load_in_path && usepath then
Packit bd2e5d
        Listbox.configure directory_listbox ~takefocus:false
Packit bd2e5d
      else
Packit bd2e5d
      begin
Packit bd2e5d
        Listbox.configure directory_listbox ~takefocus:true;
Packit bd2e5d
        Listbox.delete directory_listbox ~first:(`Num 0) ~last:`End;
Packit bd2e5d
        Listbox.insert directory_listbox ~index:`End ~texts:directories;
Packit bd2e5d
        Jg_box.recenter directory_listbox ~index:(`Num 0)
Packit bd2e5d
      end
Packit bd2e5d
  in
Packit bd2e5d
Packit bd2e5d
  let selected_files = ref [] in (* used for synchronous mode *)
Packit bd2e5d
  let activate l =
Packit bd2e5d
    Grab.release tl;
Packit bd2e5d
    destroy tl;
Packit bd2e5d
    let l =
Packit bd2e5d
      if !load_in_path && usepath then
Packit bd2e5d
        List.fold_right l ~init:[] ~f:
Packit bd2e5d
        begin fun name acc ->
Packit bd2e5d
          if not (Filename.is_implicit name) then
Packit bd2e5d
            may_prefix name :: acc
Packit bd2e5d
          else try search_in_path ~name :: acc with Not_found -> acc
Packit bd2e5d
        end
Packit bd2e5d
      else
Packit bd2e5d
        List.map l ~f:may_prefix
Packit bd2e5d
    in
Packit bd2e5d
    if sync then
Packit bd2e5d
      begin
Packit bd2e5d
        selected_files := l;
Packit bd2e5d
        Textvariable.set sync_var "1"
Packit bd2e5d
      end
Packit bd2e5d
    else proc l
Packit bd2e5d
  in
Packit bd2e5d
Packit bd2e5d
  (* entries *)
Packit bd2e5d
  let fl = Label.create frm ~text:"Filter" in
Packit bd2e5d
  let sl = Label.create frm ~text:"Selection" in
Packit bd2e5d
  let filter_entry = Jg_entry.create frm ~textvariable:filter_var
Packit bd2e5d
      ~command:(fun filter -> configure ~filter) in
Packit bd2e5d
  let selection_entry = Jg_entry.create frm ~textvariable:selection_var
Packit bd2e5d
      ~command:(fun file -> activate [file]) in
Packit bd2e5d
Packit bd2e5d
  (* and buttons *)
Packit bd2e5d
  let set_path = Button.create dfl ~text:"Path editor" ~command:
Packit bd2e5d
    begin fun () ->
Packit bd2e5d
      Setpath.add_update_hook (fun () -> configure ~filter:!current_pattern);
Packit bd2e5d
      let w = Setpath.f ~dir:!current_dir in
Packit bd2e5d
      Grab.set w;
Packit bd2e5d
      bind w ~events:[`Destroy] ~extend:true ~action:(fun _ -> Grab.set tl)
Packit bd2e5d
    end in
Packit bd2e5d
  let toggle_in_path = Checkbutton.create dfl ~text:"Use load path"
Packit bd2e5d
    ~command:
Packit bd2e5d
    begin fun () ->
Packit bd2e5d
      load_in_path := not !load_in_path;
Packit bd2e5d
      if !load_in_path then
Packit bd2e5d
        pack [set_path] ~side:`Bottom ~fill:`X ~expand:true
Packit bd2e5d
      else
Packit bd2e5d
        Pack.forget [set_path];
Packit bd2e5d
      configure ~filter:(Textvariable.get filter_var)
Packit bd2e5d
    end
Packit bd2e5d
  and okb = Button.create cfrm ~text:"Ok" ~command:
Packit bd2e5d
    begin fun () ->
Packit bd2e5d
      let files =
Packit bd2e5d
        List.map (Listbox.curselection filter_listbox) ~f:
Packit bd2e5d
        begin fun x ->
Packit bd2e5d
          !current_dir ^ Listbox.get filter_listbox ~index:x
Packit bd2e5d
        end
Packit bd2e5d
      in
Packit bd2e5d
      let files = if files = [] then [Textvariable.get selection_var]
Packit bd2e5d
                                else files in
Packit bd2e5d
      activate files
Packit bd2e5d
    end
Packit bd2e5d
  and flb = Button.create cfrm ~text:"Filter"
Packit bd2e5d
      ~command:(fun () -> configure ~filter:(Textvariable.get filter_var))
Packit bd2e5d
  and ccb = Button.create cfrm ~text:"Cancel"
Packit bd2e5d
      ~command:(fun () -> activate []) in
Packit bd2e5d
Packit bd2e5d
  (* binding *)
Packit bd2e5d
  bind tl ~events:[`KeyPressDetail "Escape"] ~action:(fun _ -> activate []);
Packit bd2e5d
  Jg_box.add_completion filter_listbox
Packit bd2e5d
    ~action:(fun index -> activate [Listbox.get filter_listbox ~index]);
Packit bd2e5d
  if multi then Listbox.configure filter_listbox ~selectmode:`Multiple else
Packit bd2e5d
  bind filter_listbox ~events:[`ButtonPressDetail 1] ~fields:[`MouseY]
Packit bd2e5d
    ~action:(fun ev ->
Packit bd2e5d
      let name = Listbox.get filter_listbox
Packit bd2e5d
          ~index:(Listbox.nearest filter_listbox ~y:ev.ev_MouseY) in
Packit bd2e5d
      if !load_in_path && usepath then
Packit bd2e5d
        try Textvariable.set selection_var (search_in_path ~name)
Packit bd2e5d
        with Not_found -> ()
Packit bd2e5d
      else Textvariable.set selection_var (may_prefix name));
Packit bd2e5d
Packit bd2e5d
  Jg_box.add_completion directory_listbox ~action:
Packit bd2e5d
    begin fun index ->
Packit bd2e5d
      let filter =
Packit bd2e5d
        may_prefix (Listbox.get directory_listbox ~index) ^
Packit bd2e5d
        "/" ^ !current_pattern
Packit bd2e5d
      in configure ~filter
Packit bd2e5d
    end;
Packit bd2e5d
Packit bd2e5d
    pack [frm] ~fill:`Both ~expand:true;
Packit bd2e5d
    (* filter *)
Packit bd2e5d
    pack [fl] ~side:`Top ~anchor:`W;
Packit bd2e5d
    pack [filter_entry] ~side:`Top ~fill:`X;
Packit bd2e5d
Packit bd2e5d
    (* directory + files *)
Packit bd2e5d
    pack [df] ~side:`Top ~fill:`Both ~expand:true;
Packit bd2e5d
    (* directory *)
Packit bd2e5d
    pack [dfl] ~side:`Left ~fill:`Both ~expand:true;
Packit bd2e5d
    pack [dfll] ~side:`Top ~anchor:`W;
Packit bd2e5d
    if usepath then pack [toggle_in_path] ~side:`Bottom ~anchor:`W;
Packit bd2e5d
    pack [dflf] ~side:`Top ~fill:`Both ~expand:true;
Packit bd2e5d
    pack [directory_scrollbar] ~side:`Right ~fill:`Y;
Packit bd2e5d
    pack [directory_listbox] ~side:`Left ~fill:`Both ~expand:true;
Packit bd2e5d
    (* files *)
Packit bd2e5d
    pack [dfr] ~side:`Right ~fill:`Both ~expand:true;
Packit bd2e5d
    pack [dfrl] ~side:`Top ~anchor:`W;
Packit bd2e5d
    pack [dfrf] ~side:`Top ~fill:`Both ~expand:true;
Packit bd2e5d
    pack [filter_scrollbar] ~side:`Right ~fill:`Y;
Packit bd2e5d
    pack [filter_listbox] ~side:`Left ~fill:`Both ~expand:true;
Packit bd2e5d
Packit bd2e5d
    (* selection *)
Packit bd2e5d
    pack [sl] ~before:df ~side:`Bottom ~anchor:`W;
Packit bd2e5d
    pack [selection_entry] ~before:sl ~side:`Bottom ~fill:`X;
Packit bd2e5d
Packit bd2e5d
    (* create OK, Filter and Cancel buttons *)
Packit bd2e5d
    pack [okb; flb; ccb] ~side:`Left ~fill:`X ~expand:true;
Packit bd2e5d
    pack [cfrm] ~before:frm ~side:`Bottom ~fill:`X;
Packit bd2e5d
Packit bd2e5d
  if !load_in_path && usepath then begin
Packit bd2e5d
    load_in_path := false;
Packit bd2e5d
    Checkbutton.invoke toggle_in_path;
Packit bd2e5d
    Checkbutton.select toggle_in_path
Packit bd2e5d
  end
Packit bd2e5d
  else configure ~filter:deffilter;
Packit bd2e5d
Packit bd2e5d
    Tkwait.visibility tl;
Packit bd2e5d
    Grab.set tl;
Packit bd2e5d
Packit bd2e5d
    if sync then
Packit bd2e5d
      begin
Packit bd2e5d
        Tkwait.variable sync_var;
Packit bd2e5d
        proc !selected_files
Packit bd2e5d
      end;
Packit bd2e5d
    ()