summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJacques Garrigue <garrigue at math.nagoya-u.ac.jp>1999-12-07 15:01:12 +0000
committerJacques Garrigue <garrigue at math.nagoya-u.ac.jp>1999-12-07 15:01:12 +0000
commitaa78984afcb46226cbc35922af41ff79278a237a (patch)
treeea46e4d7c75c737e75d06b7e19824696bfb15b6f
parentbacf15f6140b9f78230fcd06058e2934cfdea067 (diff)
changed syntax for default values and some labels
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@2674 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat
-rw-r--r--otherlibs/labltk/browser/editor.ml26
-rw-r--r--otherlibs/labltk/browser/fileselect.ml49
-rw-r--r--otherlibs/labltk/browser/jg_button.ml2
-rw-r--r--otherlibs/labltk/browser/jg_completion.ml2
-rw-r--r--otherlibs/labltk/browser/jg_menu.ml4
-rw-r--r--otherlibs/labltk/browser/jg_message.ml2
-rw-r--r--otherlibs/labltk/browser/jg_multibox.ml2
-rw-r--r--otherlibs/labltk/browser/jg_text.ml5
-rw-r--r--otherlibs/labltk/browser/jg_text.mli2
-rw-r--r--otherlibs/labltk/browser/lexical.ml2
-rw-r--r--otherlibs/labltk/browser/searchid.ml9
-rw-r--r--otherlibs/labltk/browser/searchpos.ml22
-rw-r--r--otherlibs/labltk/browser/setpath.ml2
-rw-r--r--otherlibs/labltk/browser/shell.ml19
-rw-r--r--otherlibs/labltk/browser/useunix.ml2
-rw-r--r--otherlibs/labltk/browser/viewer.ml18
-rw-r--r--otherlibs/labltk/builtin/builtini_bind.ml4
-rw-r--r--otherlibs/labltk/builtin/builtini_text.ml4
-rw-r--r--otherlibs/labltk/builtin/dialog.ml2
-rw-r--r--otherlibs/labltk/compiler/compile.ml73
-rw-r--r--otherlibs/labltk/compiler/intf.ml4
-rw-r--r--otherlibs/labltk/compiler/lexer.mll2
-rw-r--r--otherlibs/labltk/compiler/maincompile.ml2
-rw-r--r--otherlibs/labltk/compiler/parser.mly11
-rw-r--r--otherlibs/labltk/compiler/tables.ml4
-rw-r--r--otherlibs/labltk/jpf/fileselect.ml32
-rw-r--r--otherlibs/labltk/support/support.ml40
-rw-r--r--otherlibs/labltk/support/support.mli12
-rw-r--r--otherlibs/labltk/support/textvariable.ml8
-rw-r--r--otherlibs/labltk/support/widget.ml4
30 files changed, 152 insertions, 218 deletions
diff --git a/otherlibs/labltk/browser/editor.ml b/otherlibs/labltk/browser/editor.ml
index 9a8f3328e..9176a7da1 100644
--- a/otherlibs/labltk/browser/editor.ml
+++ b/otherlibs/labltk/browser/editor.ml
@@ -38,9 +38,9 @@ let compiler_preferences () =
pack [ok;cancel] side:`Left fill:`X expand:true;
pack [buttons] side:`Bottom fill:`X
-let rec exclude item:txt = function
+let rec exclude key:txt = function
[] -> []
- | x :: l -> if txt.number = x.number then l else x :: exclude item:txt l
+ | x :: l -> if txt.number = x.number then l else x :: exclude key:txt l
let goto_line tw =
let tl = Jg_toplevel.titled "Go to" in
@@ -178,7 +178,7 @@ let indent_line =
fun tw ->
let `Linechar(l,c) = Text.index tw index:(ins,[])
and line = Text.get tw start:(ins,[`Linestart]) end:(ins,[]) in
- Str.string_match reg line pos:0;
+ Str.string_match pat:reg line pos:0;
if Str.match_end () < c then
Text.insert tw index:(ins,[]) text:"\t"
else let indent =
@@ -186,7 +186,7 @@ let indent_line =
let previous =
Text.get tw start:(ins,[`Line(-1);`Linestart])
end:(ins,[`Line(-1);`Lineend]) in
- Str.string_match reg previous pos:0;
+ Str.string_match pat:reg previous pos:0;
let previous = Str.matched_string previous in
let width = string_width line
and width_previous = string_width previous in
@@ -228,7 +228,7 @@ class editor :top :menus = object (self)
method set_edit txt =
if windows <> [] then
Pack.forget [(List.hd windows).frame];
- windows <- txt :: exclude item:txt windows;
+ windows <- txt :: exclude key:txt windows;
self#reset_window_menu;
current_tw <- txt.tw;
Checkbutton.configure label text:(Filename.basename txt.name)
@@ -255,7 +255,7 @@ class editor :top :menus = object (self)
action:(`Set ([`Char], fun ev ->
if ev.ev_Char <> "" &
(ev.ev_Char.[0] >= ' ' or
- List.mem item:ev.ev_Char.[0]
+ List.mem key:ev.ev_Char.[0]
(List.map fun:control ['d'; 'h'; 'i'; 'k'; 'o'; 't'; 'w'; 'y']))
then Textvariable.set txt.modified to:"modified"));
bind tw events:[[],`KeyPressDetail"Tab"]
@@ -267,7 +267,7 @@ class editor :top :menus = object (self)
action:(`Set ([], fun _ ->
let text =
Text.get tw start:(`Mark"insert",[]) end:(`Mark"insert",[`Lineend])
- in Str.string_match (Str.regexp "[ \t]*") text pos:0;
+ in Str.string_match pat:(Str.regexp "[ \t]*") text pos:0;
if Str.match_end () <> String.length text then begin
Clipboard.clear ();
Clipboard.append data:text ()
@@ -357,13 +357,13 @@ class editor :top :menus = object (self)
let file = open_in name
and tw = current_tw
and len = ref 0
- and buffer = String.create len:4096 in
+ and buf = String.create len:4096 in
Text.delete tw start:tstart end:tend;
while
- len := input file :buffer pos:0 len:4096;
+ len := input file :buf pos:0 len:4096;
!len > 0
do
- Jg_text.output tw :buffer pos:0 len:!len
+ Jg_text.output tw :buf pos:0 len:!len
done;
close_in file;
Text.mark_set tw mark:"insert" :index;
@@ -386,7 +386,7 @@ class editor :top :menus = object (self)
| `no -> ()
| `cancel -> raise Exit
end;
- windows <- exclude item:txt windows;
+ windows <- exclude key:txt windows;
if windows = [] then
self#new_window (current_dir ^ "/untitled")
else self#set_edit (List.hd windows);
@@ -522,7 +522,7 @@ end
let already_open : editor option ref = ref None
-let editor ?:file ?:pos{= 0} () =
+let editor ?:file ?:pos[=0] () =
if match !already_open with None -> false
| Some ed ->
@@ -535,7 +535,7 @@ let editor ?:file ?:pos{= 0} () =
already_open := Some ed;
if file <> None then ed#reopen :file :pos
-let f ?:file ?:pos ?:opendialog{=false} () =
+let f ?:file ?:pos ?:opendialog[=false] () =
if opendialog then
Fileselect.f title:"Open File"
action:(function [file] -> editor :file () | _ -> ())
diff --git a/otherlibs/labltk/browser/fileselect.ml b/otherlibs/labltk/browser/fileselect.ml
index 82adbb7b8..b72b6ce4e 100644
--- a/otherlibs/labltk/browser/fileselect.ml
+++ b/otherlibs/labltk/browser/fileselect.ml
@@ -16,18 +16,20 @@ let regexp = (new Jg_memo.c fun:Str.regexp)#get
let parse_filter src =
(* replace // by / *)
- let s = global_replace (regexp "/+") with:"/" src in
+ let s = global_replace pat:(regexp "/+") with:"/" src in
(* replace /./ by / *)
- let s = global_replace (regexp "/\./") with:"/" s in
+ let s = global_replace pat:(regexp "/\./") with:"/" s in
(* replace hoge/../ by "" *)
- let s = global_replace
- (regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./") with:"" s in
+ let s = global_replace s
+ pat:(regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./")
+ with:"" in
(* replace hoge/..$ by *)
- let s = global_replace
- (regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$") with:"" s in
+ let s = global_replace s
+ pat:(regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$")
+ with:"" in
(* replace ^/../../ by / *)
- let s = global_replace (regexp "^\(/\.\.\)+/") with:"/" s in
- if string_match (regexp "^\([^\*?[]*/\)\(.*\)") s pos:0 then
+ let s = global_replace pat:(regexp "^\(/\.\.\)+/") with:"/" s in
+ if string_match s pat:(regexp "^\([^\*?[]*/\)\(.*\)") pos:0 then
let dirs = matched_group 1 s
and ptrn = matched_group 2 s
in
@@ -40,24 +42,27 @@ let fixpoint fun:f v =
!v1
let unix_regexp s =
- let s = Str.global_replace (regexp "[$^.+]") with:"\\\\\\0" s in
- let s = Str.global_replace (regexp "\\*") with:".*" s in
- let s = Str.global_replace (regexp "\\?") with:".?" s in
+ let s = Str.global_replace pat:(regexp "[$^.+]") with:"\\\\\\0" s in
+ let s = Str.global_replace pat:(regexp "\\*") with:".*" s in
+ let s = Str.global_replace pat:(regexp "\\?") with:".?" s in
let s =
- fixpoint s fun:(fun s ->
- Str.global_replace (regexp "\\({.*\\),\\(.*}\\)") s
- with:"\\1\\|\\2") in
+ fixpoint s fun:
+ begin fun s ->
+ Str.global_replace s
+ pat:(regexp "\\({.*\\),\\(.*}\\)")
+ with:"\\1\\|\\2"
+ end in
let s =
- Str.global_replace (regexp "{\\(.*\\)}") with:"\\(\\1\\)" s in
+ Str.global_replace pat:(regexp "{\\(.*\\)}") with:"\\(\\1\\)" s in
Str.regexp s
-let exact_match s :regexp =
- Str.string_match regexp s pos:0 & Str.match_end () = String.length s
+let exact_match s :pat =
+ Str.string_match :pat s pos:0 & Str.match_end () = String.length s
let ls :dir :pattern =
let files = get_files_in_directory dir in
let regexp = unix_regexp pattern in
- List.filter files pred:(exact_match :regexp)
+ List.filter files pred:(exact_match pat:regexp)
(*
let ls :dir :pattern =
@@ -69,9 +74,9 @@ let load_in_path = ref false
let search_in_path :name = Misc.find_in_path !Config.load_path name
-let f :title action:proc ?:dir{=Unix.getcwd ()}
- ?filter:deffilter{="*"} ?file:deffile{=""}
- ?:multi{=false} ?:sync{=false} ?:usepath{=true} () =
+let f :title action:proc ?:dir[=Unix.getcwd ()]
+ ?filter:deffilter[="*"] ?file:deffile[=""]
+ ?:multi[=false] ?:sync[=false] ?:usepath[=true] () =
let current_pattern = ref ""
and current_dir = ref dir in
@@ -99,7 +104,7 @@ let f :title action:proc ?:dir{=Unix.getcwd ()}
let configure :filter =
let filter =
- if string_match (regexp "^/.*") filter pos:0
+ if string_match pat:(regexp "^/.*") filter pos:0
then filter
else !current_dir ^ "/" ^ filter
in
diff --git a/otherlibs/labltk/browser/jg_button.ml b/otherlibs/labltk/browser/jg_button.ml
index 64f7d6027..ea963decd 100644
--- a/otherlibs/labltk/browser/jg_button.ml
+++ b/otherlibs/labltk/browser/jg_button.ml
@@ -2,7 +2,7 @@
open Tk
-let create_destroyer :parent ?:text{="Ok"} tl =
+let create_destroyer :parent ?:text[="Ok"] tl =
Button.create parent :text command:(fun () -> destroy tl)
let add_destroyer ?:text tl =
diff --git a/otherlibs/labltk/browser/jg_completion.ml b/otherlibs/labltk/browser/jg_completion.ml
index 8836af09f..16c321bf6 100644
--- a/otherlibs/labltk/browser/jg_completion.ml
+++ b/otherlibs/labltk/browser/jg_completion.ml
@@ -1,6 +1,6 @@
(* $Id$ *)
-let lt_string ?:nocase{=false} s1 s2 =
+let lt_string ?:nocase[=false] s1 s2 =
if nocase then String.lowercase s1 < String.lowercase s2 else s1 < s2
class completion ?:nocase texts = object
diff --git a/otherlibs/labltk/browser/jg_menu.ml b/otherlibs/labltk/browser/jg_menu.ml
index ef18c1f1f..5bbba8c79 100644
--- a/otherlibs/labltk/browser/jg_menu.ml
+++ b/otherlibs/labltk/browser/jg_menu.ml
@@ -2,7 +2,7 @@
open Tk
-class c :parent ?underline:n{=0} text = object (self)
+class c :parent ?underline:n[=0] text = object (self)
val pair =
let button =
Menubutton.create parent :text underline:n in
@@ -19,7 +19,7 @@ class c :parent ?underline:n{=0} text = object (self)
?font:string -> ?foreground:color ->
?image:image -> ?state:state ->
string -> unit
- method add_command ?underline:n{=0} ?:accelerator ?:activebackground
+ method add_command ?underline:n[=0] ?:accelerator ?:activebackground
?:activeforeground ?:background ?:bitmap ?:command ?:font ?:foreground
?:image ?:state label =
Menu.add_command (self#menu) :label underline:n ?:accelerator
diff --git a/otherlibs/labltk/browser/jg_message.ml b/otherlibs/labltk/browser/jg_message.ml
index 54548a72f..bc0273016 100644
--- a/otherlibs/labltk/browser/jg_message.ml
+++ b/otherlibs/labltk/browser/jg_message.ml
@@ -28,7 +28,7 @@ class formatted :parent :width :maxheight :minheight =
end
*)
-let formatted :title ?:on ?:width{=60} ?:maxheight{=10} ?:minheight{=0} () =
+let formatted :title ?:on ?:width[=60] ?:maxheight[=10] ?:minheight[=0] () =
let tl, frame =
match on with
Some frame -> coe frame, frame
diff --git a/otherlibs/labltk/browser/jg_multibox.ml b/otherlibs/labltk/browser/jg_multibox.ml
index f05524e11..1858a48f8 100644
--- a/otherlibs/labltk/browser/jg_multibox.ml
+++ b/otherlibs/labltk/browser/jg_multibox.ml
@@ -67,7 +67,7 @@ class c :cols :texts ?:maxheight ?:width parent = object (self)
method parent = parent'
method boxes = boxes
method current = current
- method recenter?:aligntop{=false} n =
+ method recenter?:aligntop[=false] n =
current <-
if n < 0 then 0 else
if n < length then n else length - 1;
diff --git a/otherlibs/labltk/browser/jg_text.ml b/otherlibs/labltk/browser/jg_text.ml
index 18e4b8318..8a3dd8ceb 100644
--- a/otherlibs/labltk/browser/jg_text.ml
+++ b/otherlibs/labltk/browser/jg_text.ml
@@ -13,8 +13,8 @@ let tag_and_see tw :tag :start end:e =
Text.mark_set tw mark:"insert" index:(`Tagfirst tag, [])
with Protocol.TkError _ -> ()
-let output tw :buffer :pos :len =
- Text.insert tw index:tend text:(String.sub buffer :pos :len)
+let output tw :buf :pos :len =
+ Text.insert tw index:tend text:(String.sub buf :pos :len)
let add_scrollbar tw =
let sb = Scrollbar.create (Winfo.parent tw) command:(Text.yview tw)
@@ -62,6 +62,7 @@ let search_string tw =
let dir, ofs = match Textvariable.get direction with
"forward" -> `Forwards, 1
| "backward" -> `Backwards, -1
+ | _ -> assert false
and mode = match Textvariable.get mode with "exact" -> [`Exact]
| "nocase" -> [`Nocase] | "regexp" -> [`Regexp] | _ -> []
in
diff --git a/otherlibs/labltk/browser/jg_text.mli b/otherlibs/labltk/browser/jg_text.mli
index 6dd60e7ff..afe802a94 100644
--- a/otherlibs/labltk/browser/jg_text.mli
+++ b/otherlibs/labltk/browser/jg_text.mli
@@ -6,7 +6,7 @@ val get_all : text widget -> string
val tag_and_see :
text widget ->
tag:Tk.textTag -> start:Tk.textIndex -> end:Tk.textIndex -> unit
-val output : text widget -> buffer:string -> pos:int -> len:int -> unit
+val output : text widget -> buf:string -> pos:int -> len:int -> unit
val add_scrollbar : text widget -> scrollbar widget
val create_with_scrollbar :
'a widget -> frame widget * text widget * scrollbar widget
diff --git a/otherlibs/labltk/browser/lexical.ml b/otherlibs/labltk/browser/lexical.ml
index 7c10b37b9..33a68e488 100644
--- a/otherlibs/labltk/browser/lexical.ml
+++ b/otherlibs/labltk/browser/lexical.ml
@@ -20,7 +20,7 @@ let init_tags tw =
Text.tag_configure tw tag:"error" relief:`Raised;
Text.tag_raise tw tag:"error"
-let tag ?:start{=tstart} ?end:pend{=tend} tw =
+let tag ?:start[=tstart] ?end:pend[=tend] tw =
let tpos c = (Text.index tw index:start, [`Char c]) in
let text = Text.get tw :start end:pend in
let buffer = Lexing.from_string text in
diff --git a/otherlibs/labltk/browser/searchid.ml b/otherlibs/labltk/browser/searchid.ml
index fe8cb2e2c..ce5abff8e 100644
--- a/otherlibs/labltk/browser/searchid.ml
+++ b/otherlibs/labltk/browser/searchid.ml
@@ -154,7 +154,7 @@ let rec included :prefix t1 t2 =
let l2 = if arr len1 in:len2 < 100 then l2 else
let ll1 = get_options (fst (List.split l1)) in
List.filter l2
- pred:(fun (l,_) -> not (is_opt l) or List.mem item:l ll1)
+ pred:(fun (l,_) -> not (is_opt l) or List.mem key:l ll1)
in
len1 <= len2 &
List.exists (List2.flat_map fun:permutations (choose len1 in:l2)) pred:
@@ -293,7 +293,10 @@ let longident_of_string text =
(exploded := String.sub text pos:!l len:(i - !l) :: !exploded; l := i+1)
done;
let sym = String.sub text pos:!l len:(String.length text - !l) in
- let rec mklid = function [s] -> Lident s | s :: l -> Ldot (mklid l, s) in
+ let rec mklid = function
+ [s] -> Lident s
+ | s :: l -> Ldot (mklid l, s)
+ | [] -> assert false in
sym, fun l -> mklid (sym :: !exploded @ l)
@@ -416,7 +419,7 @@ let search_structure str :name :kind :prefix =
Pstr_value (_, l) when kind = Pvalue ->
List.iter l fun:
begin fun (pat,_) ->
- if List.mem item:name (bound_variables pat)
+ if List.mem key:name (bound_variables pat)
then loc := pat.ppat_loc.loc_start
end;
false
diff --git a/otherlibs/labltk/browser/searchpos.ml b/otherlibs/labltk/browser/searchpos.ml
index ad36cdb0a..49d9d76aa 100644
--- a/otherlibs/labltk/browser/searchpos.ml
+++ b/otherlibs/labltk/browser/searchpos.ml
@@ -50,22 +50,12 @@ let rec list_of_path = function
| Pdot (path, s, _) -> list_of_path path @ [s]
| Papply (path, _) -> list_of_path path (* wrong, but ... *)
-(* a standard (diposable) buffer class *)
+(* a simple wrapper *)
class buffer :len = object
- val mutable buffer = String.create :len
- val mutable length = len
- val mutable current = 0
- method out buffer:b :pos :len =
- while len + current > length do
- let newbuf = String.create len:(length * 2) in
- String.blit buffer pos:0 len:current to:newbuf to_pos:0;
- buffer <- newbuf;
- length <- 2 * length
- done;
- String.blit b :pos to:buffer to_pos:current :len;
- current <- current + len
- method get = String.sub buffer pos:0 len:current
+ val buffer = Buffer.create len
+ method out :buf = Buffer.add_substring buffer buf
+ method get = Buffer.contents buffer
end
(* Search in a signature *)
@@ -270,7 +260,7 @@ let edit_source :file :path :sign =
(* List of windows to destroy by Close All *)
let top_widgets = ref []
-let rec view_signature ?:title ?:path ?:env{= !start_env} sign =
+let rec view_signature ?:title ?:path ?:env[= !start_env] sign =
let env =
match path with None -> env
| Some path -> Env.open_signature path sign env in
@@ -408,7 +398,7 @@ and view_modtype_id li :env =
view_signature_item :path :env
[Tsig_modtype(ident_of_path path default:"S", td)]
-and view_expr_type ?:title ?:path ?:env ?:name{="noname"} t =
+and view_expr_type ?:title ?:path ?:env ?:name[="noname"] t =
let title =
match title, path with Some title, _ -> title
| None, Some path -> string_of_path path
diff --git a/otherlibs/labltk/browser/setpath.ml b/otherlibs/labltk/browser/setpath.ml
index cd255af19..f9c478b07 100644
--- a/otherlibs/labltk/browser/setpath.ml
+++ b/otherlibs/labltk/browser/setpath.ml
@@ -34,7 +34,7 @@ let renew_path box =
Listbox.insert box index:`End texts:!Config.load_path;
Jg_box.recenter box index:(`Num 0)
-let add_to_path :dirs ?:base{=""} box =
+let add_to_path :dirs ?:base[=""] box =
let dirs =
if base = "" then dirs else
if dirs = [] then [base] else
diff --git a/otherlibs/labltk/browser/shell.ml b/otherlibs/labltk/browser/shell.ml
index 039dc3f7b..caf0ea476 100644
--- a/otherlibs/labltk/browser/shell.ml
+++ b/otherlibs/labltk/browser/shell.ml
@@ -29,7 +29,8 @@ class shell :textw :prog :args :env =
and (in1,out2) = Unix.pipe ()
and (err1,err2) = Unix.pipe () in
object (self)
- val pid = Unix.create_process_env :prog :args :env in:in2 out:out2 err:err2
+ val pid = Unix.create_process_env name:prog :args :env
+ stdin:in2 stdout:out2 stderr:err2
val out = Unix.out_channel_of_descr out1
val h = new history ()
val mutable alive = true
@@ -45,7 +46,7 @@ object (self)
Fileevent.remove_fileinput fd:in1;
Fileevent.remove_fileinput fd:err1;
Unix.kill :pid signal:Sys.sigkill;
- Unix.waitpid flags:[] pid; ()
+ Unix.waitpid mode:[] pid; ()
with _ -> ()
end
method interrupt =
@@ -60,9 +61,9 @@ object (self)
with Sys_error _ -> ()
method private read :fd :len =
try
- let buffer = String.create :len in
- let len = Unix.read fd :buffer pos:0 :len in
- self#insert (String.sub buffer pos:0 :len);
+ let buf = String.create :len in
+ let len = Unix.read fd :buf pos:0 :len in
+ self#insert (String.sub buf pos:0 :len);
Text.mark_set textw mark:"input" index:(`Mark"insert",[`Char(-1)])
with Unix.Unix_error _ -> ()
method history (dir : [`next|`previous]) =
@@ -77,8 +78,8 @@ object (self)
end;
self#insert (if dir = `previous then h#previous else h#next)
end
- method private lex ?:start{= `Mark"insert",[`Linestart]}
- ?end:endx{= `Mark"insert",[`Lineend]} () =
+ method private lex ?:start[=`Mark"insert",[`Linestart]]
+ ?end:endx[=`Mark"insert",[`Lineend]] () =
Lexical.tag textw :start end:endx
method insert text =
let idx = Text.index textw
@@ -152,7 +153,7 @@ let get_all () =
all
let may_exec prog =
- try Unix.access file:prog perm:[Unix.X_OK]; true
+ try Unix.access name:prog perm:[Unix.X_OK]; true
with Unix.Unix_error _ -> false
let f :prog :title =
@@ -183,7 +184,7 @@ let f :prog :title =
let reg = Str.regexp "TERM=" in
let env = Array.map (Unix.environment ()) fun:
begin fun s ->
- if Str.string_match reg s pos:0 then "TERM=dumb" else s
+ if Str.string_match pat:reg s pos:0 then "TERM=dumb" else s
end in
let load_path =
List2.flat_map !Config.load_path fun:(fun dir -> ["-I"; dir]) in
diff --git a/otherlibs/labltk/browser/useunix.ml b/otherlibs/labltk/browser/useunix.ml
index 660d552d7..c0b7e5966 100644
--- a/otherlibs/labltk/browser/useunix.ml
+++ b/otherlibs/labltk/browser/useunix.ml
@@ -17,7 +17,7 @@ let get_files_in_directory dir =
let is_directory name =
try
- (stat file:name).st_kind = S_DIR
+ (stat :name).st_kind = S_DIR
with _ -> false
let get_directories_in_files :path =
diff --git a/otherlibs/labltk/browser/viewer.ml b/otherlibs/labltk/browser/viewer.ml
index 9af6f76d2..9a20a4996 100644
--- a/otherlibs/labltk/browser/viewer.ml
+++ b/otherlibs/labltk/browser/viewer.ml
@@ -21,7 +21,7 @@ let list_modules :path =
String.capitalize (Filename.chop_suffix x suff:".cmi")
end in
List.fold_left l :acc
- fun:(fun :acc item -> if List.mem acc :item then acc else item :: acc)
+ fun:(fun :acc key -> if List.mem acc :key then acc else key :: acc)
end
let reset_modules box =
@@ -147,10 +147,12 @@ let search_symbol () =
search_which := Textvariable.get which;
let text = Entry.get ew in
try if text = "" then () else
- let l = match !search_which with
- "itself" -> search_string_symbol text
- | "iotype" -> search_string_type text mode:`included
- | "exact" -> search_string_type text mode:`exact
+ let l =
+ match !search_which with
+ "itself" -> search_string_symbol text
+ | "iotype" -> search_string_type text mode:`included
+ | "exact" -> search_string_type text mode:`exact
+ | _ -> assert false
in
if l <> [] then
choose_symbol title:"Choose symbol" env:!start_env l
@@ -227,12 +229,12 @@ let start_shell () =
Jg_entry.create entries command:(fun _ -> Button.invoke ok)
and names = List.map fun:fst (Shell.get_all ()) in
Entry.insert e1 index:`End text:!default_shell;
- while List.mem names item:("Shell #" ^ string_of_int !shell_counter) do
+ while List.mem names key:("Shell #" ^ string_of_int !shell_counter) do
incr shell_counter
done;
Entry.insert e2 index:`End text:("Shell #" ^ string_of_int !shell_counter);
Button.configure ok command:(fun () ->
- if not (List.mem names item:(Entry.get e2)) then begin
+ if not (List.mem names key:(Entry.get e2)) then begin
default_shell := Entry.get e1;
Shell.f prog:!default_shell title:(Entry.get e2);
destroy tl
@@ -243,7 +245,7 @@ let start_shell () =
pack [ok;cancel] side:`Left fill:`X expand:true;
pack [input;buttons] side:`Top fill:`X expand:true
-let f ?:dir{= Unix.getcwd()} ?:on () =
+let f ?:dir[=Unix.getcwd()] ?:on () =
let tl = match on with
None ->
let tl = Jg_toplevel.titled "Module viewer" in
diff --git a/otherlibs/labltk/builtin/builtini_bind.ml b/otherlibs/labltk/builtin/builtini_bind.ml
index 8dbde204b..1cba2d1a9 100644
--- a/otherlibs/labltk/builtin/builtini_bind.ml
+++ b/otherlibs/labltk/builtin/builtini_bind.ml
@@ -47,12 +47,12 @@ let cCAMLtoTKmodifier : modifier -> string = function
(* type event = modifier list * xEvent *)
let cCAMLtoTKevent : (modifier list * xEvent) -> string =
function (ml, xe) ->
- "<" ^ (catenate_sep " " (List.map fun:cCAMLtoTKmodifier ml))
+ "<" ^ (String.concat sep:" " (List.map fun:cCAMLtoTKmodifier ml))
^ (cCAMLtoTKxEvent xe) ^ ">"
(* type eventSequence == (modifier list * xEvent) list *)
let cCAMLtoTKeventSequence : (modifier list * xEvent) list -> tkArgs =
function l ->
- TkToken(catenate_sep "" (List.map fun:cCAMLtoTKevent l))
+ TkToken(String.concat sep:"" (List.map fun:cCAMLtoTKevent l))
diff --git a/otherlibs/labltk/builtin/builtini_text.ml b/otherlibs/labltk/builtin/builtini_text.ml
index 1c7e2d7c0..e3ca25602 100644
--- a/otherlibs/labltk/builtin/builtini_text.ml
+++ b/otherlibs/labltk/builtin/builtini_text.ml
@@ -24,13 +24,13 @@ let ppTextIndex = function
`None -> ""
| `Index (base, ml) ->
let (TkToken ppbase) = cCAMLtoTKtext_index base in
- catenate_sep "" (ppbase :: List.map fun:ppTextModifier ml)
+ String.concat sep:"" (ppbase :: List.map fun:ppTextModifier ml)
*)
let ppTextIndex = function
(base, ml) ->
let (TkToken ppbase) = cCAMLtoTKtext_index base in
- catenate_sep "" (ppbase :: List.map fun:ppTextModifier ml)
+ String.concat sep:"" (ppbase :: List.map fun:ppTextModifier ml)
let cCAMLtoTKtextIndex : textIndex -> tkArgs = function i ->
TkToken (ppTextIndex i)
diff --git a/otherlibs/labltk/builtin/dialog.ml b/otherlibs/labltk/builtin/dialog.ml
index 9b5e06fbf..b2484e541 100644
--- a/otherlibs/labltk/builtin/dialog.ml
+++ b/otherlibs/labltk/builtin/dialog.ml
@@ -1,5 +1,5 @@
let create :parent :title :message :buttons ?:name
- ?:bitmap{=`Predefined ""} ?:default{= -1} () =
+ ?:bitmap[=`Predefined ""] ?:default[= -1] () =
let w = Widget.new_atom "toplevel" ?:name :parent in
let res = tkEval [|TkToken"tk_dialog";
cCAMLtoTKwidget w;
diff --git a/otherlibs/labltk/compiler/compile.ml b/otherlibs/labltk/compiler/compile.ml
index 66c5fb569..bbf2c4e89 100644
--- a/otherlibs/labltk/compiler/compile.ml
+++ b/otherlibs/labltk/compiler/compile.ml
@@ -6,16 +6,6 @@ open Tables
(* if you set it true, ImagePhoto and ImageBitmap will annoy you... *)
let safetype = false
-let lowercase s =
- let r = String.create len:(String.length s) in
- String.blit s pos:0 to:r to_pos:0 len:(String.length s);
- for i = 0 to String.length s - 1
- do
- let c = s.[i] in
- if c >= 'A' & c <= 'Z' then r.[i] <- Char.chr(Char.code c + 32)
- done;
- r
-
let labeloff :at l = match l with
"",t -> t
| l ,t -> raise (Failure ("labeloff : " ^ l ^ " at " ^ at))
@@ -42,7 +32,7 @@ let small_ident s =
let idents = ["to"; "raise"; "in"; "class"; "new"]
in
let s = small s in
- if List.mem item:s idents then (String.make len:1 s.[0])^s
+ if List.mem key:s idents then (String.make len:1 s.[0])^s
else s
let gettklabel fc =
@@ -54,16 +44,11 @@ let gettklabel fc =
if s = "" then small fc.ml_name else small s
| _ -> raise (Failure "gettklabel")
-let count item:x l =
+let count key:x l =
let count = ref 0 in
List.iter fun:(fun y -> if x = y then incr count) l;
!count
-let catenate_sep :sep =
- function
- [] -> ""
- | x::l -> List.fold_left fun:(fun :acc s' -> acc ^ sep ^ s') acc:x l
-
(* Extract all types from a template *)
let rec types_of_template = function
StringArg _ -> []
@@ -81,7 +66,7 @@ let rec types_of_template = function
* Pretty print a type
* used to write ML type definitions
*)
-let ppMLtype ?:any{=false} ?:return{=false} ?:def{=false} ?:counter{=ref 0} =
+let ppMLtype ?:any[=false] ?:return[=false] ?:def[=false] ?:counter[=ref 0] =
let rec ppMLtype =
function
Unit -> "unit"
@@ -103,7 +88,7 @@ let ppMLtype ?:any{=false} ?:return{=false} ?:def{=false} ?:counter{=ref 0} =
let l = List.map fcl fun:
begin fun fc ->
"?" ^ begin let p = gettklabel fc in
- if count item:p tklabels > 1 then small fc.ml_name else p
+ if count key:p tklabels > 1 then small fc.ml_name else p
end
^ ":" ^
let l = types_of_template fc.template in
@@ -111,19 +96,19 @@ let ppMLtype ?:any{=false} ?:return{=false} ?:def{=false} ?:counter{=ref 0} =
[] -> "unit"
| [lt] -> ppMLtype (labeloff lt at:"ppMLtype")
| l ->
- "(" ^ catenate_sep sep:"*"
+ "(" ^ String.concat sep:"*"
(List.map l
fun:(fun lt -> ppMLtype (labeloff lt at:"ppMLtype")))
^ ")"
end in
- catenate_sep sep:" ->\n" l
+ String.concat sep:" ->\n" l
with
Not_found -> Printf.eprintf "ppMLtype %s/%s\n" sup sub; exit (-1)
end
| List ty -> (ppMLtype ty) ^ " list"
- | Product tyl -> catenate_sep sep:" * " (List.map fun:ppMLtype tyl)
+ | Product tyl -> String.concat sep:" * " (List.map fun:ppMLtype tyl)
| Record tyl ->
- catenate_sep sep:" * "
+ String.concat sep:" * "
(List.map tyl fun:(fun (l,t) -> labelstring l ^ ppMLtype t))
| Subtype ("widget", sub) -> sub ^ " widget"
| UserDefined "widget" ->
@@ -140,7 +125,7 @@ let ppMLtype ?:any{=false} ?:return{=false} ?:def{=false} ?:counter{=ref 0} =
if typdef.variant then
if return then try
"[>" ^
- catenate_sep sep:"|"
+ String.concat sep:"|"
(List.map typdef.constructors fun:
begin
fun c ->
@@ -163,7 +148,7 @@ let ppMLtype ?:any{=false} ?:return{=false} ?:def{=false} ?:counter{=ref 0} =
| Function (Product tyl) ->
raise (Failure "Function (Product tyl) ? ppMLtype")
| Function (Record tyl) ->
- "(" ^ catenate_sep sep:" -> "
+ "(" ^ String.concat sep:" -> "
(List.map tyl fun:(fun (l,t) -> labelstring l ^ ppMLtype t))
^ " -> unit)"
| Function ty ->
@@ -176,13 +161,13 @@ let ppMLtype ?:any{=false} ?:return{=false} ?:def{=false} ?:counter{=ref 0} =
let rec ppTemplate = function
StringArg s -> s
| TypeArg (l,t) -> "<" ^ ppMLtype t ^ ">"
- | ListArg l -> "{" ^ catenate_sep sep:" " (List.map fun:ppTemplate l) ^ "}"
+ | ListArg l -> "{" ^ String.concat sep:" " (List.map fun:ppTemplate l) ^ "}"
| OptionalArgs (l,tl,d) ->
- "?" ^ l ^ "{" ^ catenate_sep sep:" " (List.map fun:ppTemplate tl)
- ^ "}[<" ^ catenate_sep sep:" " (List.map fun:ppTemplate d) ^ ">]"
+ "?" ^ l ^ "{" ^ String.concat sep:" " (List.map fun:ppTemplate tl)
+ ^ "}[<" ^ String.concat sep:" " (List.map fun:ppTemplate d) ^ ">]"
let doc_of_template = function
- ListArg l -> catenate_sep sep:" " (List.map fun:ppTemplate l)
+ ListArg l -> String.concat sep:" " (List.map fun:ppTemplate l)
| t -> ppTemplate t
(*
@@ -341,8 +326,8 @@ let rec wrapper_code fname of:ty =
converterTKtoCAML "args" as:ty ^
" in\n "
end in
- catenate_sep sep:"" readarg ^ fname ^ " " ^
- catenate_sep sep:" "
+ String.concat sep:"" readarg ^ fname ^ " " ^
+ String.concat sep:" "
(List.map2 fun:(fun v (l,_) -> labelstring l^v) vnames tyl)
(* all other types are read in one operation *)
@@ -507,7 +492,7 @@ let rec converterCAMLtoTK :context_widget argname as:ty =
*
*)
-let code_of_template :context_widget ?func:funtemplate{=false} template =
+let code_of_template :context_widget ?func:funtemplate[=false] template =
let catch_opts = ref ("","") in (* class name and first option *)
let variables = ref [] in
let variables2 = ref [] in
@@ -549,12 +534,12 @@ let code_of_template :context_widget ?func:funtemplate{=false} template =
| TypeArg (l,ty) -> converterCAMLtoTK :context_widget (!newvar l) as:ty
| ListArg l ->
"TkQuote (TkTokenList ["
- ^ catenate_sep sep:";\n " (List.map fun:coderec l) ^ "])"
+ ^ String.concat sep:";\n " (List.map fun:coderec l) ^ "])"
| OptionalArgs (l,tl,d) ->
let nv = !newvar ("?"^l) in
optionvar := Some nv; (* Store *)
- let argstr = catenate_sep sep:"; " (List.map fun:coderec tl) in
- let defstr = catenate_sep sep:"; " (List.map fun:coderec d) in
+ let argstr = String.concat sep:"; " (List.map fun:coderec tl) in
+ let defstr = String.concat sep:"; " (List.map fun:coderec d) in
"TkTokenList (match "^ nv ^" with\n"
^ " Some " ^ nv ^ " -> [" ^ argstr ^ "]\n"
^ " | None -> [" ^ defstr ^ "])"
@@ -563,14 +548,14 @@ let code_of_template :context_widget ?func:funtemplate{=false} template =
if funtemplate then
match template with
ListArg l ->
- "[|" ^ catenate_sep sep:";\n " (List.map fun:coderec l) ^ "|]"
+ "[|" ^ String.concat sep:";\n " (List.map fun:coderec l) ^ "|]"
| _ -> "[|" ^ coderec template ^ "|]"
else
match template with
ListArg [x] -> coderec x
| ListArg l ->
"TkTokenList ["
- ^ catenate_sep sep:";\n " (List.map fun:coderec l) ^ "]"
+ ^ String.concat sep:";\n " (List.map fun:coderec l) ^ "]"
| _ -> coderec template
in
code , List.rev !variables, List.rev !variables2, !catch_opts
@@ -598,7 +583,7 @@ let write_clause :w :context_widget comp =
| [x] -> w " "; w (labeloff x at:"write_clause"); warrow()
| l ->
w " ( ";
- w (catenate_sep sep:", " (List.map fun:(labeloff at:"write_clause") l));
+ w (String.concat sep:", " (List.map fun:(labeloff at:"write_clause") l));
w ")";
warrow()
end;
@@ -606,7 +591,7 @@ let write_clause :w :context_widget comp =
(* The full converter *)
-let write_CAMLtoTK :w def:typdef ?safetype:st{=true} name =
+let write_CAMLtoTK :w def:typdef ?safetype:st[=true] name =
let write_one name constrs =
w ("let cCAMLtoTK"^name);
let context_widget =
@@ -656,7 +641,7 @@ let rec write_result_parsing :w = function
end;
w (" in\n")
end;
- w (catenate_sep sep:"," rnames)
+ w (String.concat sep:"," rnames)
| String ->
w (converterTKtoCAML "res" as:String)
| As (ty, _) -> write_result_parsing :w ty
@@ -761,7 +746,7 @@ let write_catch_optionals :w clas def:typdef =
(* used as names of variants *)
fc.var_name,
begin let p = gettklabel fc in
- if count item:p tklabels > 1 then small fc.ml_name else p
+ if count key:p tklabels > 1 then small fc.ml_name else p
end,
small_ident fc.ml_name (* used as labels *)
end in
@@ -782,7 +767,7 @@ let write_catch_optionals :w clas def:typdef =
for i=1 to i do
s := !s @ ["x" ^ string_of_int i]
done;
- "(" ^ catenate_sep sep:"," !s ^ ")"
+ "(" ^ String.concat sep:"," !s ^ ")"
in
let apvars =
if i = 0 then ""
@@ -793,10 +778,10 @@ let write_catch_optionals :w clas def:typdef =
in
"(maycons (fun " ^ vars ^ " -> " ^ "`" ^ c ^ " " ^ apvars ^ ") " ^ si
end in
- w (catenate_sep sep:"\n" p);
+ w (String.concat sep:"\n" p);
w " ->\n";
w " f ";
- w (catenate_sep sep:"\n " v);
+ w (String.concat sep:"\n " v);
w "\n []";
w (String.make len:(List.length v) ')');
w "\n\n"
diff --git a/otherlibs/labltk/compiler/intf.ml b/otherlibs/labltk/compiler/intf.ml
index 93126b467..85dd62a2b 100644
--- a/otherlibs/labltk/compiler/intf.ml
+++ b/otherlibs/labltk/compiler/intf.ml
@@ -15,10 +15,10 @@ let write_create_p :w wname =
let l = List.map classdefs fun:
begin fun fc ->
begin let p = gettklabel fc in
- if count item:p tklabels > 1 then small fc.ml_name else p
+ if count key:p tklabels > 1 then small fc.ml_name else p
end, fc.template
end in
- w (catenate_sep sep:" ->\n"
+ w (String.concat sep:" ->\n"
(List.map l fun:
begin fun (s,t) ->
" ?" ^ s ^ ":"
diff --git a/otherlibs/labltk/compiler/lexer.mll b/otherlibs/labltk/compiler/lexer.mll
index 065edd3a4..b9b5f2335 100644
--- a/otherlibs/labltk/compiler/lexer.mll
+++ b/otherlibs/labltk/compiler/lexer.mll
@@ -49,7 +49,7 @@ let reset_string_buffer () =
let store_string_char c =
if !string_index >= String.length (!string_buff) then begin
let new_buff = String.create len:(String.length (!string_buff) * 2) in
- String.blit (!string_buff) pos:0 to:new_buff to_pos:0
+ String.blit src:(!string_buff) src_pos:0 dst:new_buff dst_pos:0
len:(String.length (!string_buff));
string_buff := new_buff
end;
diff --git a/otherlibs/labltk/compiler/maincompile.ml b/otherlibs/labltk/compiler/maincompile.ml
index ffa4aa49c..8d83484a4 100644
--- a/otherlibs/labltk/compiler/maincompile.ml
+++ b/otherlibs/labltk/compiler/maincompile.ml
@@ -106,7 +106,7 @@ verbose_string "type ";
verbose_string "C2T ";
write_CAMLtoTK w:(output_string to:oc') typname def:typdef;
verbose_string "T2C ";
- if List.mem item:typname !types_returned then
+ if List.mem key:typname !types_returned then
write_TKtoCAML w:(output_string to:oc') typname def:typdef;
verbose_string "CO ";
write_catch_optionals w:(output_string to:oc') typname def:typdef;
diff --git a/otherlibs/labltk/compiler/parser.mly b/otherlibs/labltk/compiler/parser.mly
index ce7895232..336c4d47a 100644
--- a/otherlibs/labltk/compiler/parser.mly
+++ b/otherlibs/labltk/compiler/parser.mly
@@ -4,13 +4,6 @@
open Tables
-let lowercase s =
- let r = String.create len:(String.length s) in
- String.blit s pos:0 to:r to_pos:0 len:(String.length s);
- let c = s.[0] in
- if c >= 'A' & c <= 'Z' then r.[0] <- Char.chr(Char.code c + 32);
- r
-
%}
/* Tokens */
@@ -53,7 +46,7 @@ let lowercase s =
%%
TypeName:
- IDENT { lowercase $1 }
+ IDENT { String.uncapitalize $1 }
| WIDGET { "widget" }
;
@@ -306,7 +299,7 @@ entry :
| WIDGET IDENT LBRACE WidgetComponents RBRACE
{ enter_widget $2 $4 }
| MODULE IDENT LBRACE ModuleComponents RBRACE
- { enter_module (lowercase $2) $4 }
+ { enter_module (String.uncapitalize $2) $4 }
| EOF
{ raise End_of_file }
;
diff --git a/otherlibs/labltk/compiler/tables.ml b/otherlibs/labltk/compiler/tables.ml
index bd650463e..efa0b9ac5 100644
--- a/otherlibs/labltk/compiler/tables.ml
+++ b/otherlibs/labltk/compiler/tables.ml
@@ -235,7 +235,7 @@ let rec has_callback = function
(*** Returned types ***)
let really_add ty =
- if List.mem item:ty !types_returned then ()
+ if List.mem key:ty !types_returned then ()
else types_returned := ty :: !types_returned
let rec add_return_type = function
@@ -283,7 +283,7 @@ let rec find_constructor cname = function
else find_constructor cname l
(* Enter a type, must not be previously defined *)
-let enter_type typname ?:variant{=false} arity constructors =
+let enter_type typname ?:variant[=false] arity constructors =
try
Hashtbl.find types_table key:typname;
raise (Duplicate_Definition ("type", typname))
diff --git a/otherlibs/labltk/jpf/fileselect.ml b/otherlibs/labltk/jpf/fileselect.ml
index 728a0245d..3ee1ddfc2 100644
--- a/otherlibs/labltk/jpf/fileselect.ml
+++ b/otherlibs/labltk/jpf/fileselect.ml
@@ -36,8 +36,8 @@ let myentry_create p :variable =
let subshell cmd =
let r,w = pipe () in
match fork () with
- 0 -> close r; dup2 w stdout;
- execv prog:"/bin/sh" args:[| "/bin/sh"; "-c"; cmd |];
+ 0 -> close r; dup2 src:w dst:stdout;
+ execv name:"/bin/sh" args:[| "/bin/sh"; "-c"; cmd |];
exit 127
| id ->
close w;
@@ -48,7 +48,7 @@ let subshell cmd =
in
let answer = it() in
close_in rc; (* because of finalize_channel *)
- let p, st = waitpid flags:[] id in answer
+ let p, st = waitpid mode:[] id in answer
(***************************************************************** Path name *)
@@ -57,20 +57,20 @@ let dirget = regexp "^\([^\*?[]*/\)\(.*\)"
let parse_filter src =
(* replace // by / *)
- let s = global_replace (regexp "/+") with:"/" src in
+ let s = global_replace pat:(regexp "/+") with:"/" src in
(* replace /./ by / *)
- let s = global_replace (regexp "/\./") with:"/" s in
+ let s = global_replace pat:(regexp "/\./") with:"/" s in
(* replace ????/../ by "" *)
- let s = global_replace
- (regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./")
- with:"" s in
+ let s = global_replace s
+ pat:(regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\./")
+ with:"" in
(* replace ????/..$ by "" *)
- let s = global_replace
- (regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$")
- with:"" s in
+ let s = global_replace s
+ pat:(regexp "\([^/]\|[^\./][^/]\|[^/][^\./]\|[^/][^/]+\)/\.\.$")
+ with:"" in
(* replace ^/../../ by / *)
- let s = global_replace (regexp "^\(/\.\.\)+/") with:"/" s in
- if string_match dirget s pos:0 then
+ let s = global_replace pat:(regexp "^\(/\.\.\)+/") with:"/" s in
+ if string_match pat:dirget s pos:0 then
let dirs = matched_group 1 s
and ptrn = matched_group 2 s
in
@@ -96,7 +96,7 @@ let get_files_in_directory dir =
let rec get_directories_in_files path = function
[] -> []
| x::xs ->
- if try (stat file:(path ^ x)).st_kind = S_DIR with _ -> false then
+ if try (stat name:(path ^ x)).st_kind = S_DIR with _ -> false then
x::(get_directories_in_files path xs)
else get_directories_in_files path xs
@@ -104,7 +104,7 @@ let remove_directories dirname =
let rec remove = function
[] -> []
| x :: xs ->
- if try (stat file:(dirname ^ x)).st_kind = S_DIR with _ -> true then
+ if try (stat name:(dirname ^ x)).st_kind = S_DIR with _ -> true then
remove xs
else
x :: (remove xs)
@@ -213,7 +213,7 @@ let f :title action:proc filter:deffilter file:deffile :multi :sync =
(* OLDER let curdir = getcwd () in *)
(* Printf.eprintf "CURDIR %s\n" curdir; *)
let filter =
- if string_match (regexp "^/.*") filter pos:0 then filter
+ if string_match pat:(regexp "^/.*") filter pos:0 then filter
else
if filter = "" then !global_dir ^ "/*"
else !global_dir ^ "/" ^ filter in
diff --git a/otherlibs/labltk/support/support.ml b/otherlibs/labltk/support/support.ml
index eee855cae..6e1e835bf 100644
--- a/otherlibs/labltk/support/support.ml
+++ b/otherlibs/labltk/support/support.ml
@@ -1,46 +1,8 @@
(* $Id$ *)
-(* Extensible buffers *)
-type extensible_buffer = {
- mutable buffer : string;
- mutable pos : int;
- mutable len : int}
-
-let new_buffer () = {
- buffer = String.create len:128;
- pos = 0;
- len = 128
- }
-
-let print_in_buffer buf s =
- let l = String.length s in
- if buf.pos + l > buf.len then begin
- buf.buffer <- buf.buffer ^ (String.create len:(l+128));
- buf.len <- buf.len + 128 + l
- end;
- String.blit s pos:0 to:buf.buffer to_pos:buf.pos len:l;
- buf.pos <- buf.pos + l
-
-let get_buffer buf =
- String.sub buf.buffer pos:0 len:buf.pos
-
-
-
-(* Used by list converters *)
-let catenate_sep sep =
- function
- [] -> ""
- | [x] -> x
- | x::l ->
- let b = new_buffer() in
- print_in_buffer b x;
- List.iter l
- fun:(function s -> print_in_buffer b sep; print_in_buffer b s);
- get_buffer b
-
(* Parsing results of Tcl *)
(* List.split a string according to char_sep predicate *)
-let split_str char_sep str =
+let split_str pred:char_sep str =
let len = String.length str in
let rec skip_sep cur =
if cur >= len then cur
diff --git a/otherlibs/labltk/support/support.mli b/otherlibs/labltk/support/support.mli
index 798842298..6db2efc2c 100644
--- a/otherlibs/labltk/support/support.mli
+++ b/otherlibs/labltk/support/support.mli
@@ -1,11 +1,3 @@
-(* Extensible buffers *)
-type extensible_buffer
-val new_buffer : unit -> extensible_buffer
-val print_in_buffer : extensible_buffer -> string -> unit
-val get_buffer : extensible_buffer -> string
-
-
-val catenate_sep : string -> string list -> string
-val split_str : (char -> bool) -> string -> string list
- (* Various string manipulations *)
+(* $Id$ *)
+val split_str : pred:(char -> bool) -> string -> string list
diff --git a/otherlibs/labltk/support/textvariable.ml b/otherlibs/labltk/support/textvariable.ml
index 363b95d3e..770dd119f 100644
--- a/otherlibs/labltk/support/textvariable.ml
+++ b/otherlibs/labltk/support/textvariable.ml
@@ -82,12 +82,12 @@ let add w v =
let r = ref StringSet.empty in
Hashtbl.add memo key:w data:r;
r in
- r := StringSet.add !r elt:v
+ r := StringSet.add !r key:v
(* to be used with care ! *)
let free v =
rem_all_handles v;
- freelist := StringSet.add elt:v !freelist
+ freelist := StringSet.add key:v !freelist
(* Free variables associated with a widget *)
let freew w =
@@ -110,7 +110,7 @@ let getv () =
end
else
let v = StringSet.choose !freelist in
- freelist := StringSet.remove elt:v !freelist;
+ freelist := StringSet.remove key:v !freelist;
v in
set v to:"";
v
@@ -126,7 +126,7 @@ let create ?on: w () =
(* to be used with care ! *)
let free v =
- freelist := StringSet.add elt:v !freelist
+ freelist := StringSet.add key:v !freelist
let cCAMLtoTKtextVariable s = TkToken s
diff --git a/otherlibs/labltk/support/widget.ml b/otherlibs/labltk/support/widget.ml
index 8c86e4448..7492c83a6 100644
--- a/otherlibs/labltk/support/widget.ml
+++ b/otherlibs/labltk/support/widget.ml
@@ -150,11 +150,11 @@ let check_class w clas =
match w with
Untyped _ -> () (* assume run-time check by tk*)
| Typed(_,c) ->
- if List.mem clas item:c then ()
+ if List.mem clas key:c then ()
else raise (IllegalWidgetType c)
(* Checking membership of constructor in subtype table *)
let chk_sub errname table c =
- if List.mem table item:c then ()
+ if List.mem table key:c then ()
else raise (Invalid_argument errname)
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-03-21 19:20:20 +0000