Commits

Stephen Weeks committed 72ec368

fixed bug in Get_project_env, which wasn't sending anything to emacs

  • Participants
  • Parent commits 3a72f6d

Comments (0)

Files changed (1)

File omake_server.ml

   val wait_for_log : unit -> unit deferred
   val log_exn : ?msg:string -> exn -> unit
 end = struct
-  let log_writer = lazy (Writer.open_file File.server_log)
+  let log_writer = lazy (Writer.open_file ~append:true File.server_log)
   let wait_for_log () = Lazy.force log_writer >>| fun _ -> ()
   let logf fmt =
     match Deferred.peek (Lazy.force log_writer) with
   (* The pid of the emacs that started the server *)
   let (pid, set_pid) = get_set "pid"
 
+  (* CR sweeks: [send_str] should not return a deferred. *)
   let send_str writer msg =
     let esc_msg = String.escaped msg in
     let header = sprintf "(Omake.Server.logf \"Server  : %s\")" esc_msg in
   let send_async fmt = ksprintf send_str_async fmt
 
   let load_file id = send_async "(load \"%s\" t t t)" (File.elisp id)
-  let message writer fmt = ksprintf (fun s ->
-    send_str writer (sprintf "(message \"omake-server: %s\")" s)) fmt
+
+  let message writer fmt =
+    ksprintf (fun s -> send_str writer (sprintf "(message \"%s\")" s)) fmt
+  ;;
 end
 
 (* -------------------------------------------------------------------------- *)
 (*  Env                                                                       *)
 (* -------------------------------------------------------------------------- *)
 
+(* CR sweeks: Actually, LIMIT_SUBDIRS_FOR_SPEED defaults to false. *)
 (* The important environment variables for omake are
 
    VERSION_UTIL_SUPPORT
  *)
 module Env : sig
   type var =
-    X_LIBRARY_INLINING
+  | X_LIBRARY_INLINING
   | LINK_EXECUTABLES
   | VERSION_UTIL_SUPPORT
   | LIMIT_SUBDIRS_FOR_SPEED with sexp
   val setenv_all : Id.t -> unit deferred
 end = struct
   type var =
-    X_LIBRARY_INLINING
+  | X_LIBRARY_INLINING
   | LINK_EXECUTABLES
   | VERSION_UTIL_SUPPORT
   | LIMIT_SUBDIRS_FOR_SPEED with sexp
         | Ok t -> return t
         | Error error ->
           Server.logf
-            "Can't read env file for %s (%s). Writing new file from bash env."
+            "Can't read env file for %s (%s).  Writing new file from bash env."
             (Id.to_string id)
             (* (exn_to_string error); *)
             (Error.to_string_hum error);
   let no_model id =
     Server.logf "There is no model for %s" (Id.to_string id)
   in
+
   try
     match Query.t_of_sexp s with
     | Q.List ->
       begin
         Env.setenv_all id >>= fun () ->
         Models.create create >>| function
-      | Ok () -> Server.logf "Model created: %s" ids
-      | Error `Already_exists -> model_exists id
+        | Ok () -> Server.logf "Model created: %s" ids
+        | Error `Already_exists -> model_exists id
       end
     | Q.Kill id ->
       let ids = Id.to_string id in
       end
     | Q.Get_project_env (id, x) ->
       begin
-        Env.get id x >>| fun b ->
-        Server.logf "Server: (%s = %b)" (Env.var_to_string x) b
-      end
+        Env.get id x
+        >>= fun b ->
+        To_emacs.message writer "%s = %b" (Env.var_to_string x) b;
+      end;
     | Q.Set_project_env (id, x, b) ->
       Env.set id x b >>| fun () ->
       Server.logf "Server: %s set to %b" (Env.var_to_string x) b
   Clock.every' span die_if_emacs_dies
 
 let serve () =
-  rm File.socket >>= fun () ->
+  rm File.socket
+  >>= fun () ->
   (* Wait for the log to open *)
-  Server.wait_for_log () >>= fun () ->
+  Server.wait_for_log ()
+  >>= fun () ->
   Server.logf "starting server on %s" File.socket;
   watch_for_dead_emacs ();
   Tcp.serve_unix ~file:File.socket ~on_handler_error:`Raise (fun _ reader writer ->
     | Error exn ->
       Server.log_exn (Monitor.extract_exn exn);
       Deferred.unit)
+;;
 
 let connect msg =
   (* Make sure the message ends with a space so the sexp parser knows
     Tcp.connect_unix ~file () >>= fun (reader, writer) ->
     Writer.write writer msg;
     Pipe.iter (Reader.pipe reader) ~f:(fun s ->
-      printf "%s\n" s;
+      eprintf "%s\n" s;
       Deferred.unit)
 
 (* -------------------------------------------------------------------------- *)