summaryrefslogtreecommitdiffstats
path: root/otherlibs/labltk
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs/labltk')
-rw-r--r--otherlibs/labltk/README16
-rw-r--r--otherlibs/labltk/compiler/compile.ml2
-rw-r--r--otherlibs/labltk/examples_camltk/eyes.ml2
-rw-r--r--otherlibs/labltk/frx/frx_mem.mli2
-rw-r--r--otherlibs/labltk/support/camltk.h4
-rw-r--r--otherlibs/labltk/support/cltkCaml.c10
-rw-r--r--otherlibs/labltk/support/cltkDMain.c2
-rw-r--r--otherlibs/labltk/support/cltkEval.c8
-rw-r--r--otherlibs/labltk/support/cltkMain.c2
-rw-r--r--otherlibs/labltk/support/cltkMisc.c2
-rw-r--r--otherlibs/labltk/support/cltkVar.c4
11 files changed, 27 insertions, 27 deletions
diff --git a/otherlibs/labltk/README b/otherlibs/labltk/README
index 5d3e9d314..6815b6669 100644
--- a/otherlibs/labltk/README
+++ b/otherlibs/labltk/README
@@ -13,11 +13,11 @@ In addition to the basic interface with Tcl/Tk, this package contains
mlTk = CamlTk + LablTk
======================
-There existed two parallel Tcl/Tk interfaces for O'Caml, CamlTk and LablTk.
+There existed two parallel Tcl/Tk interfaces for OCaml, CamlTk and LablTk.
CamlTk uses classical features only, therefore it is easy to understand for
-the beginners of ML. It makes many conservative O'Caml gurus also happy.
-LablTk, on the other hand, uses rather newer features of O'Caml, the labeled
+the beginners of ML. It makes many conservative OCaml gurus also happy.
+LablTk, on the other hand, uses rather newer features of OCaml, the labeled
optional arguments and polymorphic variants. Its syntax has much more Tcl/Tk
script flavor, but provides more powerful typing than CamlTk at the same time
(i.e. less run time type checking of widgets).
@@ -44,9 +44,9 @@ OSF/1 V4.0 (alpha), DGUX SVR4 (m88k) and Windows (VC++ and Cygwin).
INSTALLATION
============
-0. Check-out the O'Caml CVS source code tree.
+0. Check-out the OCaml CVS source code tree.
-1. Compile O'Caml (= make world). If you want, also make opt.
+1. Compile OCaml (= make world). If you want, also make opt.
2. Untar this mlTk distribution in the otherlibs directory, just like
the labltk source tree.
@@ -55,9 +55,9 @@ INSTALLATION
4. To install the library, make install (and make installopt)
-To compile mlTk, you need the O'Caml source tree, since mltk/camlbrowser
-requires some modules of O'Caml. If you are not interested in camlbrowser,
-you can compile mlTk without the O'Caml source tree, but you have to modify
+To compile mlTk, you need the OCaml source tree, since mltk/camlbrowser
+requires some modules of OCaml. If you are not interested in camlbrowser,
+you can compile mlTk without the OCaml source tree, but you have to modify
support/Makefile.common.
diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml
index 2735deb87..029cce70f 100644
--- a/otherlibs/labltk/compiler/compile.ml
+++ b/otherlibs/labltk/compiler/compile.ml
@@ -548,7 +548,7 @@ let write_TKtoCAML ~w name ~def:typdef =
(* Converters *)
(******************************)
-(* Produce an in-lined converter Caml -> Tk for simple types *)
+(* Produce an in-lined converter OCaml -> Tk for simple types *)
(* the converter is a function of type: <type> -> string *)
let rec converterCAMLtoTK ~context_widget argname ty =
match ty with
diff --git a/otherlibs/labltk/examples_camltk/eyes.ml b/otherlibs/labltk/examples_camltk/eyes.ml
index ba88af343..b7636de42 100644
--- a/otherlibs/labltk/examples_camltk/eyes.ml
+++ b/otherlibs/labltk/examples_camltk/eyes.ml
@@ -14,7 +14,7 @@
(* *)
(***********************************************************************)
-(* The eyes of Caml (CamlTk) *)
+(* The eyes of OCaml (CamlTk) *)
open Camltk;;
diff --git a/otherlibs/labltk/frx/frx_mem.mli b/otherlibs/labltk/frx/frx_mem.mli
index 4f17fa79d..190297b5e 100644
--- a/otherlibs/labltk/frx/frx_mem.mli
+++ b/otherlibs/labltk/frx/frx_mem.mli
@@ -13,7 +13,7 @@
(* described in file LICENSE found in the OCaml source tree. *)
(* *)
(***********************************************************************)
-(* A Garbage Collector Gauge for Caml *)
+(* A Garbage Collector Gauge for OCaml *)
val init : unit -> unit
(* [init ()] creates the gauge and its updater, but keeps it iconified *)
diff --git a/otherlibs/labltk/support/camltk.h b/otherlibs/labltk/support/camltk.h
index 54671a075..29452aacc 100644
--- a/otherlibs/labltk/support/camltk.h
+++ b/otherlibs/labltk/support/camltk.h
@@ -33,7 +33,7 @@
#endif
/* cltkMisc.c */
-/* copy a Caml string to the C heap. Must be deallocated with stat_free */
+/* copy an OCaml string to the C heap. Must be deallocated with stat_free */
extern char *string_to_c(value s);
/* cltkUtf.c */
@@ -45,7 +45,7 @@ CAMLTKextern Tcl_Interp *cltclinterp; /* The Tcl interpretor */
extern value copy_string_list(int argc, char **argv);
/* cltkCaml.c */
-/* pointers to Caml values */
+/* pointers to OCaml values */
extern value *tkerror_exn;
extern value *handler_code;
extern int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp,
diff --git a/otherlibs/labltk/support/cltkCaml.c b/otherlibs/labltk/support/cltkCaml.c
index f0372f14b..9a3d38a55 100644
--- a/otherlibs/labltk/support/cltkCaml.c
+++ b/otherlibs/labltk/support/cltkCaml.c
@@ -27,7 +27,7 @@
value * tkerror_exn = NULL;
value * handler_code = NULL;
-/* The Tcl command for evaluating callback in Caml */
+/* The Tcl command for evaluating callback in OCaml */
int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp,
int argc, CONST84 char **argv)
{
@@ -41,7 +41,7 @@ int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp,
return TCL_ERROR;
callback2(*handler_code,Val_int(id),
copy_string_list(argc - 2,(char **)&argv[2]));
- /* Never fails (Caml would have raised an exception) */
+ /* Never fails (OCaml would have raised an exception) */
/* but result may have been set by callback */
return TCL_OK;
}
@@ -69,14 +69,14 @@ CAMLprim void tk_error(char *errmsg)
}
-/* The initialisation of the C global variables pointing to Caml values
- must be made accessible from Caml, so that we are sure that it *always*
+/* The initialisation of the C global variables pointing to OCaml values
+ must be made accessible from OCaml, so that we are sure that it *always*
takes place during loading of the protocol module
*/
CAMLprim value camltk_init(value v)
{
- /* Initialize the Caml pointers */
+ /* Initialize the OCaml pointers */
if (tkerror_exn == NULL)
tkerror_exn = caml_named_value("tkerror");
if (handler_code == NULL)
diff --git a/otherlibs/labltk/support/cltkDMain.c b/otherlibs/labltk/support/cltkDMain.c
index 7edb92a98..04af209de 100644
--- a/otherlibs/labltk/support/cltkDMain.c
+++ b/otherlibs/labltk/support/cltkDMain.c
@@ -35,7 +35,7 @@
/*
- * Dealing with signals: when a signal handler is defined in Caml,
+ * Dealing with signals: when a signal handler is defined in OCaml,
* the actual execution of the signal handler upon reception of the
* signal is delayed until we are sure we are out of the GC.
* If a signal occurs during the MainLoop, we would have to wait
diff --git a/otherlibs/labltk/support/cltkEval.c b/otherlibs/labltk/support/cltkEval.c
index 9ec3f1476..69ba6d8a1 100644
--- a/otherlibs/labltk/support/cltkEval.c
+++ b/otherlibs/labltk/support/cltkEval.c
@@ -32,7 +32,7 @@
/* The Tcl interpretor */
Tcl_Interp *cltclinterp = NULL;
-/* Copy a list of strings from the C heap to Caml */
+/* Copy a list of strings from the C heap to OCaml */
value copy_string_list(int argc, char **argv)
{
CAMLparam0();
@@ -53,7 +53,7 @@ value copy_string_list(int argc, char **argv)
}
/*
- * Calling Tcl from Caml
+ * Calling Tcl from OCaml
* this version works on an arbitrary Tcl command,
* and does parsing and substitution
*/
@@ -65,7 +65,7 @@ CAMLprim value camltk_tcl_eval(value str)
CheckInit();
/* Tcl_Eval may write to its argument, so we take a copy
- * If the evaluation raises a Caml exception, we have a space
+ * If the evaluation raises an OCaml exception, we have a space
* leak
*/
Tcl_ResetResult(cltclinterp);
@@ -84,7 +84,7 @@ CAMLprim value camltk_tcl_eval(value str)
}
/*
- * Calling Tcl from Caml
+ * Calling Tcl from OCaml
* direct call, argument is TkArgs vect
type TkArgs =
TkToken of string
diff --git a/otherlibs/labltk/support/cltkMain.c b/otherlibs/labltk/support/cltkMain.c
index be9c907c4..8751334c5 100644
--- a/otherlibs/labltk/support/cltkMain.c
+++ b/otherlibs/labltk/support/cltkMain.c
@@ -35,7 +35,7 @@
#endif
/*
- * Dealing with signals: when a signal handler is defined in Caml,
+ * Dealing with signals: when a signal handler is defined in OCaml,
* the actual execution of the signal handler upon reception of the
* signal is delayed until we are sure we are out of the GC.
* If a signal occurs during the MainLoop, we would have to wait
diff --git a/otherlibs/labltk/support/cltkMisc.c b/otherlibs/labltk/support/cltkMisc.c
index 0e14cde81..a89ea341f 100644
--- a/otherlibs/labltk/support/cltkMisc.c
+++ b/otherlibs/labltk/support/cltkMisc.c
@@ -51,7 +51,7 @@ CAMLprim value camltk_splitlist (value v)
}
}
-/* Copy a Caml string to the C heap. Should deallocate with stat_free */
+/* Copy an OCaml string to the C heap. Should deallocate with stat_free */
char *string_to_c(value s)
{
int l = string_length(s);
diff --git a/otherlibs/labltk/support/cltkVar.c b/otherlibs/labltk/support/cltkVar.c
index a508d2288..dcda8a77c 100644
--- a/otherlibs/labltk/support/cltkVar.c
+++ b/otherlibs/labltk/support/cltkVar.c
@@ -39,7 +39,7 @@ CAMLprim value camltk_getvar(value var)
if (s == NULL)
tk_error(Tcl_GetStringResult(cltclinterp));
- else
+ else
return(tcl_string_to_caml(s));
}
@@ -51,7 +51,7 @@ CAMLprim value camltk_setvar(value var, value contents)
CheckInit();
/* SetVar makes a copy of the contents. */
- /* In case we have write traces in Caml, it's better to make sure that
+ /* In case we have write traces in OCaml, it's better to make sure that
var doesn't move... */
stable_var = string_to_c(var);
utf_contents = caml_string_to_tcl(contents);