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 <st...@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

_______________________________________________
Pkg-ocaml-maint-commits mailing list
Pkg-ocaml-maint-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits

Reply via email to