|
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 |
(* A trick by Steve Ball to do pixel scrolling on text widgets *)
|
|
Packit |
bd2e5d |
(* USES frx_fit *)
|
|
Packit |
bd2e5d |
open Camltk
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
let create top opts navigation =
|
|
Packit |
bd2e5d |
let f = Frame.create top [BorderWidth (Pixels 2); Relief Raised] in
|
|
Packit |
bd2e5d |
let lf = Frame.create f [] in
|
|
Packit |
bd2e5d |
let rf = Frame.create f [] in
|
|
Packit |
bd2e5d |
let c = Canvas.create lf [BorderWidth (Pixels 0)]
|
|
Packit |
bd2e5d |
and xscroll = Scrollbar.create lf [Orient Horizontal]
|
|
Packit |
bd2e5d |
and yscroll = Scrollbar.create rf [Orient Vertical]
|
|
Packit |
bd2e5d |
and secret = Frame.create_named rf "secret" []
|
|
Packit |
bd2e5d |
in
|
|
Packit |
bd2e5d |
let t = Text.create c (BorderWidth(Pixels 0) :: opts) in
|
|
Packit |
bd2e5d |
if navigation then Frx_text.navigation_keys t;
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
(* Make the text widget an embedded canvas object *)
|
|
Packit |
bd2e5d |
ignore
|
|
Packit |
bd2e5d |
(Canvas.create_window c (Pixels 0) (Pixels 0)
|
|
Packit |
bd2e5d |
[Anchor NW; Window t; Tags [Tag "main"]]);
|
|
Packit |
bd2e5d |
Canvas.focus c (Tag "main");
|
|
Packit |
bd2e5d |
(*
|
|
Packit |
bd2e5d |
Canvas.configure c [Width (Pixels (Winfo.reqwidth t));
|
|
Packit |
bd2e5d |
Height(Pixels (Winfo.reqheight t))];
|
|
Packit |
bd2e5d |
*)
|
|
Packit |
bd2e5d |
Canvas.configure c [YScrollCommand (Scrollbar.set yscroll)];
|
|
Packit |
bd2e5d |
(* The horizontal scrollbar is directly attached to the
|
|
Packit |
bd2e5d |
* text widget, because h scrolling works properly *)
|
|
Packit |
bd2e5d |
Scrollbar.configure xscroll [ScrollCommand (Text.xview t)];
|
|
Packit |
bd2e5d |
(* But vertical scroll is attached to the canvas *)
|
|
Packit |
bd2e5d |
Scrollbar.configure yscroll [ScrollCommand (Canvas.yview c)];
|
|
Packit |
bd2e5d |
let scroll, check = Frx_fit.vert t in
|
|
Packit |
bd2e5d |
Text.configure t [
|
|
Packit |
bd2e5d |
XScrollCommand (Scrollbar.set xscroll);
|
|
Packit |
bd2e5d |
YScrollCommand (fun first last ->
|
|
Packit |
bd2e5d |
scroll first last;
|
|
Packit |
bd2e5d |
let x,y,w,h = Canvas.bbox c [Tag "main"] in
|
|
Packit |
bd2e5d |
Canvas.configure c
|
|
Packit |
bd2e5d |
[ScrollRegion (Pixels x, Pixels y, Pixels w, Pixels h)])
|
|
Packit |
bd2e5d |
];
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
bind c [[],Configure] (BindSet ([Ev_Width], (fun ei ->
|
|
Packit |
bd2e5d |
Canvas.configure_window c (Tag "main") [Width (Pixels ei.ev_Width)])));
|
|
Packit |
bd2e5d |
|
|
Packit |
bd2e5d |
pack [rf] [Side Side_Right; Fill Fill_Y];
|
|
Packit |
bd2e5d |
pack [lf] [Side Side_Left; Fill Fill_Both; Expand true];
|
|
Packit |
bd2e5d |
pack [secret] [Side Side_Bottom];
|
|
Packit |
bd2e5d |
pack [yscroll] [Side Side_Top; Fill Fill_Y; Expand true];
|
|
Packit |
bd2e5d |
pack [xscroll] [Side Side_Bottom; Fill Fill_X];
|
|
Packit |
bd2e5d |
pack [c] [Side Side_Left; Fill Fill_Both; Expand true];
|
|
Packit |
bd2e5d |
f, t
|