1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
##ifdef CAMLTK
(* sp to avoid being picked up by doc scripts *)
type index_constrs =
CNumber
| CActiveElement
| CEnd
| CLast
| CNoIndex
| CInsert
| CSelFirst
| CSelLast
| CAt
| CAtXY
| CAnchorPoint
| CPattern
| CLineChar
| CMark
| CTagFirst
| CTagLast
| CEmbedded
;;
let index_any_table =
[CNumber; CActiveElement; CEnd; CLast; CNoIndex; CInsert; CSelFirst;
CSelLast; CAt; CAtXY; CAnchorPoint; CPattern; CLineChar;
CMark; CTagFirst; CTagLast; CEmbedded]
;;
let index_canvas_table =
[CNumber; CEnd; CInsert; CSelFirst; CSelLast; CAtXY]
;;
let index_entry_table =
[CNumber; CAnchorPoint; CEnd; CInsert; CSelFirst; CSelLast; CAt]
;;
let index_listbox_table =
[CNumber; CActiveElement; CAnchorPoint; CEnd; CAtXY]
;;
let index_menu_table =
[CNumber; CActiveElement; CEnd; CLast; CNoIndex; CAt; CPattern]
;;
let index_text_table =
[CLineChar; CAtXY; CEnd; CMark; CTagFirst; CTagLast; CEmbedded]
;;
let cCAMLtoTKindex table = function
Number x -> chk_sub "Number" table CNumber; TkToken (string_of_int x)
| ActiveElement -> chk_sub "ActiveElement" table CActiveElement; TkToken "active"
| End -> chk_sub "End" table CEnd; TkToken "end"
| Last -> chk_sub "Last" table CLast; TkToken "last"
| NoIndex -> chk_sub "NoIndex" table CNoIndex; TkToken "none"
| Insert -> chk_sub "Insert" table CInsert; TkToken "insert"
| SelFirst -> chk_sub "SelFirst" table CSelFirst; TkToken "sel.first"
| SelLast -> chk_sub "SelLast" table CSelLast; TkToken "sel.last"
| At n -> chk_sub "At" table CAt; TkToken ("@"^string_of_int n)
| AtXY (x,y) -> chk_sub "AtXY" table CAtXY;
TkToken ("@"^string_of_int x^","^string_of_int y)
| AnchorPoint -> chk_sub "AnchorPoint" table CAnchorPoint; TkToken "anchor"
| Pattern s -> chk_sub "Pattern" table CPattern; TkToken s
| LineChar (l,c) -> chk_sub "LineChar" table CLineChar;
TkToken (string_of_int l^"."^string_of_int c)
| Mark s -> chk_sub "Mark" table CMark; TkToken s
| TagFirst t -> chk_sub "TagFirst" table CTagFirst;
TkToken (t^".first")
| TagLast t -> chk_sub "TagLast" table CTagLast;
TkToken (t^".last")
| Embedded w -> chk_sub "Embedded" table CEmbedded;
cCAMLtoTKwidget widget_any_table w
;;
let char_index c s =
let rec find i =
if i >= String.length s
then raise Not_found
else if String.get s i = c then i
else find (i+1) in
find 0
;;
(* Assume returned values are only numerical and l.c *)
(* .menu index returns none if arg is none, but blast it *)
let cTKtoCAMLindex s =
try
let p = char_index '.' s in
LineChar(int_of_string (String.sub s 0 p),
int_of_string (String.sub s (p+1) (String.length s - p - 1)))
with
Not_found ->
try Number (int_of_string s)
with _ -> raise (Invalid_argument ("TKtoCAMLindex: "^s))
;;
##else
let cCAMLtoTKindex (* Don't put explicit typing *) = function
| `Num x -> TkToken (string_of_int x)
| `Active -> TkToken "active"
| `End -> TkToken "end"
| `Last -> TkToken "last"
| `None -> TkToken "none"
| `Insert -> TkToken "insert"
| `Selfirst -> TkToken "sel.first"
| `Sellast -> TkToken "sel.last"
| `At n -> TkToken ("@" ^ string_of_int n)
| `Atxy (x,y) -> TkToken ("@" ^ string_of_int x ^ "," ^ string_of_int y)
| `Anchor -> TkToken "anchor"
| `Pattern s -> TkToken s
| `Linechar (l,c) -> TkToken (string_of_int l ^ "." ^ string_of_int c)
| `Mark s -> TkToken s
| `Tagfirst t -> TkToken (t ^ ".first")
| `Taglast t -> TkToken (t ^ ".last")
| `Window (w : any widget) -> cCAMLtoTKwidget w
| `Image s -> TkToken s
;;
let cCAMLtoTKcanvas_index = (cCAMLtoTKindex : canvas_index -> tkArgs);;
let cCAMLtoTKentry_index = (cCAMLtoTKindex : entry_index -> tkArgs);;
let cCAMLtoTKlistbox_index = (cCAMLtoTKindex : listbox_index -> tkArgs);;
let cCAMLtoTKmenu_index = (cCAMLtoTKindex : menu_index -> tkArgs);;
let cCAMLtoTKtext_index = (cCAMLtoTKindex : text_index -> tkArgs);;
(* Assume returned values are only numerical and l.c *)
let cTKtoCAMLtext_index s =
try
let p = String.index s '.' in
`Linechar (int_of_string (String.sub s ~pos:0 ~len:p),
int_of_string (String.sub s ~pos:(p + 1)
~len:(String.length s - p - 1)))
with
Not_found ->
raise (Invalid_argument ("TKtoCAMLtext_index: " ^ s))
;;
let cTKtoCAMLlistbox_index s =
try `Num (int_of_string s)
with _ -> raise (Invalid_argument ("TKtoCAMLlistbox_index: " ^ s))
;;
##endif
|
