[Pkg-ocaml-maint-commits] [labltk] 02/05: Imported Upstream version 8.06.1+dfsg
Stéphane Glondu
glondu at moszumanska.debian.org
Wed Jun 8 15:29:44 UTC 2016
This is an automated email from the git hooks/post-receive script.
glondu pushed a commit to branch master
in repository labltk.
commit 2ba9e91c8fe1382a44625ad05cbe700b25a557d4
Author: Stephane Glondu <steph at glondu.net>
Date: Wed Jun 8 17:21:23 2016 +0200
Imported Upstream version 8.06.1+dfsg
---
.gitignore | 4 ++++
Changes | 10 +++++++++
README.md | 7 ++++++
browser/Makefile | 4 ++--
browser/Makefile.nt | 4 ++--
browser/Makefile.shared | 6 ++---
browser/{dummyUnix.mli => dummyUnix.ml} | 4 ++--
browser/{dummyWin.mli => dummyWin.ml} | 0
browser/fileselect.ml | 2 +-
browser/jg_completion.ml | 7 +++---
browser/jg_completion.mli | 2 +-
browser/searchid.ml | 25 +++++++++++----------
browser/searchpos.ml | 39 ++++++++++++++++++++++-----------
browser/viewer.ml | 4 ++--
camltk/Makefile | 2 +-
labltk/Makefile | 2 +-
support/Makefile.common | 2 +-
support/camltk.h | 4 ++--
support/cltkCaml.c | 2 +-
support/cltkUtf.c | 4 ++--
20 files changed, 86 insertions(+), 48 deletions(-)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..f58b073
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
+labltklink
+labltkopt
+Makefile.config
+config.status
diff --git a/Changes b/Changes
index b9aae74..95c963f 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,13 @@
+2016-04-27:
+-----------
+* Release labltk-8.06.1
+* Adapt to ocaml 4.03
+* Fix const qualifiers in C code
+
+2014-12-22:
+-----------
+* Adapt to changes in trunk
+
2014-09-18:
-----------
* Release labltk-8.06.0
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..0789125
--- /dev/null
+++ b/README.md
@@ -0,0 +1,7 @@
+LablTk is an interface to the Tcl/Tk GUI framework. It allows to develop GUI applications in a speedy and type safe way. A legacy Camltk interface is included. The OCamlBrowser library viewer is also part of this project.
+
+The project page is:
+https://forge.ocamlcore.org/projects/labltk/
+
+You can find documentation here:
+https://forge.ocamlcore.org/docman/?group_id=343&view=listfile&dirid=385
diff --git a/browser/Makefile b/browser/Makefile
index 8d96439..e9e4c30 100644
--- a/browser/Makefile
+++ b/browser/Makefile
@@ -16,5 +16,5 @@
include Makefile.shared
-dummy.mli:
- cp dummyUnix.mli dummy.mli
+dummy.ml:
+ cp dummyUnix.ml dummy.ml
diff --git a/browser/Makefile.nt b/browser/Makefile.nt
index 431a7f5..a51b4b4 100644
--- a/browser/Makefile.nt
+++ b/browser/Makefile.nt
@@ -29,5 +29,5 @@ XTRALIBS=threads.cma -custom $(WINDOWS_APP)
include Makefile.shared
-dummy.mli:
- cp dummyWin.mli dummy.mli
+dummy.ml:
+ cp dummyWin.ml dummy.ml
diff --git a/browser/Makefile.shared b/browser/Makefile.shared
index bef459a..b44814b 100644
--- a/browser/Makefile.shared
+++ b/browser/Makefile.shared
@@ -18,8 +18,8 @@ LABLTKLIB=-I ../labltk -I ../lib -I ../support -I +compiler-libs
INCLUDES=$(LABLTKLIB)
OBJ = list2.cmo useunix.cmo setpath.cmo lexical.cmo \
- fileselect.cmo searchid.cmo searchpos.cmo shell.cmo \
- help.cmo \
+ fileselect.cmo searchid.cmo searchpos.cmo \
+ dummy.cmo shell.cmo help.cmo \
viewer.cmo typecheck.cmo editor.cmo main.cmo
JG = jg_tk.cmo jg_config.cmo jg_bind.cmo jg_completion.cmo \
@@ -63,7 +63,7 @@ install:
cp ocamlbrowser$(EXE) $(INSTALLBINDIR)
clean:
- rm -f *.cm? ocamlbrowser$(EXE) dummy.mli *~ *.orig *.$(O) help.ml
+ rm -f *.cm? ocamlbrowser$(EXE) dummy.ml *~ *.orig *.$(O) help.ml
depend: help.ml
$(CAMLDEP) $(LABLTKLIB) *.ml *.mli > .depend
diff --git a/browser/dummyUnix.mli b/browser/dummyUnix.ml
similarity index 96%
rename from browser/dummyUnix.mli
rename to browser/dummyUnix.ml
index 1373681..447574f 100644
--- a/browser/dummyUnix.mli
+++ b/browser/dummyUnix.ml
@@ -14,14 +14,14 @@
(* $Id$ *)
-module Mutex : sig
+module Mutex = struct
type t
external create : unit -> t = "%ignore"
external lock : t -> unit = "%ignore"
external unlock : t -> unit = "%ignore"
end
-module Thread : sig
+module Thread = struct
type t
external create : ('a -> 'b) -> 'a -> t = "caml_ml_input"
end
diff --git a/browser/dummyWin.mli b/browser/dummyWin.ml
similarity index 100%
rename from browser/dummyWin.mli
rename to browser/dummyWin.ml
diff --git a/browser/fileselect.ml b/browser/fileselect.ml
index d62b8ba..52f55b8 100644
--- a/browser/fileselect.ml
+++ b/browser/fileselect.ml
@@ -131,7 +131,7 @@ let f ~title ~action:proc ?(dir = Unix.getcwd ())
List.fold_left !Config.load_path ~init:[] ~f:
begin fun acc dir ->
let files = ls ~dir ~pattern in
- Sort.merge (<) files
+ List.merge compare files
(List.fold_left files ~init:acc
~f:(fun acc name -> List2.exclude name acc))
end
diff --git a/browser/jg_completion.ml b/browser/jg_completion.ml
index a5457a6..c4791dd 100644
--- a/browser/jg_completion.ml
+++ b/browser/jg_completion.ml
@@ -14,8 +14,9 @@
(* $Id$ *)
-let lt_string ?(nocase=false) s1 s2 =
- if nocase then String.lowercase s1 < String.lowercase s2 else s1 < s2
+let compare_string ?(nocase=false) s1 s2 =
+ if nocase then compare (String.lowercase s1) (String.lowercase s2)
+ else compare s1 s2
class completion ?nocase texts = object
val mutable texts = texts
@@ -25,7 +26,7 @@ class completion ?nocase texts = object
method add c =
prefix <- prefix ^ c;
while current < List.length texts - 1 &&
- lt_string (List.nth texts current) prefix ?nocase
+ compare_string (List.nth texts current) prefix ?nocase < 0
do
current <- current + 1
done;
diff --git a/browser/jg_completion.mli b/browser/jg_completion.mli
index 40c2db3..2090800 100644
--- a/browser/jg_completion.mli
+++ b/browser/jg_completion.mli
@@ -14,7 +14,7 @@
(* $Id$ *)
-val lt_string : ?nocase:bool -> string -> string -> bool
+val compare_string : ?nocase:bool -> string -> string -> int
class timed : ?nocase:bool -> ?wait:int -> string list -> object
val mutable texts : string list
diff --git a/browser/searchid.ml b/browser/searchid.ml
index 0074551..ce9cce9 100644
--- a/browser/searchid.ml
+++ b/browser/searchid.ml
@@ -128,7 +128,7 @@ let rec equal ~prefix t1 t2 =
begin fun l1 ->
List.for_all2 l1 l2 ~f:
begin fun (p1,t1) (p2,t2) ->
- (p1 = "" || p1 = p2) && equal t1 t2 ~prefix
+ (p1 = Nolabel || p1 = p2) && equal t1 t2 ~prefix
end
end
| Ttuple l1, Ttuple l2 ->
@@ -140,8 +140,7 @@ let rec equal ~prefix t1 t2 =
&& List.for_all2 l1 l2 ~f:(equal ~prefix)
| _ -> false
-let is_opt s = s <> "" && s.[0] = '?'
-let get_options = List.filter ~f:is_opt
+let get_options = List.filter ~f:Btype.is_optional
let rec included ~prefix t1 t2 =
match (repr t1).desc, (repr t2).desc with
@@ -170,14 +169,14 @@ let rec included ~prefix t1 t2 =
let l2 = if arr len1 ~card:len2 < 100 then l2 else
let ll1 = get_options (fst (List.split l1)) in
List.filter l2
- ~f:(fun (l,_) -> not (is_opt l) || List.mem l ll1)
+ ~f:(fun (l,_) -> not (is_optional l) || List.mem l ll1)
in
len1 <= len2 &&
List.exists (List2.flat_map ~f:permutations (choose len1 ~card:l2)) ~f:
begin fun l2 ->
List.for_all2 l1 l2 ~f:
begin fun (p1,t1) (p2,t2) ->
- (p1 = "" || p1 = p2) && included t1 t2 ~prefix
+ (p1 = Nolabel || p1 = p2) && included t1 t2 ~prefix
end
end
| Ttuple l1, Ttuple l2 ->
@@ -217,6 +216,10 @@ let rec search_type_in_signature t ~sign ~prefix ~mode =
`Included -> included t ~prefix
| `Exact -> equal t ~prefix
and lid_of_id id = mklid (prefix @ [Ident.name id]) in
+ let constructor_matches = function
+ Types.Cstr_tuple l -> List.exists l ~f:matches
+ | Cstr_record l -> List.exists l ~f:(fun d -> matches d.Types.ld_type)
+ in
List2.flat_map sign ~f:
begin fun item -> match item with
Sig_value (id, vd) ->
@@ -233,8 +236,8 @@ let rec search_type_in_signature t ~sign ~prefix ~mode =
| Type_open -> false
| Type_variant l ->
List.exists l ~f:
- begin fun {Types.cd_args=l; cd_res=r} ->
- List.exists l ~f:matches ||
+ begin fun {Types.cd_args=args; cd_res=r} ->
+ constructor_matches args ||
match r with None -> false | Some x -> matches x
end
| Type_record(l, rep) ->
@@ -242,7 +245,7 @@ let rec search_type_in_signature t ~sign ~prefix ~mode =
end
then [lid_of_id id, Ptype] else []
| Sig_typext (id, l, _) ->
- if List.exists l.ext_args ~f:matches
+ if constructor_matches l.ext_args
then [lid_of_id id, Pconstructor]
else []
| Sig_module (id, {md_type=Mty_signature sign}, _) ->
@@ -270,7 +273,7 @@ let search_all_types t ~mode =
`Exact, _ -> [t]
| `Included, Tarrow _ -> [t]
| `Included, _ ->
- [t; newty(Tarrow("",t,newvar(),Cok)); newty(Tarrow("",newvar(),t,Cok))]
+ [t; newty(Tarrow(Nolabel,t,newvar(),Cok)); newty(Tarrow(Nolabel,newvar(),t,Cok))]
in List2.flat_map !module_list ~f:
begin fun modname ->
let mlid = Lident modname in
@@ -465,7 +468,7 @@ let search_structure str ~name ~kind ~prefix =
end;
false
| Pstr_primitive vd when kind = Pvalue -> name = vd.pval_name.txt
- | Pstr_type l when kind = Ptype ->
+ | Pstr_type (_, l) when kind = Ptype ->
List.iter l ~f:
begin fun td ->
if td.ptype_name.txt = name
@@ -526,7 +529,7 @@ let search_signature sign ~name ~kind ~prefix =
begin fun item ->
if match item.psig_desc with
Psig_value vd when kind = Pvalue -> name = vd.pval_name.txt
- | Psig_type l when kind = Ptype ->
+ | Psig_type (_, l) when kind = Ptype ->
List.iter l ~f:
begin fun td ->
if td.ptype_name.txt = name
diff --git a/browser/searchpos.ml b/browser/searchpos.ml
index ca0b44c..0111acd 100644
--- a/browser/searchpos.ml
+++ b/browser/searchpos.ml
@@ -20,8 +20,8 @@ open Support
open Tk
open Jg_tk
open Parsetree
-open Types
open Typedtree
+open Types
open Location
open Longident
open Path
@@ -158,6 +158,16 @@ let rec search_pos_class_type cl ~pos ~env =
| Pcty_extension _ -> ()
end
+let search_pos_arguments ~pos ~env = function
+ Pcstr_tuple l -> List.iter l ~f:(search_pos_type ~pos ~env)
+ | Pcstr_record l -> List.iter l ~f:(fun ld -> search_pos_type ld.pld_type ~pos ~env)
+
+let search_pos_constructor pcd ~pos ~env =
+ if in_loc ~pos pcd.pcd_loc then begin
+ Misc.may (search_pos_type ~pos ~env) pcd.pcd_res;
+ search_pos_arguments ~pos ~env pcd.pcd_args
+ end
+
let search_pos_type_decl td ~pos ~env =
if in_loc ~pos td.ptype_loc then begin
begin match td.ptype_manifest with
@@ -168,8 +178,7 @@ let search_pos_type_decl td ~pos ~env =
Ptype_abstract
| Ptype_open -> ()
| Ptype_variant dl ->
- List.iter dl
- ~f:(fun pcd -> List.iter pcd.pcd_args ~f:(search_pos_type ~pos ~env)) (* iter on pcd_res? *)
+ List.iter dl ~f:(search_pos_constructor ~pos ~env)
| Ptype_record dl ->
List.iter dl ~f:(fun pld -> search_pos_type pld.pld_type ~pos ~env) in
search_tkind td.ptype_kind;
@@ -182,7 +191,7 @@ let search_pos_type_decl td ~pos ~env =
let search_pos_extension ext ~pos ~env =
begin match ext.pext_kind with
- Pext_decl (l, _) -> List.iter l ~f:(search_pos_type ~pos ~env)
+ Pext_decl (l, _) -> search_pos_arguments l ~pos ~env
| Pext_rebind _ -> ()
end
@@ -205,7 +214,7 @@ let rec search_pos_signature l ~pos ~env =
if in_loc ~pos pt.psig_loc then
begin match pt.psig_desc with
Psig_value desc -> search_pos_type desc.pval_type ~pos ~env
- | Psig_type l ->
+ | Psig_type (_, l) ->
List.iter l ~f:(search_pos_type_decl ~pos ~env)
| Psig_typext pty ->
List.iter pty.ptyext_constructors
@@ -507,7 +516,7 @@ and view_expr_type ?title ?path ?env ?(name="noname") t =
in
view_signature ~title ?path ?env
[Sig_value (id, {val_type = t; val_kind = Val_reg; val_attributes=[];
- Types.val_loc = Location.none})]
+ val_loc = Location.none})]
and view_decl lid ~kind ~env =
match kind with
@@ -573,9 +582,9 @@ and view_decl_menu lid ~kind ~env ~parent =
type fkind = [
`Exp of
[`Expr|`Pat|`Const|`Val of Path.t|`Var of Path.t|`New of Path.t]
- * Types.type_expr
- | `Class of Path.t * Types.class_type
- | `Module of Path.t * Types.module_type
+ * type_expr
+ | `Class of Path.t * class_type
+ | `Module of Path.t * module_type
]
let view_type kind ~env =
@@ -612,7 +621,7 @@ let view_type kind ~env =
Mty_signature sign -> view_signature sign ~path ~env
| modtype ->
let md =
- {Types.md_type = mty; md_attributes = []; md_loc = Location.none} in
+ {md_type = mty; md_attributes = []; md_loc = Location.none} in
view_signature_item ~path ~env
[Sig_module(ident_of_path path ~default:"M", md, Trec_not)]
@@ -691,7 +700,7 @@ let rec search_pos_structure ~pos str =
| Tstr_recmodule bindings ->
List.iter bindings ~f:(fun mb -> search_pos_module_expr mb.mb_expr ~pos)
| Tstr_class l ->
- List.iter l ~f:(fun (cl, _, _) -> search_pos_class_expr cl.ci_expr ~pos)
+ List.iter l ~f:(fun (ci, _) -> search_pos_class_expr ci.ci_expr ~pos)
| Tstr_include {incl_mod=m} -> search_pos_module_expr m ~pos
| Tstr_primitive _
| Tstr_type _
@@ -733,7 +742,7 @@ and search_pos_class_expr ~pos cl =
search_pos_class_expr cl ~pos
| Tcl_apply (cl, el) ->
search_pos_class_expr cl ~pos;
- List.iter el ~f:(fun (_, x,_) -> Misc.may (search_pos_expr ~pos) x)
+ List.iter el ~f:(fun (_, x) -> Misc.may (search_pos_expr ~pos) x)
| Tcl_let (_, pel, iel, cl) ->
List.iter pel ~f:
begin fun {vb_pat=pat; vb_expr=exp} ->
@@ -776,7 +785,7 @@ and search_pos_expr ~pos exp =
| Texp_function (_, l, _) ->
List.iter l ~f:(search_case ~pos)
| Texp_apply (exp, l) ->
- List.iter l ~f:(fun (_, x,_) -> Misc.may (search_pos_expr ~pos) x);
+ List.iter l ~f:(fun (_, x) -> Misc.may (search_pos_expr ~pos) x);
search_pos_expr exp ~pos
| Texp_match (exp, l, _, _) ->
search_pos_expr exp ~pos;
@@ -830,6 +839,10 @@ and search_pos_expr ~pos exp =
search_pos_class_structure ~pos cls
| Texp_pack modexp ->
search_pos_module_expr modexp ~pos
+ | Texp_unreachable ->
+ ()
+ | Texp_extension_constructor _ ->
+ ()
end;
add_found_str (`Exp(`Expr, exp.exp_type)) ~env:exp.exp_env ~loc:exp.exp_loc
end
diff --git a/browser/viewer.ml b/browser/viewer.ml
index a0fe47a..5ca8896 100644
--- a/browser/viewer.ml
+++ b/browser/viewer.ml
@@ -44,7 +44,7 @@ let list_modules ~path =
let reset_modules box =
Listbox.delete box ~first:(`Num 0) ~last:`End;
- module_list := Sort.list (Jg_completion.lt_string ~nocase:true)
+ module_list := List.sort (Jg_completion.compare_string ~nocase:true)
(list_modules ~path:!Config.load_path);
Listbox.insert box ~index:`End ~texts:!module_list;
Jg_box.recenter box ~index:(`Num 0)
@@ -76,7 +76,7 @@ let view_symbol ~kind ~env ?path id =
[Sig_typext (Ident.create name,
{Types.ext_type_path = cpath;
ext_type_params = args;
- ext_args = cd.cstr_args;
+ ext_args = Cstr_tuple cd.cstr_args;
ext_ret_type = (if cd.cstr_generalized
then Some cd.cstr_res else None);
ext_private = cd.cstr_private;
diff --git a/camltk/Makefile b/camltk/Makefile
index 0736c83..ed4b3a0 100644
--- a/camltk/Makefile
+++ b/camltk/Makefile
@@ -16,7 +16,7 @@
include ../support/Makefile.common
-COMPFLAGS= -I ../support
+COMPFLAGS= -I ../support -no-alias-deps
all: camltkobjs
diff --git a/labltk/Makefile b/labltk/Makefile
index c68b01e..8fb58db 100644
--- a/labltk/Makefile
+++ b/labltk/Makefile
@@ -16,7 +16,7 @@
include ../support/Makefile.common
-COMPFLAGS= -I ../support
+COMPFLAGS= -I ../support -no-alias-deps
all: labltkobjs
diff --git a/support/Makefile.common b/support/Makefile.common
index d24d591..32757ec 100644
--- a/support/Makefile.common
+++ b/support/Makefile.common
@@ -25,7 +25,7 @@ CAMLC=$(BINDIR)/ocamlc$(OPT)
CAMLOPT=$(BINDIR)/ocamlopt$(OPT)
CAMLCB=$(BINDIR)/ocamlc
CAMLOPTB=$(BINDIR)/ocamlopt
-CAMLCOMP=$(CAMLC) -c -warn-error A-3
+CAMLCOMP=$(CAMLC) -c -warn-error A-3-52
CAMLYACC=$(BINDIR)/ocamlyacc -v
CAMLLEX=$(BINDIR)/ocamllex
CAMLLIBR=$(CAMLC) -a
diff --git a/support/camltk.h b/support/camltk.h
index 9efbbea..2c92f90 100644
--- a/support/camltk.h
+++ b/support/camltk.h
@@ -40,7 +40,7 @@
extern char *string_to_c(value s);
/* cltkUtf.c */
-extern value tcl_string_to_caml( char * );
+extern value tcl_string_to_caml( const char * );
extern char * caml_string_to_tcl( value );
/* cltkEval.c */
@@ -53,7 +53,7 @@ extern value *tkerror_exn;
extern value *handler_code;
extern int CamlCBCmd(ClientData clientdata, Tcl_Interp *interp,
int argc, CONST84 char *argv[]);
-CAMLTKextern void tk_error(char * errmsg) Noreturn;
+CAMLTKextern void tk_error(const char * errmsg) Noreturn;
/* cltkMain.c */
extern int signal_events;
diff --git a/support/cltkCaml.c b/support/cltkCaml.c
index 9a3d38a..4234dde 100644
--- a/support/cltkCaml.c
+++ b/support/cltkCaml.c
@@ -63,7 +63,7 @@ CAMLprim value camltk_return (value v)
}
/* Note: raise_with_string WILL copy the error message */
-CAMLprim void tk_error(char *errmsg)
+CAMLprim void tk_error(const char *errmsg)
{
raise_with_string(*tkerror_exn, errmsg);
}
diff --git a/support/cltkUtf.c b/support/cltkUtf.c
index 61dbfb2..b104256 100644
--- a/support/cltkUtf.c
+++ b/support/cltkUtf.c
@@ -50,7 +50,7 @@ char *external_to_utf( char *str ){
return res;
}
-char *utf_to_external( char *str ){
+char *utf_to_external( const char *str ){
char *res;
Tcl_DString dstr;
int length;
@@ -69,7 +69,7 @@ char *caml_string_to_tcl( value s )
return external_to_utf( String_val(s) );
}
-value tcl_string_to_caml( char *s )
+value tcl_string_to_caml( const char *s )
{
CAMLparam0();
CAMLlocal1(res);
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/labltk.git
More information about the Pkg-ocaml-maint-commits
mailing list