Blame frx/frx_text.ml

Packit bd2e5d
(***********************************************************************)
Packit bd2e5d
(*                                                                     *)
Packit bd2e5d
(*                 MLTk, Tcl/Tk interface of OCaml                     *)
Packit bd2e5d
(*                                                                     *)
Packit bd2e5d
(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
Packit bd2e5d
(*               projet Cristal, INRIA Rocquencourt                    *)
Packit bd2e5d
(*            Jacques Garrigue, Kyoto University RIMS                  *)
Packit bd2e5d
(*                                                                     *)
Packit bd2e5d
(*  Copyright 2002 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 found in the OCaml source tree.          *)
Packit bd2e5d
(*                                                                     *)
Packit bd2e5d
(***********************************************************************)
Packit bd2e5d
open Camltk
Packit bd2e5d
Packit bd2e5d
let version = "$Id$"
Packit bd2e5d
Packit bd2e5d
(*
Packit bd2e5d
 * convert an integer to an absolute index
Packit bd2e5d
*)
Packit bd2e5d
let abs_index n =
Packit bd2e5d
  TextIndex (LineChar(0,0), [CharOffset n])
Packit bd2e5d
Packit bd2e5d
let insertMark =
Packit bd2e5d
  TextIndex(Mark "insert", [])
Packit bd2e5d
Packit bd2e5d
let currentMark =
Packit bd2e5d
  TextIndex(Mark "current", [])
Packit bd2e5d
Packit bd2e5d
let textEnd =
Packit bd2e5d
  TextIndex(End, [])
Packit bd2e5d
Packit bd2e5d
let textBegin =
Packit bd2e5d
  TextIndex (LineChar(0,0), [])
Packit bd2e5d
Packit bd2e5d
(*
Packit bd2e5d
 * Link a scrollbar and a text widget
Packit bd2e5d
*)
Packit bd2e5d
let scroll_link sb tx =
Packit bd2e5d
  Text.configure tx [YScrollCommand (Scrollbar.set sb)];
Packit bd2e5d
  Scrollbar.configure sb [ScrollCommand (Text.yview tx)]
Packit bd2e5d
Packit bd2e5d
Packit bd2e5d
(*
Packit bd2e5d
 * Tk 4.0 has navigation in Text widgets, sometimes using scrolling
Packit bd2e5d
 * sometimes using the insertion mark. It is a pain to add more
Packit bd2e5d
 * compatible bindings. We do our own.
Packit bd2e5d
 *)
Packit bd2e5d
let page_up tx   =  Text.yview tx (ScrollPage (-1))
Packit bd2e5d
and page_down tx =  Text.yview tx (ScrollPage 1)
Packit bd2e5d
and line_up tx   =  Text.yview tx (ScrollUnit (-1))
Packit bd2e5d
and line_down tx =  Text.yview tx (ScrollUnit 1)
Packit bd2e5d
and top tx = Text.yview_index tx textBegin
Packit bd2e5d
and bottom tx = Text.yview_index tx textEnd
Packit bd2e5d
Packit bd2e5d
let navigation_keys tx =
Packit bd2e5d
  let tags = bindtags_get tx in
Packit bd2e5d
    match tags with
Packit bd2e5d
      (WidgetBindings t)::l when t = tx ->
Packit bd2e5d
        bindtags tx ((WidgetBindings tx) :: (TagBindings "TEXT_RO") :: l)
Packit bd2e5d
    | _ -> ()
Packit bd2e5d
Packit bd2e5d
let new_scrollable_text top options navigation =
Packit bd2e5d
  let f = Frame.create top [] in
Packit bd2e5d
  let tx = Text.create f options
Packit bd2e5d
  and sb = Scrollbar.create f [] in
Packit bd2e5d
    scroll_link sb tx;
Packit bd2e5d
    (* IN THIS ORDER -- RESIZING *)
Packit bd2e5d
    pack [sb] [Side Side_Right; Fill Fill_Y];
Packit bd2e5d
    pack [tx] [Side Side_Left; Fill Fill_Both; Expand true];
Packit bd2e5d
    if navigation then navigation_keys tx;
Packit bd2e5d
    f, tx
Packit bd2e5d
Packit bd2e5d
(*
Packit bd2e5d
 * Searching
Packit bd2e5d
 *)
Packit bd2e5d
let patternv = Frx_misc.autodef Textvariable.create
Packit bd2e5d
and casev = Frx_misc.autodef Textvariable.create
Packit bd2e5d
Packit bd2e5d
let topsearch t =
Packit bd2e5d
  (* The user interface *)
Packit bd2e5d
  let top = Toplevel.create t [Class "TextSearch"] in
Packit bd2e5d
  Wm.title_set top "Text search";
Packit bd2e5d
    let f = Frame.create_named top "fpattern" [] in
Packit bd2e5d
      let m = Label.create_named f "search" [Text "Search pattern"]
Packit bd2e5d
      and e = Entry.create_named f "pattern"
Packit bd2e5d
        [Relief Sunken; TextVariable (patternv()) ] in
Packit bd2e5d
  let hgroup = Frame.create top []
Packit bd2e5d
  and bgroup = Frame.create top [] in
Packit bd2e5d
    let fdir = Frame.create hgroup []
Packit bd2e5d
    and fmisc = Frame.create hgroup [] in
Packit bd2e5d
    let direction = Textvariable.create_temporary fdir
Packit bd2e5d
    and exactv = Textvariable.create_temporary fdir
Packit bd2e5d
    in
Packit bd2e5d
       let forw = Radiobutton.create_named fdir "forward"
Packit bd2e5d
             [Text "Forward"; Variable direction; Value "f"]
Packit bd2e5d
      and backw = Radiobutton.create_named fdir "backward"
Packit bd2e5d
             [Text "Backward"; Variable direction; Value "b"]
Packit bd2e5d
      and exact = Checkbutton.create_named fmisc "exact"
Packit bd2e5d
             [Text "Exact match"; Variable exactv]
Packit bd2e5d
      and case = Checkbutton.create_named fmisc "case"
Packit bd2e5d
             [Text "Fold Case"; Variable (casev())]
Packit bd2e5d
      and searchb = Button.create_named bgroup "search" [Text "Search"]
Packit bd2e5d
      and contb = Button.create_named bgroup "continue" [Text "Continue"]
Packit bd2e5d
      and dismissb = Button.create_named bgroup "dismiss"
Packit bd2e5d
         [Text "Dismiss";
Packit bd2e5d
         Command (fun () -> Text.tag_delete t ["search"]; destroy top)] in
Packit bd2e5d
Packit bd2e5d
      Radiobutton.invoke forw;
Packit bd2e5d
      pack [m][Side Side_Left];
Packit bd2e5d
      pack [e][Side Side_Right; Fill Fill_X; Expand true];
Packit bd2e5d
      pack [forw; backw] [Anchor W];
Packit bd2e5d
      pack [exact; case] [Anchor W];
Packit bd2e5d
      pack [fdir; fmisc] [Side Side_Left; Anchor Center];
Packit bd2e5d
      pack [searchb; contb; dismissb] [Side Side_Left; Fill Fill_X];
Packit bd2e5d
      pack [f;hgroup;bgroup] [Fill Fill_X; Expand true];
Packit bd2e5d
Packit bd2e5d
  let current_index = ref textBegin in
Packit bd2e5d
Packit bd2e5d
   let search cont = fun () ->
Packit bd2e5d
     let opts = ref [] in
Packit bd2e5d
     if Textvariable.get direction = "f" then
Packit bd2e5d
        opts := Forwards :: !opts
Packit bd2e5d
     else opts := Backwards :: !opts ;
Packit bd2e5d
     if Textvariable.get exactv = "1" then
Packit bd2e5d
       opts := Exact :: !opts;
Packit bd2e5d
     if Textvariable.get (casev()) = "1" then
Packit bd2e5d
       opts := Nocase :: !opts;
Packit bd2e5d
     try
Packit bd2e5d
       let forward = Textvariable.get direction = "f" in
Packit bd2e5d
       let i = Text.search t !opts (Entry.get e)
Packit bd2e5d
          (if cont then !current_index
Packit bd2e5d
           else if forward then textBegin
Packit bd2e5d
           else TextIndex(End, [CharOffset (-1)])) (* does not work with end *)
Packit bd2e5d
          (if forward then textEnd
Packit bd2e5d
           else textBegin) in
Packit bd2e5d
       let found = TextIndex (i, []) in
Packit bd2e5d
         current_index :=
Packit bd2e5d
           TextIndex(i, [CharOffset (if forward then 1 else (-1))]);
Packit bd2e5d
         Text.tag_delete t ["search"];
Packit bd2e5d
         Text.tag_add t "search" found (TextIndex (i, [WordEnd]));
Packit bd2e5d
         Text.tag_configure t "search"
Packit bd2e5d
                [Relief Raised; BorderWidth (Pixels 1);
Packit bd2e5d
                 Background Red];
Packit bd2e5d
         Text.see t found
Packit bd2e5d
     with
Packit bd2e5d
       Invalid_argument _ -> Bell.ring() in
Packit bd2e5d
Packit bd2e5d
   bind e [[], KeyPressDetail "Return"]
Packit bd2e5d
         (BindSet ([], fun _ -> search false ()));
Packit bd2e5d
   Button.configure searchb [Command (search false)];
Packit bd2e5d
   Button.configure contb [Command (search true)];
Packit bd2e5d
   Tkwait.visibility top;
Packit bd2e5d
   Focus.set e
Packit bd2e5d
Packit bd2e5d
let addsearch tx =
Packit bd2e5d
  let tags = bindtags_get tx in
Packit bd2e5d
    match tags with
Packit bd2e5d
      (WidgetBindings t)::l when t = tx ->
Packit bd2e5d
        bindtags tx ((WidgetBindings tx) :: (TagBindings "SEARCH") :: l)
Packit bd2e5d
    | _ -> ()
Packit bd2e5d
Packit bd2e5d
(* We use Mod1 instead of Meta or Alt *)
Packit bd2e5d
let init () =
Packit bd2e5d
  List.iter (function ev ->
Packit bd2e5d
             tag_bind "TEXT_RO" ev
Packit bd2e5d
                  (BindSetBreakable ([Ev_Widget],
Packit bd2e5d
                                 (fun ei -> page_up ei.ev_Widget; break()))))
Packit bd2e5d
           [
Packit bd2e5d
            [[], KeyPressDetail "BackSpace"];
Packit bd2e5d
            [[], KeyPressDetail "Delete"];
Packit bd2e5d
            [[], KeyPressDetail "Prior"];
Packit bd2e5d
            [[], KeyPressDetail "b"];
Packit bd2e5d
            [[Mod1], KeyPressDetail "v"]
Packit bd2e5d
           ];
Packit bd2e5d
  List.iter (function ev ->
Packit bd2e5d
             tag_bind "TEXT_RO" ev
Packit bd2e5d
                  (BindSetBreakable ([Ev_Widget],
Packit bd2e5d
                                 (fun ei -> page_down ei.ev_Widget; break()))))
Packit bd2e5d
           [
Packit bd2e5d
            [[], KeyPressDetail "space"];
Packit bd2e5d
            [[], KeyPressDetail "Next"];
Packit bd2e5d
            [[Control], KeyPressDetail "v"]
Packit bd2e5d
           ];
Packit bd2e5d
  List.iter (function ev ->
Packit bd2e5d
             tag_bind "TEXT_RO" ev
Packit bd2e5d
                  (BindSetBreakable ([Ev_Widget],
Packit bd2e5d
                                 (fun ei -> line_up ei.ev_Widget; break()))))
Packit bd2e5d
           [
Packit bd2e5d
            [[], KeyPressDetail "Up"];
Packit bd2e5d
            [[Mod1], KeyPressDetail "z"]
Packit bd2e5d
           ];
Packit bd2e5d
  List.iter (function ev ->
Packit bd2e5d
             tag_bind "TEXT_RO" ev
Packit bd2e5d
                  (BindSetBreakable ([Ev_Widget],
Packit bd2e5d
                                 (fun ei -> line_down ei.ev_Widget; break()))))
Packit bd2e5d
           [
Packit bd2e5d
            [[], KeyPressDetail "Down"];
Packit bd2e5d
            [[Control], KeyPressDetail "z"]
Packit bd2e5d
           ];
Packit bd2e5d
Packit bd2e5d
  List.iter (function ev ->
Packit bd2e5d
             tag_bind "TEXT_RO" ev
Packit bd2e5d
                  (BindSetBreakable ([Ev_Widget],
Packit bd2e5d
                                 (fun ei -> top ei.ev_Widget; break()))))
Packit bd2e5d
           [
Packit bd2e5d
            [[], KeyPressDetail "Home"];
Packit bd2e5d
            [[Mod1], KeyPressDetail "less"]
Packit bd2e5d
           ];
Packit bd2e5d
Packit bd2e5d
  List.iter (function ev ->
Packit bd2e5d
             tag_bind "TEXT_RO" ev
Packit bd2e5d
                  (BindSetBreakable ([Ev_Widget],
Packit bd2e5d
                                 (fun ei -> bottom ei.ev_Widget; break()))))
Packit bd2e5d
           [
Packit bd2e5d
            [[], KeyPressDetail "End"];
Packit bd2e5d
            [[Mod1], KeyPressDetail "greater"]
Packit bd2e5d
           ];
Packit bd2e5d
Packit bd2e5d
  List.iter (function ev ->
Packit bd2e5d
              tag_bind "SEARCH" ev
Packit bd2e5d
                   (BindSetBreakable ([Ev_Widget],
Packit bd2e5d
                             (fun ei -> topsearch ei.ev_Widget; break()))))
Packit bd2e5d
           [
Packit bd2e5d
            [[Control], KeyPressDetail "s"]
Packit bd2e5d
           ]