path: root/community/mldonkey/fix_compile_error.patch

commit 64cf1e7eabf3087c111b54d7df490c5763d0546b
Author: ygrek <ygrek@autistici.org>
Date:   Tue Mar 11 16:15:09 2014 +0800

    Revert "gettext: reduce complexity, drop unused code"
    
    This reverts commit 6a094b4381dacdc9043c8348002179eb87846e16.
    "Unused" code is actually used in gui
    
    Conflicts:
    	src/utils/lib/gettext.ml4

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