[Pkg-ocaml-maint-commits] [mldonkey] 03/07: Imported Upstream version 3.1.5
Mehdi Dogguy
mehdi at moszumanska.debian.org
Wed Mar 26 23:26:59 UTC 2014
This is an automated email from the git hooks/post-receive script.
mehdi pushed a commit to branch master
in repository mldonkey.
commit 741bb84bad9c6c4e48c3dd5e6aa66a7177a7843f
Author: Mehdi Dogguy <mehdi at debian.org>
Date: Thu Mar 27 00:14:29 2014 +0100
Imported Upstream version 3.1.5
---
config/configure | 2 +-
config/configure.in | 2 +-
distrib/ChangeLog | 3 ++
src/daemon/common/commonMessages.ml | 6 ++-
src/daemon/driver/driverCommands.ml | 2 +-
src/daemon/driver/driverControlers.ml | 2 +-
src/utils/lib/gettext.ml4 | 96 ++++++++++++++++++++++++++++++++---
src/utils/lib/gettext.mli | 45 ++++++++++++++++
8 files changed, 146 insertions(+), 12 deletions(-)
diff --git a/config/configure b/config/configure
index ff292f4..3135c7f 100755
--- a/config/configure
+++ b/config/configure
@@ -2379,7 +2379,7 @@ cd config
MAJOR_VERSION=3
MINOR_VERSION=1
-SUB_VERSION=4 # range 0-7 due to eMule limitations
+SUB_VERSION=5 # range 0-7 due to eMule limitations
# ********** **********
# ********** check for C compiler **********
diff --git a/config/configure.in b/config/configure.in
index 585568c..ea5318e 100644
--- a/config/configure.in
+++ b/config/configure.in
@@ -22,7 +22,7 @@ cd config
MAJOR_VERSION=3
MINOR_VERSION=1
-SUB_VERSION=4 # range 0-7 due to eMule limitations
+SUB_VERSION=5 # range 0-7 due to eMule limitations
# ********** **********
# ********** check for C compiler **********
diff --git a/distrib/ChangeLog b/distrib/ChangeLog
index 15823f1..c1622bf 100644
--- a/distrib/ChangeLog
+++ b/distrib/ChangeLog
@@ -14,6 +14,9 @@ http://mldonkey.sourceforge.net/Windows#MinGW_Installation
ChangeLog
=========
+2014/03/22: version 3.1.5 = tag release-3-1-5
+8415: Revert patch #8328 to fix GTK2 gui's compilation (ygrek)
+
2014/03/10: version 3.1.4 = tag release-3-1-4
8388: BT: use porttest service from EDK module (ygrek)
8352: CryptoPP: Fix compilation with gcc-4.7 (Jaakko Perttilä)
diff --git a/src/daemon/common/commonMessages.ml b/src/daemon/common/commonMessages.ml
index ebae333..0cffed2 100644
--- a/src/daemon/common/commonMessages.ml
+++ b/src/daemon/common/commonMessages.ml
@@ -1399,9 +1399,11 @@ let bad_login = _s "Bad login/password"
let full_access = _s "Full access enabled"
-let download_started n = _s (Printf.sprintf "Download of file %d started<br>" n)
+let download_started = message "download_started"
+ (T.boption (T.int T.bformat)) "Download of file %d started<br>"
-let no_such_command s = _s (Printf.sprintf "No such command %s\n" s)
+let no_such_command = message "no_such_command"
+ (T.boption (T.string T.bformat)) "No such command %s\n"
let bad_number_of_args cmd help = _s (Printf.sprintf "Bad number of arguments, see help for correct use:\n%s %s" cmd help)
diff --git a/src/daemon/driver/driverCommands.ml b/src/daemon/driver/driverCommands.ml
index 6085073..c24be04 100644
--- a/src/daemon/driver/driverCommands.ml
+++ b/src/daemon/driver/driverCommands.ml
@@ -87,7 +87,7 @@ let execute_command arg_list output cmd args =
let rec iter list =
match list with
[] ->
- Buffer.add_string buf (no_such_command cmd)
+ Gettext.buftext buf no_such_command cmd
| (command, _, arg_kind, help) :: tail ->
if command = cmd then begin
if !verbose_user_commands && not (user2_is_admin output.conn_user.ui_user) then
diff --git a/src/daemon/driver/driverControlers.ml b/src/daemon/driver/driverControlers.ml
index e07ba77..69a1751 100644
--- a/src/daemon/driver/driverControlers.ml
+++ b/src/daemon/driver/driverControlers.ml
@@ -1296,7 +1296,7 @@ let http_handler o t r =
List.iter CommonInteractive.start_download files;
let module M = CommonMessages in
- Buffer.add_string buf (M.download_started num)
+ Gettext.buftext buf M.download_started num
with e ->
Printf.bprintf buf "Error %s with %s<br>"
(Printexc2.to_string e) value;
diff --git a/src/utils/lib/gettext.ml4 b/src/utils/lib/gettext.ml4
index 91a9fbb..fcfe50d 100644
--- a/src/utils/lib/gettext.ml4
+++ b/src/utils/lib/gettext.ml4
@@ -29,15 +29,15 @@ let lprintf_n fmt =
lprintf2 log_prefix fmt
type expected_types =
-| Type_int
+ Type_int
| Type_char
| Type_string
-| Type_float
+| Type_float
| Type_bool
| Type_int32
| Type_int64
| Type_nativeint
-
+
let ty_arrow x y = x :: y
(* Taken from ocaml-3.04, typing/typecore.ml *)
@@ -135,6 +135,81 @@ let type_format fmt =
bad_format i j
in
scan_format 0
+
+type 'a variable
+type 'a arrow
+
+
+let arrow_add_variable
+ (x : 'a variable)
+ (y : 'b arrow) =
+ let x = Obj.magic x in
+ let y = Obj.magic y in
+ (Obj.magic (x :: y) : ('a -> 'b) arrow)
+
+
+
+open Options
+
+let value_to_text (expected_type : 'a arrow) v =
+ let s = value_to_string v in
+ let expected_type = Obj.magic expected_type in
+ let format_type = type_format s in
+ if format_type = expected_type then
+ (Obj.magic s : ('a, unit, string) format) else
+ failwith "Bad format"
+
+let text_to_value v =
+ let v = Obj.magic v in
+ string_to_value v
+
+let text_option (expected_type : 'a arrow)
+ =
+ define_option_class "Text"
+ (value_to_text expected_type)
+ text_to_value
+
+let gettext v = Printf.sprintf !!v
+
+let buftext buf (v : ('a, Buffer.t, unit) format Options.option_record) =
+ Printf.bprintf buf !!v
+
+module T = struct
+ let int x = arrow_add_variable (Obj.magic Type_int : int variable) x
+ let char x = arrow_add_variable (Obj.magic Type_char : char variable) x
+ let string x = arrow_add_variable (Obj.magic Type_string : string variable) x
+ let float x = arrow_add_variable (Obj.magic Type_float : float variable) x
+ let bool x = arrow_add_variable (Obj.magic Type_bool : bool variable) x
+ let int32 x = arrow_add_variable (Obj.magic Type_int32 : int32 variable) x
+ let int64 x = arrow_add_variable (Obj.magic Type_int64 : int64 variable) x
+ let nativeint x = arrow_add_variable (Obj.magic Type_nativeint : nativeint variable) x
+ let format = (Obj.magic [] : string arrow)
+ let bformat = (Obj.magic [] : unit arrow)
+ let option = text_option
+ let boption x = (Obj.magic text_option) x
+ end
+
+
+(********* Some tests ************)
+
+(*
+let option_file = create_options_file "test.ini"
+
+let nshared = define_option option_file
+ ["nshared"] "Text for Nshared option"
+ (text_option
+ (T.int (T.int32 T.format)))
+ "Shared: %d/%ld"
+
+let _ =
+ try
+ load option_file
+ with Sys_error _ ->
+ save_with_help option_file
+
+let _ =
+ lprint_string (Printf.sprintf !! nshared 23 (Int32.one));
+ *)
type 'a _string = {
name : string;
@@ -208,6 +283,14 @@ let translate modname s t =
save_strings_file := true;
!translation.(m.index) <- t
end
+(*
+ let x =
+ let y = (Obj.magic x : string) in
+ Obj.magic (register y : string message)
+
+ let s_ x = register x
+*)
+
let verify index translated =
let index_type = type_format !default.(index) in
@@ -222,8 +305,8 @@ let verify index translated =
false
end
-let ss_ : string -> string -> string _string = register
-let _ss : string _string -> string = fun m ->
+let ss_ modname (x : string) = register modname x
+let _ss m =
let index = m.index in
!requests.(index) <- !requests.(index) + 1;
let translation = !translation.(index) in
@@ -251,7 +334,8 @@ let _bb : ('a, 'b, 'c, 'd) format4 _string -> ('a, 'b, 'c, 'd) format4 = fun m -
Obj.magic s
let _b modname x = _bb (bb_ modname x)
-
+
+
let save_strings () =
match !strings_file with
None -> ()
diff --git a/src/utils/lib/gettext.mli b/src/utils/lib/gettext.mli
index 6ac31be..2370881 100644
--- a/src/utils/lib/gettext.mli
+++ b/src/utils/lib/gettext.mli
@@ -17,7 +17,52 @@
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
+open Autoconf
+
+type 'a variable
+type 'a arrow
+
+val text_option : 'a arrow ->
+ ('a, unit, string) format Options.option_class
+
+(*
+let nshared =
+ (arrow_variable int_variable int32_variable)
+ "Shared: %d/%ld"
+ *)
+
+val save_strings : unit -> unit
val set_strings_file : string -> unit
val _b : string -> ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4
val _s : string -> string -> string
+
+type 'a _string
+
+val bb_ : string -> ('a, 'b, 'c) format -> ('a, 'b, 'c) format _string
+val _bb : ('a, 'b, 'c) format _string -> ('a, 'b, 'c) format
+
+val ss_ : string -> string -> string _string
+val _ss : string _string -> string
+
+
+module T :
+ sig
+ val int : 'b arrow -> (int -> 'b) arrow
+ val char : 'b arrow -> (char -> 'b) arrow
+ val string : 'b arrow -> (string -> 'b) arrow
+ val float : 'b arrow -> (float -> 'b) arrow
+ val bool : 'b arrow -> (bool -> 'b) arrow
+ val int32 : 'b arrow -> (int32 -> 'b) arrow
+ val int64 : 'b arrow -> (int64 -> 'b) arrow
+ val nativeint : 'b arrow -> (nativeint -> 'b) arrow
+ val format : string arrow
+ val bformat : unit arrow
+ val option : 'a arrow ->
+ ('a, unit, string) format Options.option_class
+ val boption : 'a arrow ->
+ ('a, Buffer.t, unit) format Options.option_class
+ end
+
+val gettext : ('a, unit, string) format Options.option_record -> 'a
+val buftext : Buffer.t -> ('a, Buffer.t, unit) format Options.option_record -> 'a
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/mldonkey.git
More information about the Pkg-ocaml-maint-commits
mailing list