Matitaweb: Some bugfixes concerning file flags.

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

diff --git a/matitaB/matita/matitaFilesystem.ml b/matitaB/matita/matitaFilesystem.ml
index b846c153ca5274a7892c3c24ecfe4da231f10f64..77e65822163657ffc7af9fce3bb662999f41148e 100644 (file)
--- a/matitaB/matita/matitaFilesystem.ml
+++ b/matitaB/matita/matitaFilesystem.ml
@@ -154,45 +154,65 @@ let checkout user =
   if errno = 0 then List.map (fun (f,_) -> f,MSynchronized) files 
   else raise (SvnError (string_of_output outlines errlines))
 
+(* normalize qualified file name *)
+let normalize_qfn p = 
+  (* trim leading "./" *)
+  let p = 
+    try
+      if String.sub p 0 2 <> "./" then p
+      else String.sub p 2 (String.length p - 2)
+    with
+    | Invalid_argument _ -> p
+  in
+  (* trim trailing "/" *)
+  try
+    if String.sub p (String.length p - 1) 1 <> "/" then p
+    else String.sub p 0 (String.length p - 1)
+  with
+  | Invalid_argument _ -> p
+    
 let html_of_library uid ft =
   let i = ref 0 in
   let newid () = incr i; ("node" ^ string_of_int !i) in
 
   let basedir = (Helm_registry.get "matita.rt_base_dir") ^ "/users/" ^ uid in
 
+
   let branch lpath children =
     let id = newid () in
     let name = Filename.basename lpath in
     let name = if name <> "." then name else "cic:/matita" in
-    let lpath =
-      try 
-        if String.sub lpath 0 2 <> "./" then lpath 
-        else String.sub lpath 2 (String.length lpath - 2)
-      with Invalid_argument _ -> lpath
-    in
     let flag = 
       try List.assoc lpath ft 
       with Not_found -> MSynchronized in
     let szflag = string_of_matita_flag flag in
-    "<span class=\"trigger\" onClick=\"showBranch('" ^ id ^ "','" ^ lpath ^ "/')\">\n" ^
+    "<span class=\"trigger\" onClick=\"showBranch('" ^ id ^ "','" ^ lpath ^ "')\">\n" ^
     "<img src=\"treeview/closed.gif\" id=\"I" ^ id ^ "\"/>\n" ^
     name ^ " " ^ szflag ^ "<br/></span>\n" ^
     "<span class=\"branch\" id=\"" ^ id ^ "\">\n" ^
     children ^ "\n</span>"
   in
   let leaf lpath =
+    let flag = 
+      try List.assoc lpath ft 
+      with Not_found -> MSynchronized in
+    let szflag = string_of_matita_flag flag in
     "<img src=\"treeview/doc.gif\"/>\n" ^
     "<a href=\"javascript:void(0)\" onClick=\"selectFile('" ^ lpath ^ "')\" onDblClick=\"dialogBox.callback('" ^ lpath ^ "')\">" ^ 
-     (Filename.basename lpath) ^ "</a><br/>"
+     (Filename.basename lpath) ^ " " ^ szflag ^ "</a><br/>"
   in
 
   let rec aux path =
     let lpath filename = path ^ "/" ^ filename in
     let gpath filename = basedir ^ "/" ^ path ^ "/" ^ filename in
+
+    (* hide hidden dirs ... including svn stuff *)
     let dirlist = 
       List.filter (fun x -> String.sub x 0 1 <> ".") 
         (Array.to_list (Sys.readdir (basedir ^ "/" ^ path))) in
     let subdirs = List.filter (fun x -> Sys.is_directory (gpath x)) dirlist in
+
+    (* only .ma scripts, hidden files excluded *)
     let scripts = 
       List.filter (fun x -> 
         try
@@ -202,10 +222,10 @@ let html_of_library uid ft =
           (String.sub x 0 1 <> ".") && (String.sub x i len = ".ma")
         with Not_found | Invalid_argument _ -> false) dirlist in
     let subdirtags = 
-      String.concat "\n" (List.map (fun x -> aux (lpath x)) subdirs) in
+      String.concat "\n" (List.map (fun x -> aux (normalize_qfn (lpath x ^ "/"))) subdirs) in
     let scripttags =
       String.concat "\n" 
-       (List.map (fun x -> leaf (lpath x)) scripts)
+       (List.map (fun x -> leaf (normalize_qfn (lpath x))) scripts)
     in
     branch path (subdirtags ^ "\n" ^ scripttags)
   in