ocaml/otherlibs/labltk/frx/frx_selection.ml

46 lines
2.0 KiB
OCaml

(***********************************************************************)
(* *)
(* MLTk, Tcl/Tk interface of OCaml *)
(* *)
(* Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis *)
(* projet Cristal, INRIA Rocquencourt *)
(* Jacques Garrigue, Kyoto University RIMS *)
(* *)
(* Copyright 2002 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 found in the OCaml source tree. *)
(* *)
(***********************************************************************)
(* A selection handler *)
open Widget
open Protocol
open Camltk
let frame = ref None
let selection = ref ""
let read ofs n =
let res =
if ofs < 0 then ""
else if ofs + n > String.length !selection
then String.sub !selection ofs (String.length !selection - ofs)
else String.sub !selection ofs n in
tkreturn res
(* As long as we don't loose the selection, we keep the widget *)
(* Calling this function means that we own the selection *)
(* When we loose the selection, both cb are destroyed *)
let own () =
match !frame with
None ->
let f = Frame.create_named Widget.default_toplevel "frx_selection" [] in
let lost () = selection := ""; destroy f; frame := None in
Selection.own_set [Selection "PRIMARY"; LostCommand lost] f;
Selection.handle_set [Selection "PRIMARY"; ICCCMType "STRING"] f read;
frame := Some f
| Some f -> ()
let set s = own(); selection := s