[Mldonkey-commits] mldonkey distrib/ChangeLog src/daemon/common/co...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       14/02/23 18:14:53

Modified files:
        distrib        : ChangeLog 
        src/daemon/common: commonMessages.ml 
        src/daemon/driver: driverCommands.ml driverControlers.ml 
        src/utils/lib  : gettext.ml4 gettext.mli 

Log message:
        patch #8328

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1587&r2=1.1588
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/common/commonMessages.ml?cvsroot=mldonkey&r1=1.78&r2=1.79
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverCommands.ml?cvsroot=mldonkey&r1=1.268&r2=1.269
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/daemon/driver/driverControlers.ml?cvsroot=mldonkey&r1=1.124&r2=1.125
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/gettext.ml4?cvsroot=mldonkey&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/lib/gettext.mli?cvsroot=mldonkey&r1=1.3&r2=1.4

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1587
retrieving revision 1.1588
diff -u -b -r1.1587 -r1.1588
--- distrib/ChangeLog   23 Feb 2014 18:14:05 -0000      1.1587
+++ distrib/ChangeLog   23 Feb 2014 18:14:52 -0000      1.1588
@@ -15,6 +15,7 @@
 =========
 
 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)

Index: src/daemon/common/commonMessages.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/common/commonMessages.ml,v
retrieving revision 1.78
retrieving revision 1.79
diff -u -b -r1.78 -r1.79
--- src/daemon/common/commonMessages.ml 7 Jul 2013 11:03:33 -0000       1.78
+++ src/daemon/common/commonMessages.ml 23 Feb 2014 18:14:52 -0000      1.79
@@ -1399,11 +1399,9 @@
 
 let full_access = _s "Full access enabled"
 
-let download_started = message "download_started"
-    (T.boption (T.int T.bformat)) "Download of file %d started<br>"
+let download_started n = _s (Printf.sprintf "Download of file %d started<br>" 
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)
 

Index: src/daemon/driver/driverCommands.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverCommands.ml,v
retrieving revision 1.268
retrieving revision 1.269
diff -u -b -r1.268 -r1.269
--- src/daemon/driver/driverCommands.ml 7 Jul 2013 11:07:13 -0000       1.268
+++ src/daemon/driver/driverCommands.ml 23 Feb 2014 18:14:52 -0000      1.269
@@ -87,7 +87,7 @@
     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

Index: src/daemon/driver/driverControlers.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/daemon/driver/driverControlers.ml,v
retrieving revision 1.124
retrieving revision 1.125
diff -u -b -r1.124 -r1.125
--- src/daemon/driver/driverControlers.ml       7 Jul 2013 11:49:37 -0000       
1.124
+++ src/daemon/driver/driverControlers.ml       23 Feb 2014 18:14:52 -0000      
1.125
@@ -1296,7 +1296,7 @@
                         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<br>"
                             (Printexc2.to_string e) value;

Index: src/utils/lib/gettext.ml4
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/gettext.ml4,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- src/utils/lib/gettext.ml4   23 May 2010 09:12:15 -0000      1.11
+++ src/utils/lib/gettext.ml4   23 Feb 2014 18:14:52 -0000      1.12
@@ -29,7 +29,7 @@
   lprintf2 log_prefix fmt
 
 type expected_types =
-  Type_int
+| Type_int
 | Type_char
 | Type_string
 | Type_float  
@@ -136,81 +136,6 @@
   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;
     index : int;
@@ -283,14 +208,6 @@
       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 @@
       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,8 +236,8 @@
 
 let _s modname (x : string) = _ss (ss_ modname x)
 
-let bb_ x = Obj.magic (ss_ x)
-let _bb m = 
+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
@@ -335,7 +252,6 @@
 
 let _b modname x = _bb (bb_ modname x)
   
-  
 let save_strings () =
   match !strings_file with 
     None -> ()

Index: src/utils/lib/gettext.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/lib/gettext.mli,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- src/utils/lib/gettext.mli   2 Feb 2004 19:55:20 -0000       1.3
+++ src/utils/lib/gettext.mli   23 Feb 2014 18:14:52 -0000      1.4
@@ -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