Hello community, here is the log from the commit of package ocaml-labltk for openSUSE:Factory checked in at 2017-08-18 15:03:45 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ocaml-labltk (Old) and /work/SRC/openSUSE:Factory/.ocaml-labltk.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ocaml-labltk" Fri Aug 18 15:03:45 2017 rev:3 rq:517022 version:8.06.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ocaml-labltk/ocaml-labltk.changes 2016-07-15 12:46:54.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ocaml-labltk.new/ocaml-labltk.changes 2017-08-18 15:03:49.543041122 +0200 @@ -1,0 +2,22 @@ +Tue Jul 25 13:04:54 UTC 2017 - [email protected] + +- Use Group: Development/Languages/OCaml + +------------------------------------------------------------------- +Mon Jul 17 20:24:18 UTC 2017 - [email protected] + +- Update to version 8.06.3 + Adjust for ocaml-4.05 + remove labltk-8.06.1.patch + +------------------------------------------------------------------- +Mon Jul 17 12:48:58 UTC 2017 - [email protected] + +- Wrap specfile conditionals to fix quilt setup + +------------------------------------------------------------------- +Mon Jul 17 10:48:58 UTC 2017 - [email protected] + +- Remove autodeps for pre openSUSE 12.1 releases + +------------------------------------------------------------------- Old: ---- labltk-8.06.1.patch labltk-8.06.1.tar.xz New: ---- labltk-8.06.3.tar.xz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ocaml-labltk.spec ++++++ --- /var/tmp/diff_new_pack.IFvowp/_old 2017-08-18 15:03:50.362925708 +0200 +++ /var/tmp/diff_new_pack.IFvowp/_new 2017-08-18 15:03:50.382922893 +0200 @@ -1,7 +1,7 @@ # # spec file for package ocaml-labltk # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -16,29 +16,21 @@ # -Version: 8.06.1 -Release: 0 -%{ocaml_preserve_bytecode} Name: ocaml-labltk +Version: 8.06.3 +Release: 0 +%{?ocaml_preserve_bytecode} Summary: Tcl/Tk framework for ocaml License: SUSE-LGPL-2.0-with-linking-exception -Group: System/Libraries +Group: Development/Languages/OCaml Url: https://forge.ocamlcore.org/projects/labltk/ Source: labltk-%{version}.tar.xz -Patch0: labltk-8.06.1.patch -Conflicts: ocaml < 4.02.0 -BuildRequires: ocaml >= 4.02.0 +BuildRequires: ocaml BuildRequires: ocaml-findlib -BuildRequires: ocaml-rpm-macros >= 4.02.1 +BuildRequires: ocaml-rpm-macros >= 4.05.0 BuildRequires: tcl-devel BuildRequires: tk-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# ocaml autodep start for pkg: ocaml-labltk -# hardcoded rpm dependency for pre 12.1 to compensate for lack of ocaml() provides/requires -%if 0%{?suse_version} < 1210 -Requires: ocaml-runtime -%endif -# ocaml autodep end for pkg: ocaml-labltk %description LablTk is an interface to the Tcl/Tk GUI framework. It allows to @@ -47,14 +39,8 @@ also part of this project. %package devel -# ocaml autodep start for pkg: ocaml-labltk-devel -# hardcoded rpm dependency for pre 12.1 to compensate for lack of ocaml() provides/requires -%if 0%{?suse_version} < 1210 -Requires: ocaml-runtime -%endif -# ocaml autodep end for pkg: ocaml-labltk-devel Summary: Development files for labltk -Group: Development/Libraries/Other +Group: Development/Languages/OCaml Requires: %{name} = %{version} Requires: tcl-devel Requires: tk-devel @@ -68,17 +54,13 @@ browser for code editing and library browsing. %prep %setup -q -n labltk-%{version} -%patch0 -p1 -find -name .gitignore -print -delete %build ./configure --use-findlib make \ - %{?_smp_mflags} \ byte -%if %{ocaml_native_compiler} +%if 0%{?ocaml_native_compiler} make \ - %{?_smp_mflags} \ opt %endif @@ -116,7 +98,7 @@ /etc/ld.so.conf.d/*.conf %dir %{_libdir}/ocaml %dir %{_libdir}/ocaml/* -%if %{ocaml_native_compiler} +%if 0%{?ocaml_native_compiler} %endif %{_libdir}/ocaml/*/*.so %{_libdir}/ocaml/*/*.so.owner @@ -132,7 +114,7 @@ %dir %{_libdir}/ocaml %dir %{_libdir}/ocaml/* %{_libdir}/ocaml/*/*.a -%if %{ocaml_native_compiler} +%if 0%{?ocaml_native_compiler} %{_libdir}/ocaml/*/*.cmx %{_libdir}/ocaml/*/*.cmxa %endif ++++++ labltk-8.06.1.tar.xz -> labltk-8.06.3.tar.xz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/Changes new/labltk-8.06.3/Changes --- old/labltk-8.06.1/Changes 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/Changes 2017-07-19 05:52:11.000000000 +0200 @@ -1,3 +1,24 @@ +2017-07-19: +----------- +* Release labltk-8.06.3, for ocaml 4.05 +* Various fixes for ocaml 4.05 (merge debian patches by Stephane Glondu) + +2016-08-13: +----------- +* suppress gcc warning about unused variable (Damien Doligez) + +2016-08-10: +----------- +* Release labltk-8.06.2, for ocaml 4.04 + +2016-08-02: +----------- +* update browser for 4.04 + +2016-04-28: +----------- +* Fix warning 52 + 2016-04-27: ----------- * Release labltk-8.06.1 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/Makefile new/labltk-8.06.3/Makefile --- old/labltk-8.06.1/Makefile 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/Makefile 2017-07-19 05:52:11.000000000 +0200 @@ -46,7 +46,7 @@ byte: all opt: allopt -.PHONY: all allopt byte opt +.PHONY: all allopt byte opt apiref .PHONY: labltk camltk examples examples_labltk examples_camltk .PHONY: install installopt partialclean clean depend @@ -66,6 +66,10 @@ examples_camltk: cd examples_camltk; $(MAKE) all +SUPPORTMLIS= fileevent support textvariable timer tkthread widget +apiref: + $(BINDIR)/ocamldoc -I +threads -I support -I labltk $(SUPPORTMLIS:%=support/%.mli) labltk/*.mli labltk/tk.ml -sort -d htdocs/apiref -html || echo "There were errors" + install: cd support; $(MAKE) install cd lib; $(MAKE) install diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/browser/editor.ml new/labltk-8.06.3/browser/editor.ml --- old/labltk-8.06.1/browser/editor.ml 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/browser/editor.ml 2017-07-19 05:52:11.000000000 +0200 @@ -83,7 +83,7 @@ and ic = Entry.create fi ~width:10 and get_int ew = try int_of_string (Entry.get ew) - with Failure "int_of_string" -> 0 + with Failure _ (*"int_of_string"*) -> 0 in let buttons = Frame.create tl in let ok = Button.create buttons ~text:"Ok" ~command: @@ -184,7 +184,7 @@ end; match token with CLASS | EXTERNAL | EXCEPTION | FUNCTOR - | LET | MODULE | OPEN | TYPE | VAL | SHARP when bol -> + | LET | MODULE | OPEN | TYPE | VAL | HASH when bol -> if !block_start = [] then if !after then pend := pos else start := pos else block_start := pos :: List.tl !block_start diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/browser/lexical.ml new/labltk-8.06.3/browser/lexical.ml --- old/labltk-8.06.1/browser/lexical.ml 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/browser/lexical.ml 2017-07-19 05:52:12.000000000 +0200 @@ -111,7 +111,7 @@ | INFIXOP3 _ | INFIXOP4 _ | PREFIXOP _ - | SHARP + | HASH -> "infix" | LABEL _ | OPTLABEL _ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/browser/searchid.ml new/labltk-8.06.3/browser/searchid.ml --- old/labltk-8.06.1/browser/searchid.ml 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/browser/searchid.ml 2017-07-19 05:52:12.000000000 +0200 @@ -437,6 +437,7 @@ | Ppat_lazy pat -> bound_variables pat | Ppat_extension _ -> [] | Ppat_exception pat -> bound_variables pat + | Ppat_open (_, pat) -> bound_variables pat let search_structure str ~name ~kind ~prefix = let loc = ref 0 in diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/browser/searchpos.ml new/labltk-8.06.3/browser/searchpos.ml --- old/labltk-8.06.1/browser/searchpos.ml 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/browser/searchpos.ml 2017-07-19 05:52:12.000000000 +0200 @@ -485,7 +485,7 @@ [Sig_type(ident_of_path path ~default:"t", td, Trec_first)] and view_type_id li ~env = - let path, decl = lookup_type li env in + let path = lookup_type li env in view_type_decl path ~env and view_class_id li ~env = @@ -528,7 +528,7 @@ and view_decl_menu lid ~kind ~env ~parent = let path, kname = try match kind with - `Type -> fst (lookup_type lid env), "Type" + `Type -> lookup_type lid env, "Type" | `Class -> fst (lookup_class lid env), "Class" | `Module -> lookup_module ~load:true lid env, "Module" | `Modtype -> fst (lookup_modtype lid env), "Module type" @@ -782,7 +782,7 @@ search_pos_expr exp' ~pos end; search_pos_expr exp ~pos - | Texp_function (_, l, _) -> + | Texp_function {cases=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); @@ -797,8 +797,9 @@ | Texp_construct (_, _, l) -> List.iter l ~f:(search_pos_expr ~pos) | Texp_variant (_, None) -> () | Texp_variant (_, Some exp) -> search_pos_expr exp ~pos - | Texp_record (l, opt) -> - List.iter l ~f:(fun (_, _, exp) -> search_pos_expr exp ~pos); + | Texp_record {fields=l; extended_expression=opt} -> + Array.iter l ~f: + (function (_,Overridden(_,exp)) -> search_pos_expr exp ~pos | _ -> ()); (match opt with None -> () | Some exp -> search_pos_expr exp ~pos) | Texp_field (exp, _, _) -> search_pos_expr exp ~pos | Texp_setfield (a, _, _, b) -> @@ -843,6 +844,8 @@ () | Texp_extension_constructor _ -> () + | Texp_letexception (_, exp) -> + search_pos_expr exp ~pos end; add_found_str (`Exp(`Expr, exp.exp_type)) ~env:exp.exp_env ~loc:exp.exp_loc end diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/browser/viewer.ml new/labltk-8.06.3/browser/viewer.ml --- old/labltk-8.06.1/browser/viewer.ml 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/browser/viewer.ml 2017-07-19 05:52:12.000000000 +0200 @@ -609,7 +609,7 @@ let display index = let `Num pos = Listbox.index box ~index in try - let li, k = List.nth l pos in + let li, k = try List.nth l pos with Failure _ -> raise Exit in self#hide_after (n+1); if !current = Some (li,k) then () else let path = @@ -623,7 +623,7 @@ in current := Some (li,k); view_symbol li ~kind:k ~env ?path - with Failure "nth" -> () + with Exit -> () in Jg_box.add_completion box ~double:false ~action:display; bind box ~events:[`KeyRelease] ~fields:[`Char] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/compiler/maincompile.ml new/labltk-8.06.3/compiler/maincompile.ml --- old/labltk-8.06.1/compiler/maincompile.ml 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/compiler/maincompile.ml 2017-07-19 05:52:12.000000000 +0200 @@ -229,8 +229,8 @@ Copyright.write ~w:(output_string oc); Copyright.write ~w:(output_string oc'); begin match wdef.module_type with - Widget -> output_string oc' ("(* The "^wname^" widget *)\n") - | Family -> output_string oc' ("(* The "^wname^" commands *)\n") + Widget -> output_string oc' ("(** The "^wname^" widget *)\n") + | Family -> output_string oc' ("(** The "^wname^" commands *)\n") end; List.iter ~f:(fun s -> output_string oc s; output_string oc' s) begin diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/jpf/fileselect.ml new/labltk-8.06.3/jpf/fileselect.ml --- old/labltk-8.06.1/jpf/fileselect.ml 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/jpf/fileselect.ml 2017-07-19 05:52:12.000000000 +0200 @@ -55,7 +55,7 @@ let subshell cmd = let r,w = pipe () in match fork () with - 0 -> close r; dup2 ~src:w ~dst:stdout; + 0 -> close r; dup2 w stdout; execv ~prog:"/bin/sh" ~args:[| "/bin/sh"; "-c"; cmd |] | id -> close w; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/Makefile.common new/labltk-8.06.3/support/Makefile.common --- old/labltk-8.06.1/support/Makefile.common 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/Makefile.common 2017-07-19 05:52:12.000000000 +0200 @@ -25,7 +25,7 @@ CAMLOPT=$(BINDIR)/ocamlopt$(OPT) CAMLCB=$(BINDIR)/ocamlc CAMLOPTB=$(BINDIR)/ocamlopt -CAMLCOMP=$(CAMLC) -c -warn-error A-3-52 +CAMLCOMP=$(CAMLC) -c -warn-error A-3 CAMLYACC=$(BINDIR)/ocamlyacc -v CAMLLEX=$(BINDIR)/ocamllex CAMLLIBR=$(CAMLC) -a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkCaml.c new/labltk-8.06.3/support/cltkCaml.c --- old/labltk-8.06.1/support/cltkCaml.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkCaml.c 2017-07-19 05:52:12.000000000 +0200 @@ -39,7 +39,7 @@ int id; if (Tcl_GetInt(interp, argv[1], &id) != TCL_OK) return TCL_ERROR; - callback2(*handler_code,Val_int(id), + caml_callback2(*handler_code,Val_int(id), copy_string_list(argc - 2,(char **)&argv[2])); /* Never fails (OCaml would have raised an exception) */ /* but result may have been set by callback */ @@ -62,10 +62,10 @@ return Val_unit; } -/* Note: raise_with_string WILL copy the error message */ +/* Note: caml_raise_with_string WILL copy the error message */ CAMLprim void tk_error(const char *errmsg) { - raise_with_string(*tkerror_exn, errmsg); + caml_raise_with_string(*tkerror_exn, errmsg); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkDMain.c new/labltk-8.06.3/support/cltkDMain.c --- old/labltk-8.06.1/support/cltkDMain.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkDMain.c 2017-07-19 05:52:12.000000000 +0200 @@ -52,11 +52,11 @@ ClientData clientdata; { signal_events = 0; - enter_blocking_section(); /* triggers signal handling */ + caml_enter_blocking_section(); /* triggers signal handling */ /* Rearm timer */ Tk_CreateTimerHandler(SIGNAL_INTERVAL, invoke_pending_caml_signals, NULL); signal_events = 1; - leave_blocking_section(); + caml_leave_blocking_section(); } /* The following is taken from byterun/startup.c */ header_t atom_table[256]; @@ -222,10 +222,10 @@ strcat(f, RCNAME); if (0 == access(f,R_OK)) if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) { - stat_free(f); + caml_stat_free(f); tk_error(Tcl_GetStringResult(cltclinterp)); }; - stat_free(f); + caml_stat_free(f); } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkEval.c new/labltk-8.06.3/support/cltkEval.c --- old/labltk-8.06.1/support/cltkEval.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkEval.c 2017-07-19 05:52:12.000000000 +0200 @@ -45,7 +45,7 @@ for (i = argc-1; i >= 0; i--) { oldres = res; str = tcl_string_to_caml(argv[i]); - res = alloc(2, 0); + res = caml_alloc(2, 0); Field(res, 0) = str; Field(res, 1) = oldres; } @@ -71,7 +71,7 @@ Tcl_ResetResult(cltclinterp); cmd = caml_string_to_tcl(str); code = Tcl_Eval(cltclinterp, cmd); - stat_free(cmd); + caml_stat_free(cmd); switch (code) { case TCL_OK: @@ -128,7 +128,7 @@ switch (Tag_val(v)) { case 0: - argv[where] = caml_string_to_tcl(Field(v,0)); /* must free by stat_free */ + argv[where] = caml_string_to_tcl(Field(v,0)); /* must free by caml_stat_free */ return (where + 1); case 1: for (l=Field(v,0); Is_block(l); l=Field(l,1)) @@ -143,9 +143,9 @@ fill_args(tmpargv,0,Field(v,0)); tmpargv[size] = NULL; merged = Tcl_Merge(size,(const char *const*)tmpargv); - for(i = 0; i<size; i++){ stat_free(tmpargv[i]); } - stat_free((char *)tmpargv); - /* must be freed by stat_free */ + for(i = 0; i<size; i++){ caml_stat_free(tmpargv[i]); } + caml_stat_free((char *)tmpargv); + /* must be freed by caml_stat_free */ argv[where] = (char*)caml_stat_alloc(strlen(merged)+1); strcpy(argv[where], merged); Tcl_Free(merged); @@ -176,7 +176,7 @@ argv = (char **)caml_stat_alloc((size + 2) * sizeof(char *)); allocated = (char **)caml_stat_alloc(size * sizeof(char *)); - /* Copy -- argv[i] must be freed by stat_free */ + /* Copy -- argv[i] must be freed by caml_stat_free */ { int where; for(i=0, where=0; i<Wosize_val(v); i++){ @@ -227,10 +227,10 @@ /* Free the various things we allocated */ for(i=0; i< size; i ++){ - stat_free((char *) allocated[i]); + caml_stat_free((char *) allocated[i]); } - stat_free((char *)argv); - stat_free((char *)allocated); + caml_stat_free((char *)argv); + caml_stat_free((char *)allocated); switch (result) { case TCL_OK: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkEvent.c new/labltk-8.06.3/support/cltkEvent.c --- old/labltk-8.06.1/support/cltkEvent.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkEvent.c 2017-07-19 05:52:12.000000000 +0200 @@ -49,6 +49,6 @@ CheckInit(); - ret = Tk_DoOneEvent(convert_flag_list(flags, event_flag_table)); + ret = Tk_DoOneEvent(caml_convert_flag_list(flags, event_flag_table)); return Val_int(ret); } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkFile.c new/labltk-8.06.3/support/cltkFile.c --- old/labltk-8.06.1/support/cltkFile.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkFile.c 2017-07-19 05:52:12.000000000 +0200 @@ -33,7 +33,7 @@ void FileProc(ClientData clientdata, int mask) { - callback2(*handler_code,Val_int(clientdata),Val_int(0)); + caml_callback2(*handler_code,Val_int(clientdata),Val_int(0)); } /* Map Unix.file_descr values to Tcl file handles */ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkImg.c new/labltk-8.06.3/support/cltkImg.c --- old/labltk-8.06.1/support/cltkImg.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkImg.c 2017-07-19 05:52:12.000000000 +0200 @@ -46,8 +46,9 @@ #endif code = Tk_PhotoGetImage(ph,&pib); /* never fails ? */ + (void) code; size = pib.width * pib.height * pib.pixelSize; - res = alloc_string(size); + res = caml_alloc_string(size); /* no holes, default format ? */ if ((pib.pixelSize == 3) && diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkMain.c new/labltk-8.06.3/support/cltkMain.c --- old/labltk-8.06.1/support/cltkMain.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkMain.c 2017-07-19 05:52:12.000000000 +0200 @@ -51,11 +51,11 @@ void invoke_pending_caml_signals (ClientData clientdata) { signal_events = 0; - enter_blocking_section(); /* triggers signal handling */ + caml_enter_blocking_section(); /* triggers signal handling */ /* Rearm timer */ Tk_CreateTimerHandler(SIGNAL_INTERVAL, invoke_pending_caml_signals, NULL); signal_events = 1; - leave_blocking_section(); + caml_leave_blocking_section(); } /* Now the real Tk stuff */ @@ -77,7 +77,7 @@ tmp = Val_unit; if ( argv == Val_int(0) ){ - failwith("camltk_opentk: argv is empty"); + caml_failwith("camltk_opentk: argv is empty"); } argv0 = String_val( Field( argv, 0 ) ); @@ -91,7 +91,7 @@ /* Register cltclinterp for use in other related extensions */ value *interp = caml_named_value("cltclinterp"); if (interp != NULL) - Store_field(*interp,0,copy_nativeint((intnat)cltclinterp)); + Store_field(*interp,0,caml_copy_nativeint((intnat)cltclinterp)); } if (Tcl_Init(cltclinterp) != TCL_OK) @@ -128,7 +128,7 @@ args = Tcl_Merge(argc, (const char *const*)tkargv); /* args must be freed by Tcl_Free */ Tcl_SetVar(cltclinterp, "argv", args, TCL_GLOBAL_ONLY); Tcl_Free(args); - stat_free( tkargv ); + caml_stat_free( tkargv ); } } if (Tk_Init(cltclinterp) != TCL_OK) @@ -164,10 +164,10 @@ strcat(f, RCNAME); if (0 == access(f,R_OK)) if (TCL_OK != Tcl_EvalFile(cltclinterp,f)) { - stat_free(f); + caml_stat_free(f); tk_error(Tcl_GetStringResult(cltclinterp)); }; - stat_free(f); + caml_stat_free(f); } } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkMisc.c new/labltk-8.06.3/support/cltkMisc.c --- old/labltk-8.06.1/support/cltkMisc.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkMisc.c 2017-07-19 05:52:12.000000000 +0200 @@ -41,20 +41,20 @@ { value res = copy_string_list(argc,argv); Tcl_Free((char *)argv); /* only one large block was allocated */ /* argv points into utf: utf must be freed after argv are freed */ - stat_free( utf ); + caml_stat_free( utf ); return res; } case TCL_ERROR: default: - stat_free( utf ); + caml_stat_free( utf ); tk_error(Tcl_GetStringResult(cltclinterp)); } } -/* Copy an OCaml string to the C heap. Should deallocate with stat_free */ +/* Copy an OCaml string to the C heap. Should deallocate with caml_stat_free */ char *string_to_c(value s) { - int l = string_length(s); + int l = caml_string_length(s); char *res = caml_stat_alloc(l + 1); memmove (res, String_val (s), l); res[l] = '\0'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkTimer.c new/labltk-8.06.3/support/cltkTimer.c --- old/labltk-8.06.1/support/cltkTimer.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkTimer.c 2017-07-19 05:52:12.000000000 +0200 @@ -26,7 +26,7 @@ /* Basically the same thing as FileProc */ void TimerProc (ClientData clientdata) { - callback2(*handler_code,Val_long(clientdata),Val_int(0)); + caml_callback2(*handler_code,Val_long(clientdata),Val_int(0)); } CAMLprim value camltk_add_timer(value milli, value cbid) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkUtf.c new/labltk-8.06.3/support/cltkUtf.c --- old/labltk-8.06.1/support/cltkUtf.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkUtf.c 2017-07-19 05:52:12.000000000 +0200 @@ -36,7 +36,7 @@ #ifdef UTFCONVERSION -char *external_to_utf( char *str ){ +char *external_to_utf( const char *str ){ char *res; Tcl_DString dstr; int length; @@ -76,14 +76,14 @@ char *str; str = utf_to_external( s ); - res = copy_string(str); - stat_free(str); + res = caml_copy_string(str); + caml_stat_free(str); CAMLreturn(res); } #else char *caml_string_to_tcl(value s){ return string_to_c(s); } -value tcl_string_to_caml(char *s){ return copy_string(s); } +value tcl_string_to_caml(char *s){ return caml_copy_string(s); } #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkVar.c new/labltk-8.06.3/support/cltkVar.c --- old/labltk-8.06.1/support/cltkVar.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkVar.c 2017-07-19 05:52:12.000000000 +0200 @@ -35,7 +35,7 @@ stable_var = string_to_c(var); s = (char *)Tcl_GetVar(cltclinterp,stable_var, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); - stat_free(stable_var); + caml_stat_free(stable_var); if (s == NULL) tk_error(Tcl_GetStringResult(cltclinterp)); @@ -57,11 +57,11 @@ utf_contents = caml_string_to_tcl(contents); s = (char *)Tcl_SetVar(cltclinterp,stable_var, utf_contents, TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); - stat_free(stable_var); + caml_stat_free(stable_var); if( s == utf_contents ){ tk_error("camltk_setvar: Tcl_SetVar returned strange result. Call the author of mlTk!"); } - stat_free(utf_contents); + caml_stat_free(utf_contents); if (s == NULL) tk_error(Tcl_GetStringResult(cltclinterp)); @@ -84,7 +84,7 @@ Tcl_UntraceVar2(interp, name1, name2, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, tracevar, clientdata); - callback2(*handler_code,Val_int(clientdata),Val_unit); + caml_callback2(*handler_code,Val_int(clientdata),Val_unit); return (char *)NULL; } @@ -103,10 +103,10 @@ tracevar, (ClientData) (Long_val(cbid))) != TCL_OK) { - stat_free(cvar); + caml_stat_free(cvar); tk_error(Tcl_GetStringResult(cltclinterp)); }; - stat_free(cvar); + caml_stat_free(cvar); return Val_unit; } @@ -123,6 +123,6 @@ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, tracevar, (ClientData) (Long_val(cbid))); - stat_free(cvar); + caml_stat_free(cvar); return Val_unit; } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/cltkWait.c new/labltk-8.06.3/support/cltkWait.c --- old/labltk-8.06.1/support/cltkWait.c 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/cltkWait.c 2017-07-19 05:52:12.000000000 +0200 @@ -54,8 +54,8 @@ Tk_DeleteEventHandler(vis->win, VisibilityChangeMask, WaitVisibilityProc, clientData); - stat_free((char *)vis); - callback2(*handler_code,cbid,Val_int(0)); + caml_stat_free((char *)vis); + caml_callback2(*handler_code,cbid,Val_int(0)); } /* Sets up a callback upon Visibility of a window */ @@ -65,7 +65,7 @@ (struct WinCBData *)caml_stat_alloc(sizeof(struct WinCBData)); vis->win = Tk_NameToWindow(cltclinterp, String_val(win), cltk_mainWindow); if (vis -> win == NULL) { - stat_free((char *)vis); + caml_stat_free((char *)vis); tk_error(Tcl_GetStringResult(cltclinterp)); }; vis->cbid = Int_val(cbid); @@ -79,9 +79,9 @@ if (eventPtr->type == DestroyNotify) { struct WinCBData *vis = clientData; value cbid = Val_int(vis->cbid); - stat_free((char *)clientData); + caml_stat_free((char *)clientData); /* The handler is destroyed by Tk itself */ - callback2(*handler_code,cbid,Val_int(0)); + caml_callback2(*handler_code,cbid,Val_int(0)); } } @@ -92,7 +92,7 @@ (struct WinCBData *)caml_stat_alloc(sizeof(struct WinCBData)); vis->win = Tk_NameToWindow(cltclinterp, String_val(win), cltk_mainWindow); if (vis -> win == NULL) { - stat_free((char *)vis); + caml_stat_free((char *)vis); tk_error(Tcl_GetStringResult(cltclinterp)); }; vis->cbid = Int_val(cbid); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/labltk-8.06.1/support/tkthread.mli new/labltk-8.06.3/support/tkthread.mli --- old/labltk-8.06.1/support/tkthread.mli 2016-04-27 05:35:24.000000000 +0200 +++ new/labltk-8.06.3/support/tkthread.mli 2017-07-19 05:52:12.000000000 +0200 @@ -14,17 +14,19 @@ (* $Id$ *) -(* Helper functions for using LablTk with threads. +(** Helper functions for using LablTk with threads. To use, add tkthread.cmo or tkthread.cmx to your command line *) (** Start the main loop in a new GUI thread. Do not use recursively. *) val start : unit -> Thread.t + (** The actual function executed in the GUI thread *) val thread_main : unit -> unit + (** The toplevel widget (an alias of [Widget.default_toplevel]) *) val top : Widget.toplevel Widget.widget -(* Jobs are needed for Windows, as you cannot do GUI work from +(** Jobs are needed for Windows, as you cannot do GUI work from another thread. This is apparently true on OSX/Aqua too. And even using X11 some calls need to come from the main thread. The basic idea is to either use async (if you don't need a result) @@ -35,12 +37,15 @@ (** Add an asynchronous job (to do in the GUI thread) *) val async : ('a -> unit) -> 'a -> unit + (** Add a synchronous job (to do in the GUI thread). Raise [Failure "Tkthread.sync"] if there is no such thread. *) val sync : ('a -> 'b) -> 'a -> 'b + (** Whether the current thread is the GUI thread. Note that when using X11 it is generally safe to call most Tk functions from other threads too. *) val gui_safe : unit -> bool + (** Whether a GUI thread is running *) val running : unit -> bool
