Blame builtin/builtini_index.ml

Packit bd2e5d
##ifdef CAMLTK
Packit bd2e5d
Packit bd2e5d
(* sp to avoid being picked up by doc scripts *)
Packit bd2e5d
 type index_constrs =
Packit bd2e5d
          CNumber
Packit bd2e5d
        | CActiveElement
Packit bd2e5d
        | CEnd
Packit bd2e5d
        | CLast
Packit bd2e5d
        | CNoIndex
Packit bd2e5d
        | CInsert
Packit bd2e5d
        | CSelFirst
Packit bd2e5d
        | CSelLast
Packit bd2e5d
        | CAt
Packit bd2e5d
        | CAtXY
Packit bd2e5d
        | CAnchorPoint
Packit bd2e5d
        | CPattern
Packit bd2e5d
        | CLineChar
Packit bd2e5d
        | CMark
Packit bd2e5d
        | CTagFirst
Packit bd2e5d
        | CTagLast
Packit bd2e5d
        | CEmbedded
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
let index_any_table =
Packit bd2e5d
 [CNumber; CActiveElement; CEnd; CLast; CNoIndex; CInsert; CSelFirst;
Packit bd2e5d
  CSelLast; CAt; CAtXY; CAnchorPoint; CPattern; CLineChar;
Packit bd2e5d
  CMark; CTagFirst; CTagLast; CEmbedded]
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
let index_canvas_table =
Packit bd2e5d
  [CNumber; CEnd; CInsert; CSelFirst; CSelLast; CAtXY]
Packit bd2e5d
;;
Packit bd2e5d
let index_entry_table =
Packit bd2e5d
  [CNumber; CAnchorPoint; CEnd; CInsert; CSelFirst; CSelLast; CAt]
Packit bd2e5d
;;
Packit bd2e5d
let index_listbox_table =
Packit bd2e5d
  [CNumber; CActiveElement; CAnchorPoint; CEnd; CAtXY]
Packit bd2e5d
;;
Packit bd2e5d
let index_menu_table =
Packit bd2e5d
  [CNumber; CActiveElement; CEnd; CLast; CNoIndex; CAt; CPattern]
Packit bd2e5d
;;
Packit bd2e5d
let index_text_table =
Packit bd2e5d
  [CLineChar; CAtXY; CEnd; CMark; CTagFirst; CTagLast; CEmbedded]
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
let cCAMLtoTKindex table = function
Packit bd2e5d
   Number x -> chk_sub "Number" table CNumber; TkToken (string_of_int x)
Packit bd2e5d
 | ActiveElement -> chk_sub "ActiveElement" table CActiveElement; TkToken "active"
Packit bd2e5d
 | End -> chk_sub "End" table CEnd; TkToken "end"
Packit bd2e5d
 | Last -> chk_sub "Last" table CLast; TkToken "last"
Packit bd2e5d
 | NoIndex -> chk_sub "NoIndex" table CNoIndex; TkToken "none"
Packit bd2e5d
 | Insert -> chk_sub "Insert" table CInsert; TkToken "insert"
Packit bd2e5d
 | SelFirst -> chk_sub "SelFirst" table CSelFirst; TkToken "sel.first"
Packit bd2e5d
 | SelLast -> chk_sub "SelLast" table CSelLast; TkToken "sel.last"
Packit bd2e5d
 | At n -> chk_sub "At" table CAt; TkToken ("@"^string_of_int n)
Packit bd2e5d
 | AtXY (x,y) -> chk_sub "AtXY" table CAtXY;
Packit bd2e5d
             TkToken ("@"^string_of_int x^","^string_of_int y)
Packit bd2e5d
 | AnchorPoint -> chk_sub "AnchorPoint" table CAnchorPoint; TkToken "anchor"
Packit bd2e5d
 | Pattern s -> chk_sub "Pattern" table CPattern; TkToken s
Packit bd2e5d
 | LineChar (l,c) -> chk_sub "LineChar" table CLineChar;
Packit bd2e5d
          TkToken (string_of_int l^"."^string_of_int c)
Packit bd2e5d
 | Mark s -> chk_sub "Mark" table CMark; TkToken s
Packit bd2e5d
 | TagFirst t -> chk_sub "TagFirst" table CTagFirst;
Packit bd2e5d
           TkToken (t^".first")
Packit bd2e5d
 | TagLast t -> chk_sub "TagLast" table CTagLast;
Packit bd2e5d
           TkToken (t^".last")
