[Server] Implement proposed API for get/set/exec files.

src/plugins/server/kernel_ast.ml

@@ -164,3 +164,38 @@ let () = Request.register ~page
     (fun kf -> Jbuffer.to_json PP.pp_global (Kernel_function.get_global kf))
 
 (* -------------------------------------------------------------------------- *)
+(* --- Files                                                              --- *)
+(* -------------------------------------------------------------------------- *)
+
+let () =
+  Request.register
+    ~page
+    ~descr:(Md.plain "Get the currently analyzed source file names")
+    ~kind:`GET
+    ~name:"kernel.ast.getFiles"
+    ~input:(module Junit) ~output:(module Jstring.Jlist)
+    Kernel.Files.get
+
+let () =
+  Request.register
+    ~page
+    ~descr:(Md.plain "Set the source file names to analyze.")
+    ~kind:`SET
+    ~name:"kernel.ast.setFiles"
+    ~input:(module Jstring.Jlist)
+    ~output:(module Junit)
+    Kernel.Files.set
+
+let () =
+  Request.register
+    ~page
+    ~descr:(Md.plain "Compute the AST of the currently set source file names.")
+    ~kind:`EXEC
+    ~name:"kernel.ast.execCompute"
+    ~input:(module Junit)
+    ~output:(module Junit)
+    (fun () ->
+       if not (Ast.is_computed ())
+       then File.init_from_cmdline ())
+
+(* -------------------------------------------------------------------------- *)

src/plugins/server/kernel_project.ml

@@ -126,13 +126,12 @@ let () = Request.register ~page
 
 let () =
   Request.register
-    ~kind:`GET
-    ~page ~name:"kernel.project.getSourceFileNames"
-    ~descr:(Md.plain "Get the source file names of the current project")
-    ~input:(module Junit) ~output:(module Jstring.Jlist)
-    (fun () ->
-       List.map
-         (fun fname -> (Filepath.Normalized.of_string fname :> string))
-         (Kernel.Files.get ()))
+    ~page
+    ~descr:(Md.plain "Create a new project")
+    ~kind:`SET
+    ~name:"kernel.project.setCreate"
+    ~input:(module Jstring)
+    ~output:(module ProjectInfo)
+    Project.create
 
 (* -------------------------------------------------------------------------- *)

src/plugins/server/main.ml

@@ -147,10 +147,33 @@ let execute exec : _ response =
       exec.request (Cmdline.protect exn) ;
     `Error(exec.id,Printexc.to_string exn)
 
+let acceptable_between_yield = 0.25 (* seconds *)
+
 let execute_with_yield yield exec =
   let db = !Db.progress in
-  Db.progress := if exec.yield then yield else no_yield ;
-  Extlib.try_finally ~finally:(fun () -> Db.progress := db) execute exec
+  let yield, check =
+    if Senv.debug_atleast 1 then
+      let time = ref (Unix.gettimeofday ()) in
+      let check () =
+        let time' = Unix.gettimeofday () in
+        let diff = time' -. !time in
+        if diff > acceptable_between_yield
+        then
+          Senv.debug
+            "Db.progress missing during %s request (spent %fs between calls)"
+            exec.request
+            diff
+      in
+      (fun () ->
+         check ();
+         yield ();
+         time := Unix.gettimeofday ()),
+      check
+    else
+      yield, ignore
+  in
+  Db.progress := if exec.yield then yield else no_yield;
+  Extlib.try_finally ~finally:(fun () -> Db.progress := db; check ()) execute exec
 
 let execute_debug pp yield exec =
   if Senv.debug_atleast 1 then