Bug fixing + cosmetic changes

[helm.git] / matitaB / matita / matitadaemon.ml

diff --git a/matitaB/matita/matitadaemon.ml b/matitaB/matita/matitadaemon.ml
index 261811815d3c1705d41de529c789ac19cb9ad4a9..eba76597e9e896805d30cd92f511ee9b9d67bbd7 100644 (file)
--- a/matitaB/matita/matitadaemon.ml
+++ b/matitaB/matita/matitadaemon.ml
@@ -41,7 +41,7 @@ let add_user_for_commit uid =
   Mutex.unlock mutex;
 ;;
 
-let do_global_commit () =
+let do_global_commit (* () *) uid =
   prerr_endline ("to be committed: " ^ String.concat " " !to_be_committed);
   List.fold_left
     (fun out u ->
@@ -146,7 +146,11 @@ let do_global_commit () =
   (* XXX: at the moment, we don't keep track of the order in which users have 
      scheduled their commits, but we should, otherwise we will get a 
      "first come, random served" policy *)
-  "" (* (List.rev !to_be_committed) *) (MatitaAuthentication.get_users ())
+  "" (* (List.rev !to_be_committed) *) 
+  (* replace [uid] to commit all users:
+    (MatitaAuthentication.get_users ())
+   *)
+  [uid]
 ;;
 
 (*** from matitaScript.ml ***)
@@ -228,8 +232,8 @@ let eval_statement include_paths (* (buffer : GText.buffer) *) status (* script
           let pre = Netconversion.ustring_sub `Enc_utf8  0 x !outstr in
           let post = Netconversion.ustring_sub `Enc_utf8 x
            (Netconversion.ustring_length `Enc_utf8 !outstr - x) !outstr in
-          outstr := Printf.sprintf 
-            "%s\005input type=\"radio\" class=\"anchor\" id=\"%s\" /\006%s" pre objname post;
+          outstr := Printf.sprintf
+            "%s\005img class=\"anchor\" src=\"icons/tick.png\" id=\"%s\" /\006%s" pre objname post;
           prerr_endline ("baseuri after advance = " ^ status#baseuri);
           (* prerr_endline ("parser output: " ^ !outstr); *)
           (status,!outstr, unparsed_txt'),parsed_text_len
@@ -735,6 +739,10 @@ let save  (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
     cgi#out_channel#output_string "<response>ok</response>"
   with
   | File_already_exists ->
+      cgi # set_header 
+        ~cache:`No_cache 
+        ~content_type:"text/xml; charset=\"utf-8\""
+        ();
       cgi#out_channel#output_string "<response>cancelled</response>"
   | Sys_error _ -> 
     cgi # set_header
@@ -743,6 +751,10 @@ let save  (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
       ~content_type:"text/xml; charset=\"utf-8\""
       ()
   | e ->
+      cgi # set_header 
+        ~cache:`No_cache 
+        ~content_type:"text/xml; charset=\"utf-8\""
+        ();
       let estr = Printexc.to_string e in
       cgi#out_channel#output_string ("<response>" ^ estr ^ "</response>"));
   cgi#out_channel#commit_work()
@@ -755,7 +767,8 @@ let initiate_commit (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
     let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
     let sid = HExtlib.unopt sid in
     MatitaAuthentication.probe_commit_priv sid;
-    let out = do_global_commit () in
+    let uid = MatitaAuthentication.user_of_session sid in
+    let out = do_global_commit (* () *) uid in
     cgi # set_header 
       ~cache:`No_cache 
       ~content_type:"text/xml; charset=\"utf-8\""
@@ -765,6 +778,13 @@ let initiate_commit (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
     cgi#out_channel#output_string ("<details>" ^ out ^ "</details>");
     cgi#out_channel#output_string "</commit>"
   with
+  | Failure _ -> 
+      cgi # set_header 
+        ~cache:`No_cache 
+        ~content_type:"text/xml; charset=\"utf-8\""
+        ();
+      cgi#out_channel#output_string 
+        "<commit><error>no commit privileges</error></commit>"
   | Not_found _ -> 
     cgi # set_header
       ~status:`Internal_server_error
@@ -808,6 +828,13 @@ let svn_update  (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
     cgi#out_channel#output_string ("<details>" ^ details ^ "</details>");
     cgi#out_channel#output_string "</update>";
   with
+  | Failure _ -> 
+      cgi # set_header 
+        ~cache:`No_cache 
+        ~content_type:"text/xml; charset=\"utf-8\""
+        ();
+      cgi#out_channel#output_string 
+        "<commit><error>no commit privileges</error></commit>"
   | Not_found _ -> 
     cgi # set_header
       ~status:`Internal_server_error
@@ -863,6 +890,13 @@ let advance (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
       ~content_type:"text/xml; charset=\"utf-8\""
       ();
     cgi#out_channel#output_string body
+  | End_of_file _ -> 
+    let body = "<response><parsed length=\"0\"></parsed></response>" in
+    cgi # set_header 
+      ~cache:`No_cache 
+      ~content_type:"text/xml; charset=\"utf-8\""
+      ();
+    cgi#out_channel#output_string body
   | Not_found _ -> 
     cgi # set_header
       ~status:`Internal_server_error