|
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
|