From 134e8d956e98bcae3add0628cd7ae7a074c93f8c Mon Sep 17 00:00:00 2001 From: spiralvoice Date: Sun, 23 Feb 2014 18:14:52 +0000 Subject: [PATCH] patch #8328 --- distrib/ChangeLog | 1 + src/daemon/common/commonMessages.ml | 6 +- src/daemon/driver/driverCommands.ml | 2 +- src/daemon/driver/driverControlers.ml | 2 +- src/utils/lib/gettext.ml4 | 102 +++------------------------------- src/utils/lib/gettext.mli | 45 --------------- 6 files changed, 14 insertions(+), 144 deletions(-) diff --git a/distrib/ChangeLog b/distrib/ChangeLog index c8aa986f..85d4d644 100644 --- a/distrib/ChangeLog +++ b/distrib/ChangeLog @@ -15,6 +15,7 @@ ChangeLog ========= 2014/02/23: +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) 8325: do not reset option pause_new_downloads at startup (ygrek) diff --git a/src/daemon/common/commonMessages.ml b/src/daemon/common/commonMessages.ml index 0cffed23..ebae333f 100644 --- a/src/daemon/common/commonMessages.ml +++ b/src/daemon/common/commonMessages.ml @@ -1399,11 +1399,9 @@ let bad_login = _s "Bad login/password" let full_access = _s "Full access enabled" -let download_started = message "download_started" - (T.boption (T.int T.bformat)) "Download of file %d started
" +let download_started n = _s (Printf.sprintf "Download of file %d started
" n) -let no_such_command = message "no_such_command" - (T.boption (T.string T.bformat)) "No such command %s\n" +let no_such_command s = _s (Printf.sprintf "No such command %s\n" s) 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 6b003b04..c84fb27d 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 [] -> - Gettext.buftext buf no_such_command cmd + Buffer.add_string 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 69a1751d..e07ba77e 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 - Gettext.buftext buf M.download_started num + Buffer.add_string buf (M.download_started num) with e -> Printf.bprintf buf "Error %s with %s
" (Printexc2.to_string e) value; diff --git a/src/utils/lib/gettext.ml4 b/src/utils/lib/gettext.ml4 index b0e935f9..60cf3102 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,81 +135,6 @@ 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; @@ -283,14 +208,6 @@ 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 @@ -305,8 +222,8 @@ let verify index translated = false end -let ss_ modname (x : string) = register modname x -let _ss m = +let ss_ : string -> string -> string _string = register +let _ss : string _string -> string = fun m -> let index = m.index in !requests.(index) <- !requests.(index) + 1; let translation = !translation.(index) in @@ -319,9 +236,9 @@ let _ss m = let _s modname (x : string) = _ss (ss_ modname x) -let bb_ x = Obj.magic (ss_ x) -let _bb m = - let index = m.index in +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 index = m.index in !requests.(index) <- !requests.(index) + 1; let translation = !translation.(index) in let s= if translation == no_translation then @@ -334,8 +251,7 @@ let _bb 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 92fb73e2..f642b232 100644 --- a/src/utils/lib/gettext.mli +++ b/src/utils/lib/gettext.mli @@ -17,52 +17,7 @@ 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) format -> ('a, 'b, 'c) format 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 -- 2.11.4.GIT