[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...
|
From: |
mldonkey-commits |
|
Subject: |
[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co... |
|
Date: |
Sun, 23 Feb 2014 18:16:11 +0000 |
CVSROOT: /sources/mldonkey
Module name: mldonkey
Changes by: spiralvoice <spiralvoice> 14/02/23 18:16:11
Modified files:
distrib : ChangeLog
src/daemon/common: commonFile.mli
src/utils/cdk : printf2.ml printf2.mli
src/utils/lib : gettext.ml4 gettext.mli
Log message:
patch #8329
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1588&r2=1.1589
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonFile.mli?cvsroot=mldonkey&r1=1.35&r2=1.36
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/printf2.ml?cvsroot=mldonkey&r1=1.23&r2=1.24
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/cdk/printf2.mli?cvsroot=mldonkey&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/gettext.ml4?cvsroot=mldonkey&r1=1.12&r2=1.13
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/gettext.mli?cvsroot=mldonkey&r1=1.4&r2=1.5
Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1588
retrieving revision 1.1589
diff -u -b -r1.1588 -r1.1589
--- distrib/ChangeLog 23 Feb 2014 18:14:52 -0000 1.1588
+++ distrib/ChangeLog 23 Feb 2014 18:16:11 -0000 1.1589
@@ -15,6 +15,7 @@
=========
2014/02/23:
+8329: printf2: reduce complexity, use Printf.ksprintf (ygrek)
8328: gettext: reduce complexity, drop unused code (ygrek)
8327: GTK2 GUI: fix wrong url on splash screen (ygrek)
8326: BT: disable announcing to 127.0.0.1 (ygrek)
Index: src/daemon/common/commonFile.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonFile.mli,v
retrieving revision 1.35
retrieving revision 1.36
diff -u -b -r1.35 -r1.36
--- src/daemon/common/commonFile.mli 25 Oct 2011 17:33:21 -0000 1.35
+++ src/daemon/common/commonFile.mli 23 Feb 2014 18:16:11 -0000 1.36
@@ -155,7 +155,7 @@
val file_owner : CommonTypes.file -> CommonTypes.userdb
val set_file_group : CommonTypes.file -> CommonTypes.groupdb option -> unit
val file_group : CommonTypes.file -> CommonTypes.groupdb option
-val lprintf_file_nl : CommonTypes.file -> ('a, unit, unit) Pervasives.format
-> 'a
+val lprintf_file_nl : CommonTypes.file -> ('a, unit, string, unit)
Pervasives.format4 -> 'a
(** [concat_file dir filename] sanitizes [filename] and appends it to [dir] *)
val concat_file : string -> string -> string
Index: src/utils/cdk/printf2.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/printf2.ml,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -b -r1.23 -r1.24
--- src/utils/cdk/printf2.ml 1 Nov 2010 17:09:29 -0000 1.23
+++ src/utils/cdk/printf2.ml 23 Feb 2014 18:16:11 -0000 1.24
@@ -23,195 +23,21 @@
let syslog_oc = ref None
-external format_int: string -> int -> string = "caml_format_int"
-external format_int32: string -> int32 -> string = "caml_int32_format"
-external format_nativeint: string -> nativeint -> string =
"caml_nativeint_format"
-external format_int64: string -> int64 -> string = "caml_int64_format"
-external format_float: string -> float -> string = "caml_format_float"
-
let log_time () =
-let t = Unix.localtime (Unix.time ()) in
+ let t = Unix.localtime (Unix.time ()) in
let { Unix.tm_year = tm_year; Unix.tm_mon = tm_mon; Unix.tm_mday = tm_mday;
- Unix.tm_hour = tm_hour; Unix.tm_min = tm_min; Unix.tm_sec = tm_sec } =
t in
+ Unix.tm_hour = tm_hour; Unix.tm_min = tm_min; Unix.tm_sec = tm_sec } =
t
+ in
Printf.sprintf "%4d/%02d/%02d %02d:%02d:%02d " (tm_year+1900) (tm_mon+1)
tm_mday tm_hour tm_min tm_sec
-let bad_format fmt pos =
- invalid_arg
- ("printf: bad format " ^ String.sub fmt pos (String.length fmt - pos))
-
-(* Format a string given a %s format, e.g. %40s or %-20s.
- To do: ignore other flags (#, +, etc)? *)
-
-let format_string format s =
- let rec parse_format neg i =
- if i >= String.length format then (0, neg) else
- match String.unsafe_get format i with
- | '1'..'9' ->
- (int_of_string (String.sub format i (String.length format - i - 1)),
- neg)
- | '-' ->
- parse_format true (succ i)
- | _ ->
- parse_format neg (succ i) in
- let (p, neg) =
- try parse_format false 1 with Failure _ -> bad_format format 0 in
- if String.length s < p then begin
- let res = String.make p ' ' in
- if neg
- then String.blit s 0 res 0 (String.length s)
- else String.blit s 0 res (p - String.length s) (String.length s);
- res
- end else
- s
-
-(* Extract a %format from [fmt] between [start] and [stop] inclusive.
- '*' in the format are replaced by integers taken from the [widths] list.
- The function is somewhat optimized for the "no *" case. *)
-
-let extract_format fmt start stop widths =
- match widths with
- | [] -> String.sub fmt start (stop - start + 1)
- | _ ->
- let b = Buffer.create (stop - start + 10) in
- let rec fill_format i w =
- if i > stop then Buffer.contents b else
- match (String.unsafe_get fmt i, w) with
- ('*', h::t) ->
- Buffer.add_string b (string_of_int h); fill_format (succ i) t
- | ('*', []) ->
- bad_format fmt start (* should not happen *)
- | (c, _) ->
- Buffer.add_char b c; fill_format (succ i) w
- in fill_format start (List.rev widths)
-
-(* Decode a %format and act on it.
- [fmt] is the printf format style, and [pos] points to a [%] character.
- After consuming the appropriate number of arguments and formatting
- them, one of the three continuations is called:
- [cont_s] for outputting a string (args: string, next pos)
- [cont_a] for performing a %a action (args: fn, arg, next pos)
- [cont_t] for performing a %t action (args: fn, next pos)
- "next pos" is the position in [fmt] of the first character following
- the %format in [fmt]. *)
-
-(* Note: here, rather than test explicitly against [String.length fmt]
- to detect the end of the format, we use [String.unsafe_get] and
- rely on the fact that we'll get a "nul" character if we access
- one past the end of the string. These "nul" characters are then
- caught by the [_ -> bad_format] clauses below.
- Don't do this at home, kids. *)
-
-let scan_format fmt pos cont_s cont_a cont_t =
- let rec scan_flags widths i =
- match String.unsafe_get fmt i with
- | '*' ->
- Obj.magic(fun w -> scan_flags (w :: widths) (succ i))
- | '0'..'9' | '.' | '#' | '-' | ' ' | '+' -> scan_flags widths (succ i)
- | _ -> scan_conv widths i
- and scan_conv widths i =
- match String.unsafe_get fmt i with
- | '%' ->
- cont_s "%" (succ i)
- | 's' | 'S' as conv ->
- Obj.magic (fun (s: string) ->
- let s = if conv = 's' then s else "\"" ^ String.escaped s ^ "\"" in
- if i = succ pos (* optimize for common case %s *)
- then cont_s s (succ i)
- else cont_s (format_string (extract_format fmt pos i widths) s)
- (succ i))
- | 'c' | 'C' as conv ->
- Obj.magic (fun (c: char) ->
- if conv = 'c'
- then cont_s (String.make 1 c) (succ i)
- else cont_s ("'" ^ Char.escaped c ^ "'") (succ i))
- | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
- Obj.magic(fun (n: int) ->
- cont_s (format_int (extract_format fmt pos i widths) n) (succ i))
- | 'f' | 'e' | 'E' | 'g' | 'G' ->
- Obj.magic(fun (f: float) ->
- cont_s (format_float (extract_format fmt pos i widths) f) (succ i))
- | 'b' | 'B' ->
- Obj.magic(fun (b: bool) ->
- cont_s (string_of_bool b) (succ i))
- | 'a' ->
- Obj.magic (fun printer arg ->
- cont_a printer arg (succ i))
- | 't' ->
- Obj.magic (fun printer ->
- cont_t printer (succ i))
- | 'l' ->
- begin match String.unsafe_get fmt (succ i) with
- | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
- Obj.magic(fun (n: int32) ->
- cont_s (format_int32 (extract_format fmt pos (succ i) widths) n)
- (i + 2))
- | _ ->
- bad_format fmt pos
- end
- | 'n' ->
- begin match String.unsafe_get fmt (succ i) with
- | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
- Obj.magic(fun (n: nativeint) ->
- cont_s (format_nativeint
- (extract_format fmt pos (succ i) widths)
- n)
- (i + 2))
- | _ ->
- bad_format fmt pos
- end
- | 'L' ->
- begin match String.unsafe_get fmt (succ i) with
- | 'd' | 'i' | 'o' | 'x' | 'X' | 'u' ->
- Obj.magic(fun (n: int64) ->
- cont_s (format_int64 (extract_format fmt pos (succ i) widths) n)
- (i + 2))
- | _ ->
- bad_format fmt pos
- end
- | _ ->
- bad_format fmt pos
- in scan_flags [] (pos + 1)
-
-let cprintf kont fmt =
- let fmt = (Obj.magic fmt : string) in
- let len = String.length fmt in
- let dest = Buffer.create (len + 16) in
- let rec doprn i =
- if i >= len then begin
- let res = Buffer.contents dest in
- Buffer.reset dest; (* just in case kprintf is partially applied *)
- Obj.magic (kont res)
- end else
- match String.unsafe_get fmt i with
- | '%' -> scan_format fmt i cont_s cont_a cont_t
- | c -> Buffer.add_char dest c; doprn (succ i)
- and cont_s s i =
- Buffer.add_string dest s; doprn i
- and cont_a printer arg i =
- Buffer.add_string dest (printer () arg); doprn i
- and cont_t printer i =
- Buffer.add_string dest (printer ()); doprn i
- in doprn 0
-
let lprintf_handler = ref (fun s time ->
Printf.printf "%sMessage [%s] discarded\n" time s;
)
-let lprintf fmt =
- cprintf (fun s -> try !lprintf_handler "" s with _ -> ())
- (fmt : ('a,unit, unit) format )
-
-let lprintf2 m fmt =
- cprintf (fun s -> try !lprintf_handler (log_time ()) (m^" "^s) with _ -> ())
- (fmt : ('a,unit, unit) format )
-
-let lprintf_nl fmt =
- cprintf (fun s -> try !lprintf_handler (log_time ()) (s^"\n") with _ -> ())
- (fmt : ('a,unit, unit) format )
-
-let lprintf_nl2 m fmt =
- cprintf (fun s -> try !lprintf_handler (log_time ()) (m^" "^s^"\n") with _
-> ())
- (fmt : ('a,unit, unit) format )
+let lprintf fmt = Printf.ksprintf (fun s -> try !lprintf_handler "" s with _
-> ()) fmt
+let lprintf2 m fmt = Printf.ksprintf (fun s -> try !lprintf_handler (log_time
()) (m^" "^s) with _ -> ()) fmt
+let lprintf_nl fmt = Printf.ksprintf (fun s -> try !lprintf_handler (log_time
()) (s^"\n") with _ -> ()) fmt
+let lprintf_nl2 m fmt = Printf.ksprintf (fun s -> try !lprintf_handler
(log_time ()) (m^" "^s^"\n") with _ -> ()) fmt
let lprint_newline () = lprintf "\n"
let lprint_char = lprintf "%c"
@@ -234,13 +60,13 @@
Some c when c = stderr || c = stdout -> true
| _ -> false
-let _ =
+let () =
set_lprintf_handler (fun time s ->
(match !syslog_oc with
- None -> ()
+ | None -> ()
| Some oc -> Syslog.syslog oc `LOG_INFO s);
match !lprintf_output with
- Some out when !lprintf_to_channel ->
+ | Some out when !lprintf_to_channel ->
Printf.fprintf out "%s" (time ^ s); flush out
| _ ->
if !lprintf_size >= !lprintf_max_size then
Index: src/utils/cdk/printf2.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/cdk/printf2.mli,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- src/utils/cdk/printf2.mli 1 Nov 2010 17:09:29 -0000 1.11
+++ src/utils/cdk/printf2.mli 23 Feb 2014 18:16:11 -0000 1.12
@@ -25,15 +25,11 @@
val keep_console_output : unit -> bool
val log_time : unit -> string
-val cprintf : (string -> unit) -> ('a, unit, unit) format -> 'a
-(** [cprintf k format arguments] is the same as [printf format arguments],
- except that the resulting string is passed as argument to [k]; the
- result of [k] is then returned as the result of [cprintf]. *)
-val lprintf : ('a, unit, unit) format -> 'a
-val lprintf2 : string -> ('a, unit, unit) format -> 'a
-val lprintf_nl : ('a, unit, unit) format -> 'a
-val lprintf_nl2 : string -> ('a, unit, unit) format -> 'a
+val lprintf : ('a, unit, string, unit) format4 -> 'a
+val lprintf2 : string -> ('a, unit, string, unit) format4 -> 'a
+val lprintf_nl : ('a, unit, string, unit) format4 -> 'a
+val lprintf_nl2 : string -> ('a, unit, string, unit) format4 -> 'a
val lprint_newline : unit -> unit
val lprint_char : char -> unit
val lprint_string : string -> unit
Index: src/utils/lib/gettext.ml4
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/gettext.ml4,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- src/utils/lib/gettext.ml4 23 Feb 2014 18:14:52 -0000 1.12
+++ src/utils/lib/gettext.ml4 23 Feb 2014 18:16:11 -0000 1.13
@@ -236,8 +236,8 @@
let _s modname (x : string) = _ss (ss_ modname x)
-let bb_ : string -> ('a, 'b, 'c) format -> ('a, 'b, 'c) format _string = fun
modname -> Obj.magic (ss_ modname)
-let _bb : ('a, 'b, 'c) format _string -> ('a, 'b, 'c) format = fun m ->
+let bb_ : string -> ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4
_string = fun modname -> Obj.magic (ss_ modname)
+let _bb : ('a, 'b, 'c, 'd) format4 _string -> ('a, 'b, 'c, 'd) format4 = fun m
->
let index = m.index in
!requests.(index) <- !requests.(index) + 1;
let translation = !translation.(index) in
Index: src/utils/lib/gettext.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/gettext.mli,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- src/utils/lib/gettext.mli 23 Feb 2014 18:14:52 -0000 1.4
+++ src/utils/lib/gettext.mli 23 Feb 2014 18:16:11 -0000 1.5
@@ -19,5 +19,5 @@
val set_strings_file : string -> unit
-val _b : string -> ('a, 'b, 'c) format -> ('a, 'b, 'c) format
+val _b : string -> ('a, 'b, 'c, 'd) format4 -> ('a, 'b, 'c, 'd) format4
val _s : string -> string -> string