Packit bd2e5d
 | Embedded w -> chk_sub "Embedded" table CEmbedded;
Packit bd2e5d
           cCAMLtoTKwidget widget_any_table w
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
let char_index c s =
Packit bd2e5d
  let rec find i =
Packit bd2e5d
    if i >= String.length s
Packit bd2e5d
    then raise Not_found
Packit bd2e5d
    else if String.get s i = c then i
Packit bd2e5d
    else find (i+1) in
Packit bd2e5d
  find 0
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
(* Assume returned values are only numerical and l.c *)
Packit bd2e5d
(* .menu index returns none if arg is none, but blast it *)
Packit bd2e5d
let cTKtoCAMLindex s =
Packit bd2e5d
  try
Packit bd2e5d
   let p = char_index '.' s in
Packit bd2e5d
    LineChar(int_of_string (String.sub s 0 p),
Packit bd2e5d
             int_of_string (String.sub s (p+1) (String.length s - p - 1)))
Packit bd2e5d
  with
Packit bd2e5d
    Not_found ->
Packit bd2e5d
      try Number (int_of_string s)
Packit bd2e5d
      with _ -> raise (Invalid_argument ("TKtoCAMLindex: "^s))
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
##else
Packit bd2e5d
Packit bd2e5d
let cCAMLtoTKindex (* Don't put explicit typing *) = function
Packit bd2e5d
 | `Num x -> TkToken (string_of_int x)
Packit bd2e5d
 | `Active -> TkToken "active"
Packit bd2e5d
 | `End -> TkToken "end"
Packit bd2e5d
 | `Last -> TkToken "last"
Packit bd2e5d
 | `None -> TkToken "none"
Packit bd2e5d
 | `Insert -> TkToken "insert"
Packit bd2e5d
 | `Selfirst -> TkToken "sel.first"
Packit bd2e5d
 | `Sellast -> TkToken "sel.last"
Packit bd2e5d
 | `At n -> TkToken ("@" ^ string_of_int n)
Packit bd2e5d
 | `Atxy (x,y) -> TkToken ("@" ^ string_of_int x ^ "," ^ string_of_int y)
Packit bd2e5d
 | `Anchor -> TkToken "anchor"
Packit bd2e5d
 | `Pattern s -> TkToken s
Packit bd2e5d
 | `Linechar (l,c) -> TkToken (string_of_int l ^ "." ^ string_of_int c)
Packit bd2e5d
 | `Mark s -> TkToken s
Packit bd2e5d
 | `Tagfirst t -> TkToken (t ^ ".first")
Packit bd2e5d
 | `Taglast t -> TkToken (t ^ ".last")
Packit bd2e5d
 | `Window (w : any widget) -> cCAMLtoTKwidget w
Packit bd2e5d
 | `Image s -> TkToken s
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
let cCAMLtoTKcanvas_index = (cCAMLtoTKindex : canvas_index -> tkArgs);;
Packit bd2e5d
let cCAMLtoTKentry_index = (cCAMLtoTKindex : entry_index -> tkArgs);;
Packit bd2e5d
let cCAMLtoTKlistbox_index = (cCAMLtoTKindex : listbox_index -> tkArgs);;
Packit bd2e5d
let cCAMLtoTKmenu_index = (cCAMLtoTKindex : menu_index -> tkArgs);;
Packit bd2e5d
let cCAMLtoTKtext_index = (cCAMLtoTKindex : text_index -> tkArgs);;
Packit bd2e5d
Packit bd2e5d
(* Assume returned values are only numerical and l.c *)
Packit bd2e5d
Packit bd2e5d
let cTKtoCAMLtext_index s =
Packit bd2e5d
  try
Packit bd2e5d
   let p = String.index s '.' in
Packit bd2e5d
    `Linechar (int_of_string (String.sub s ~pos:0 ~len:p),
Packit bd2e5d
             int_of_string (String.sub s ~pos:(p + 1)
Packit bd2e5d
                                         ~len:(String.length s - p - 1)))
Packit bd2e5d
  with
Packit bd2e5d
    Not_found ->
Packit bd2e5d
      raise (Invalid_argument ("TKtoCAMLtext_index: " ^ s))
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
let cTKtoCAMLlistbox_index s =
Packit bd2e5d
  try `Num (int_of_string s)
Packit bd2e5d
  with _ -> raise (Invalid_argument ("TKtoCAMLlistbox_index: " ^ s))
Packit bd2e5d
;;
Packit bd2e5d
Packit bd2e5d
##endif