Commits

seanmcl committed 1a49481

split ocaml code into lib/bin so we can use ounit

  • Participants
  • Parent commits 5d9f3bb

Comments (0)

Files changed (96)

 \#*\#
 *.pyc
 *__pycache__
+.DS_Store
 
 bins.inferred-1step.deps
 *.build_info.c

File ocaml/omake/OMakefile

-
-OCAML_LIBRARIES[] =
-  async
-  core
-  core_extended
-  pcre
-  ocaml_inotify
-  ounit
-
-EXES[] =
-  omake_server
-
-FILES[] =
-  process
-  omake_inotify
-  std
-  util
-  id
-  files
-  log
-  config
-  server_config
-  elisp
-  regex
-  error
-  omake
-  version
-  emacs
-  env
-  omake_command
-  project
-  projects
-  query
-  server
-  top
-  omake_server
-
-OCamlMakePPDeps($(PA_JANE), $(FILES))
-
-OCamlMakeProjDefaults($(addsuffixes .exe, $(EXES)))
+Subdirs()

File ocaml/omake/config.ml

-open Std
-
-module T = String.Table
-type t = string T.t
-
-let create () = T.create ()
-
-let lookup t ~key ~default =
-  let key = String.lowercase key in
-  let default = String.lowercase default in
-  Hashtbl.find_or_add t key ~default:(fun () -> default)
-
-let read_file file =
-  try
-    let s = Sexp.load_sexp file in
-    let sexp_of_string s = String.lowercase (String.t_of_sexp s) in
-    Ok (T.t_of_sexp sexp_of_string s)
-  with exn -> Error exn
-
-let write_file f t =
-  let s = Sexp.to_string_hum (T.sexp_of_t String.sexp_of_t t) in
-  let header = ";; -*- scheme -*- ;;\n\n" in
-  Out_channel.write_all f ~data:(header ^ s)
-
-let update t ~key ~value =
-  let key = String.lowercase key in
-  let value = String.lowercase value in
-  T.replace t ~key ~data:value
-

File ocaml/omake/config.mli

-
-open Std
-
-type t
-
-val create : unit -> t
-val read_file : string -> t result
-val write_file : string -> t -> unit
-
-val lookup : t -> key:string -> default:string -> string
-val update : t -> key:string -> value:string -> unit

File ocaml/omake/elisp.ml

-
-open Std
-
-type t = string
-let list l ~f = String.concat ~sep:" " ("(list" :: List.map ~f l @ [")"])
-let message s = sprintf "(message \"%s\")" (String.escaped s)
-let error s = message (sprintf "Error: %s" s)
-let load s = sprintf "(load \"%s\" t t t)" s
-let bool = function true -> "t" | false -> "nil"
-let id id = sprintf "(Omake.Id.of-path %s)" (String.quote (Id.to_string id))
-let env_value b = sprintf "'%b" b

File ocaml/omake/elisp.mli

-
-open Std
-
-type t = string
-val list : 'a list -> f:('a -> t) -> t
-val message : string -> t
-val error : string -> t
-val load : string -> t
-val bool : bool -> t
-val id : Id.t -> t
-val env_value : bool -> t

File ocaml/omake/emacs.ml

-
-open Std
-
-module Pid = Emacs_pid
-type pid = Emacs_pid.t
-
-type t = {
-  pid : pid;
-  mutable writer : Writer.t;
-  watching : Id.Hash_set.t;
-}
-
-let table : t Pid.Table.t = Pid.Table.create ()
-
-let registered pid = Hashtbl.mem table pid
-
-let pp () =
-  let pp1 t =
-    sprintf "  %d [%s]" (Pid.to_int t.pid)
-      (String.concat ~sep:"," (List.map ~f:Id.to_string (Hash_set.to_list t.watching)))
-  in
-  String.concat ~sep:"\n" (List.map ~f:pp1 (Hashtbl.data table))
-
-let find pid = Hashtbl.find table pid
-let find_exn pid = Hashtbl.find_exn table pid
-
-let unregister pid =
-  (* Multiple Writer.close calls are ok. *)
-  Writer.close (find_exn pid).writer >>| fun () ->
-  Hashtbl.remove table pid
-
-let list () = Hashtbl.data table
-
-let register pid writer = match Hashtbl.find table pid with
-  (* If the writer closed for some reason, install the new writer*)
-| Some t ->
-  Log.printf "Installing new writer for Emacs pid: %d" (Pid.to_int pid);
-  t.writer <- writer
-| None ->
-  let t = { pid; writer; watching = Id.Hash_set.create () } in
-  Hashtbl.replace table ~key:pid ~data:t
-
-let writer t = t.writer
-let watch t pid = Hash_set.add t.watching pid
-let unwatch t pid = Hash_set.remove t.watching pid
-let watching t = Hash_set.to_list t.watching
-
-let with_t pid f = f (find_exn pid)
-
-(* There is a race condition in that an Emacs may be killed while
-   the server is trying to send a message (e.g. due to a change in
-   a watched raw buffer) on the writer.  *)
-let send_str writer msg =
-  let esc_msg = String.escaped msg in
-  let header = sprintf "(Omake.Server.logf \"Server  : %s\")" esc_msg in
-  let msg = sprintf "(progn %s %s)" header msg in
-  Log.printf "Writing: %s" msg;
-  (* newline is important here.  It designates an end of input. *)
-  if Writer.is_open writer then
-    Writer.writef writer "%s\n" msg
-  else
-    Log.printf "Warning: writing to a closed Emacs writer.  This is probably OK. (%s)" msg
-
-module Sync = struct
-  let send writer fmt = ksprintf (send_str writer) fmt
-  let message writer fmt =
-    ksprintf (fun s -> send_str writer (Elisp.message s)) fmt
-end
-
-module Async = struct
-  let send_gen ?pid ?id fmt =
-    ksprintf (fun msg ->
-      Hashtbl.iter table ~f:(fun ~key:_ ~data:t ->
-        let msg = String.map msg ~f:(function '\n' -> ' ' | s -> s) in
-        let send () = send_str t.writer msg in
-        match pid, id with
-        | None, None -> send ()
-        | Some pid, None -> if Pid.equal pid t.pid then send ()
-        | None, Some id -> if Hash_set.mem t.watching id then send ()
-        | Some pid, Some id ->
-          if Pid.equal pid t.pid && Hash_set.mem t.watching id then
-            send ())) fmt
-
-  let send pid fmt = send_gen ~pid fmt
-  let send_all fmt = send_gen fmt
-  let send_all_watching id fmt = send_gen ~id fmt
-  let message id fmt =
-    ksprintf (fun s -> send_gen ~id "%s" (Elisp.message s)) fmt
-  let load_elisp_file id = send_gen ~id "%s" (Elisp.load (Files.elisp id))
-  let load_server_state_file () = send_all "%s" (Elisp.load Files.server_state)
-end
-
-let kill_model id =
-  (* Async.send_all_watching id *)
-  (*   "(Omake.Model.kill (Omake.Id.of-path \"%s\"))" (Id.to_string id); *)
-  Hashtbl.iter table ~f:(fun ~key:_ ~data:t -> Hash_set.remove t.watching id)

File ocaml/omake/emacs.mli

-
-open Std
-
-type t
-type pid = Emacs_pid.t
-
-(* Register a pid and writer.  The writer is used to send
-   asyncronous messages to the emacs with the corresponding pid. *)
-val register : pid -> Writer.t -> unit
-
-(* Unregister the pid.  This does not close the associated writer. *)
-val unregister : pid -> unit deferred
-val registered : pid -> bool
-val find : pid -> t option
-val find_exn : pid -> t
-val with_t : pid -> (t -> 'a) -> 'a
-val writer : t -> Writer.t
-val watch : t -> Id.t -> unit
-val unwatch : t -> Id.t -> unit
-val watching : t -> Id.t list
-
-val pp : unit -> string
-val list : unit -> t list
-
-(* Send a syncronous message to a given writer *)
-module Sync : sig
-  val send : Writer.t -> ('a, unit, string, unit) format4 -> 'a
-  val message : Writer.t -> ('a, unit, string, unit) format4 -> 'a
-end
-
-(* Send asyncronous messages to Emacs instances.  These functions strip newlines, since
-   the Emacs filter-function is line-based. *)
-module Async : sig
-  val send : pid -> ('a, unit, string, unit) format4 -> 'a
-  val send_all : ('a, unit, string, unit) format4 -> 'a
-  val send_all_watching : Id.t -> ('a, unit, string, unit) format4 -> 'a
-  val message : Id.t -> ('a, unit, string, unit) format4 -> 'a
-
-  (* Tell all watching Emacsen to reload the elisp output file. *)
-  val load_elisp_file : Id.t -> unit
-
-  (* Tell all Emacsen to reload the server state. *)
-  val load_server_state_file : unit -> unit
-end
-
-(* Remove the model from ocaml and send messages to all Emacsen watching
-   the project *)
-val kill_model : Id.t -> unit

File ocaml/omake/env.ml

-
-open Std
-
-type var =
-| FOUR_POINT_ZERO
-| LIMIT_SUBDIRS_FOR_SPEED
-| LINK_EXECUTABLES
-| VERSION_UTIL_SUPPORT
-| X_LIBRARY_INLINING
-with sexp
-
-let var_to_string x = Sexp.to_string (sexp_of_var x)
-let var_of_string x = var_of_sexp (Sexp.of_string x)
-
-type t = Config.t
-
-(* These defaults should match the variables in OMakeroot.  We
-   thought about parsing OMakeroot to get the defaults, but decided
-   it was too much trouble.  They shouldn't ever change. *)
-let default = function
-| FOUR_POINT_ZERO         -> false
-| LIMIT_SUBDIRS_FOR_SPEED -> false
-| LINK_EXECUTABLES        -> true
-| VERSION_UTIL_SUPPORT    -> true
-| X_LIBRARY_INLINING      -> true
-
-let all_vars =
-  [ FOUR_POINT_ZERO
-  ; LIMIT_SUBDIRS_FOR_SPEED
-  ; LINK_EXECUTABLES
-  ; VERSION_UTIL_SUPPORT
-  ; X_LIBRARY_INLINING ]
-
-let value t v =
-  let key = var_to_string v in
-  let default = Bool.to_string (default v) in
-  Bool.of_string (Config.lookup t ~key ~default)
-
-let to_elisp t = sprintf "
-      (Omake.Env.create
-        :four-point-zero %s
-        :limit-subdirs-for-speed %s
-        :link-executables %s
-        :version-util-support %s
-        :x-library-inlining %s)"
-  (Elisp.env_value (value t FOUR_POINT_ZERO))
-  (Elisp.env_value (value t LIMIT_SUBDIRS_FOR_SPEED))
-  (Elisp.env_value (value t LINK_EXECUTABLES))
-  (Elisp.env_value (value t VERSION_UTIL_SUPPORT))
-  (Elisp.env_value (value t X_LIBRARY_INLINING))
-
-(* Make sure all the env variables are set. *)
-let () =
-  let assure_set key =
-    let default = Bool.to_string (default key) in
-    let key = var_to_string key in
-    match Sys.getenv key with
-    | None -> Unix.putenv ~key ~data:default
-    | Some _ -> ()
-  in
-  List.iter ~f:assure_set all_vars
-
-(* Save the variables in a file in ~/.omake-server/PROJ/env.sexp *)
-
-let get_exn key = match Sys.getenv key with
-| None -> failwithf "No env: %s" key ()
-| Some data -> data
-
-let home = get_exn "HOME"
-
-let env_dir id = sprintf "%s/.omake-server/%s" home id
-
-let env_file id = sprintf "%s/%s" (env_dir id) "env.sexp"
-
-let save id t =
-  let ids = Id.to_string id in
-  Shell.mkdir ~p:() (env_dir ids);
-  Config.write_file (env_file ids) t
-
-let ensure_set t var =
-  let env key = get_exn (var_to_string key) |! Bool.of_string in
-  let key = var_to_string var in
-  let default = Bool.to_string (env var) in
-  ignore (Config.lookup t ~key ~default)
-
-(* Read the initial state of the variables out of the process environment
-   if there is no file.  We do this instead of using the defaults because
-   the user may set the variable in their .bashrc *)
-let create_default id =
-  let t = Config.create () in
-  List.iter ~f:(ensure_set t) all_vars;
-  save id t;
-  t
-
-let get id =
-  let file = env_file (Id.to_string id) in
-  if Sys.file_exists_exn file then
-    begin
-      match Config.read_file file with
-      | Ok t ->
-        List.iter ~f:(ensure_set t) all_vars;
-        save id t;
-        t
-      | Error exn ->
-        Log.printf
-          "Can't read env file for %s (%s).  Writing new file from bash env."
-          (Id.to_string id)
-          (Exn.to_string exn);
-        create_default id
-    end
-  else
-    create_default id
-
-(* Set the variable of a project. *)
-let set id x b =
-  let t = get id in
-  Config.update t ~key:(var_to_string x) ~value:(Bool.to_string b);
-  save id t
-
-(* Set the variables before starting the process. *)
-let set_env t =
-  let put k =
-    let key = var_to_string k in
-    let default = Bool.to_string (default k) in
-    let data = Config.lookup t ~key ~default in
-    Unix.putenv ~key ~data
-  in
-  List.iter ~f:put all_vars

File ocaml/omake/env.mli

-
-open Std
-
-type var =
-| FOUR_POINT_ZERO
-| LIMIT_SUBDIRS_FOR_SPEED
-| LINK_EXECUTABLES
-| VERSION_UTIL_SUPPORT
-| X_LIBRARY_INLINING
-with sexp
-
-val var_to_string : var -> string
-val var_of_string : string -> var
-
-type t
-
-val value : t -> var -> bool
-
-val to_elisp : t -> Elisp.t
-val get : Id.t -> t
-val set : Id.t -> var -> bool -> unit
-val set_env : t -> unit

File ocaml/omake/error.ml

-
-open Std
-
-module Make = struct
-  type t = {
-    relpath : path;
-    file : path;
-    line : int;
-    char_beg : int;
-    char_end : int;
-    text : string;
-    full_text : string option;
-  }
-end
-
-type t = {
-  hash : int;
-  relpath : path;
-  file : path;
-  line : int;
-  char_beg : int;
-  char_end : int;
-  text : string;
-  full_text : string option;
-} with sexp, fields
-
-(* Emacs compiled on a 32 bit machine can only handle 2^28 hash.  Not sure why. *)
-let hash m = Hashtbl.hash m mod 268435456
-
-let make m =
-  let hash = hash m in
-  { hash
-  ; relpath = m.Make.relpath
-  ; file = m.Make.file
-  ; line = m.Make.line
-  ; char_beg = m.Make.char_beg
-  ; char_end = m.Make.char_end
-  ; text = m.Make.text
-  ; full_text = m.Make.full_text }
-
-let to_string = Sexp.to_string_hum ** sexp_of_t
-
-let rootpath e = e.relpath ^/ e.file
-
-let compare e1 e2 =
-  match String.compare (rootpath e1) (rootpath e2) with
-  | 0 -> Int.compare e1.line e2.line
-  | n -> n
-
-let equal x y = x.hash = y.hash
-  (* String.equal x.file y.file && *)
-  (*   Int.equal x.line y.line && *)
-  (*   Int.equal x.char_beg x.char_beg && *)
-  (*   Int.equal x.char_end y.char_end *)
-
-(* n^2 dedup.  Errors must maintain their relative order in the raw buffer.
-   Of the equal errors, keep the last. *)
-let rec dedup l = match l with
-| [] -> l
-| x :: xs ->
-  let xs = dedup xs in
-  if List.exists ~f:(equal x) xs then xs else x :: xs
-
-(* truncate long lines that may wrap to the next line *)
-let shorten_lines s =
-  let lines = String.split ~on:'\n' s in
-  let lines = List.map lines ~f:truncate in
-  String.concat lines ~sep:"\n"
-
-let abbreviate s =
-  let lines = String.split ~on:'\n' s in
-  let n = List.length lines in
-  if n < 10 then None
-  else
-    List.take lines 3 @ "       ..." :: List.drop lines (n - 3)
-    |! String.concat ~sep:"\n"
-    |! some
-
-(* Some errors have bad indentation in the raw output, e.g.
-   File "util/check_inotify_max_user_watches.ml", line 9, characters 14-15:
-                                 Parse error: [module_longident]
-*)
-let cleanup_indentation s =
-  Regex.rewrite (Regex.of_string "[ \t]+(Parse error:.*)") ~template:"$1" s
-
-(* to_elisp corresponds to the elisp constructor *)
-let to_elisp ~id t =
-  let text = String.escaped (cleanup_indentation t.text) in
-  let full_text = match t.full_text with
-  | None -> text
-  | Some ftext -> String.escaped ftext
-  in
-  sprintf "
-      (Omake.Error :hash %d
-                   :id \"%s\"
-                   :relpath \"%s\"
-                   :file \"%s\"
-                   :line %d
-                   :char-beg %d
-                   :char-end %d
-                   :text \"%s\"
-                   :full-text \"%s\")"
-    t.hash id t.relpath t.file t.line t.char_beg t.char_end
-    text full_text

File ocaml/omake/error.mli

-
-open Std
-
-type t with sexp
-
-module Make : sig
-  type t = {
-    relpath : path;
-    file : path;
-    line : int;
-    char_beg : int;
-    char_end : int;
-    text : string;
-    full_text : string option;
-  }
-end
-
-val make : Make.t -> t
-
-val relpath : t -> path
-val text : t -> string
-val full_text : t -> string option
-val file : t -> path
-
-val to_string : t -> string
-val to_elisp : id:string -> t -> Elisp.t
-  (* path from the omake root *)
-val rootpath : t -> path
-val dedup : t list -> t list
-val shorten_lines : string -> string
-val abbreviate : string -> string option
-val compare : t -> t -> int
-val equal : t -> t -> bool

File ocaml/omake/exe/OMakefile

+
+OCAML_LIBRARIES[] =
+  core
+  omake_lib
+
+EXES[] =
+  omake_server
+
+FILES[] =
+  omake_server
+
+OCamlMakePPDeps($(PA_JANE), $(FILES))
+
+OCamlMakeProjDefaults($(addsuffixes .exe, $(EXES)))

File ocaml/omake/exe/omake_server.ml

+
+open Core
+let _ = Command.run Omake_lib.Top.cmd
+

File ocaml/omake/exe/omake_server.mli

+(* omake_server.exe *)

File ocaml/omake/files.ml

-
-open Std
-
-let check_perms f = match Unix.access f [`Read; `Write] with
-| Ok () -> ()
-| Error _ ->
-  begin
-    printf "I can't read and write %s.  Please fix the permissions and try again.\n" f;
-    exit 1
-  end
-
-let shared_root = "/tmp/omake-server"
-let _ = Shell.mkdir ~p:() ~perm:0o777 shared_root
-let _ = check_perms shared_root
-let root = sprintf "%s/%s" shared_root Util.user
-let _ = Shell.mkdir ~p:() root
-let _ = check_perms root
-
-let project_dir id =
-  let dir = sprintf "%s%s" root (Id.to_string id) in
-  Shell.mkdir ~p:() dir;
-  dir
-
-let project_file name id =
-  sprintf "%s/%s" (project_dir id) name
-
-let server_log_dir = sprintf "%s/log/server" root
-let _ = Shell.mkdir ~p:() server_log_dir
-let controller = sprintf "%s/controller" server_log_dir
-
-let omake = project_file "omake"
-let elisp = project_file "elisp.el"
-let log = project_file "log"
-let env = project_file "env"
-let server_log () =
-  let date = Date.to_string (Date.today ()) in
-  sprintf "%s/%s" server_log_dir date
-
-let socket = sprintf "%s/socket" root
-let server_state = sprintf "%s/server-state.el" root
-
-let rec omakeroot_dir = function
-| "/" | "" -> None
-| p ->
-  match
-    Array.findi (Sys.readdir p)
-      ~f:(fun _ -> function "OMakeroot" -> true | _ -> false)
-  with
-  | Some _ -> Some p
-  | None -> omakeroot_dir (Filename.dirname p)

File ocaml/omake/files.mli

-
-open Std
-
-val omake         : Id.t -> path
-val elisp         : Id.t -> path
-val log           : Id.t -> path
-val env           : Id.t -> path
-val server_state  : path
-val controller    : path
-val server_log    : unit -> path
-val socket        : path
-val omakeroot_dir : path -> path option

File ocaml/omake/id.ml

-
-open Std
-
-include String

File ocaml/omake/id.mli

-
-open Std
-
-type t with sexp
-
-include Hashable.S with type t := t
-include Stringable.S with type t := t
-

File ocaml/omake/lib/OMakefile

+
+OCAML_LIBRARIES[] =
+  async
+  core
+  core_extended
+  pcre
+  ocaml_inotify
+
+LIB_MLNAMES[] =
+  process
+  omake_inotify
+  std
+  util
+  id
+  files
+  log
+  config
+  server_config
+  elisp
+  regex
+  error
+  omake
+  version
+  emacs
+  env
+  omake_command
+  project
+  projects
+  query
+  server
+  top
+
+OCamlMakePPDeps($(PA_JANE), $(LIB_MLNAMES))
+
+OCamlMakeLibPackage(omake_lib)

File ocaml/omake/lib/config.ml

+open Std
+
+module T = String.Table
+type t = string T.t
+
+let create () = T.create ()
+
+let lookup t ~key ~default =
+  let key = String.lowercase key in
+  let default = String.lowercase default in
+  Hashtbl.find_or_add t key ~default:(fun () -> default)
+
+let read_file file =
+  try
+    let s = Sexp.load_sexp file in
+    let sexp_of_string s = String.lowercase (String.t_of_sexp s) in
+    Ok (T.t_of_sexp sexp_of_string s)
+  with exn -> Error exn
+
+let write_file f t =
+  let s = Sexp.to_string_hum (T.sexp_of_t String.sexp_of_t t) in
+  let header = ";; -*- scheme -*- ;;\n\n" in
+  Out_channel.write_all f ~data:(header ^ s)
+
+let update t ~key ~value =
+  let key = String.lowercase key in
+  let value = String.lowercase value in
+  T.replace t ~key ~data:value
+

File ocaml/omake/lib/config.mli

+
+open Std
+
+type t
+
+val create : unit -> t
+val read_file : string -> t result
+val write_file : string -> t -> unit
+
+val lookup : t -> key:string -> default:string -> string
+val update : t -> key:string -> value:string -> unit

File ocaml/omake/lib/elisp.ml

+
+open Std
+
+type t = string
+let list l ~f = String.concat ~sep:" " ("(list" :: List.map ~f l @ [")"])
+let message s = sprintf "(message \"%s\")" (String.escaped s)
+let error s = message (sprintf "Error: %s" s)
+let load s = sprintf "(load \"%s\" t t t)" s
+let bool = function true -> "t" | false -> "nil"
+let id id = sprintf "(Omake.Id.of-path %s)" (String.quote (Id.to_string id))
+let env_value b = sprintf "'%b" b

File ocaml/omake/lib/elisp.mli

+
+open Std
+
+type t = string
+val list : 'a list -> f:('a -> t) -> t
+val message : string -> t
+val error : string -> t
+val load : string -> t
+val bool : bool -> t
+val id : Id.t -> t
+val env_value : bool -> t

File ocaml/omake/lib/emacs.ml

+
+open Std
+
+module Pid = Emacs_pid
+type pid = Emacs_pid.t
+
+type t = {
+  pid : pid;
+  mutable writer : Writer.t;
+  watching : Id.Hash_set.t;
+}
+
+let table : t Pid.Table.t = Pid.Table.create ()
+
+let registered pid = Hashtbl.mem table pid
+
+let pp () =
+  let pp1 t =
+    sprintf "  %d [%s]" (Pid.to_int t.pid)
+      (String.concat ~sep:"," (List.map ~f:Id.to_string (Hash_set.to_list t.watching)))
+  in
+  String.concat ~sep:"\n" (List.map ~f:pp1 (Hashtbl.data table))
+
+let find pid = Hashtbl.find table pid
+let find_exn pid = Hashtbl.find_exn table pid
+
+let unregister pid =
+  (* Multiple Writer.close calls are ok. *)
+  Writer.close (find_exn pid).writer >>| fun () ->
+  Hashtbl.remove table pid
+
+let list () = Hashtbl.data table
+
+let register pid writer = match Hashtbl.find table pid with
+  (* If the writer closed for some reason, install the new writer*)
+| Some t ->
+  Log.printf "Installing new writer for Emacs pid: %d" (Pid.to_int pid);
+  t.writer <- writer
+| None ->
+  let t = { pid; writer; watching = Id.Hash_set.create () } in
+  Hashtbl.replace table ~key:pid ~data:t
+
+let writer t = t.writer
+let watch t pid = Hash_set.add t.watching pid
+let unwatch t pid = Hash_set.remove t.watching pid
+let watching t = Hash_set.to_list t.watching
+
+let with_t pid f = f (find_exn pid)
+
+(* There is a race condition in that an Emacs may be killed while
+   the server is trying to send a message (e.g. due to a change in
+   a watched raw buffer) on the writer.  *)
+let send_str writer msg =
+  let esc_msg = String.escaped msg in
+  let header = sprintf "(Omake.Server.logf \"Server  : %s\")" esc_msg in
+  let msg = sprintf "(progn %s %s)" header msg in
+  Log.printf "Writing: %s" msg;
+  (* newline is important here.  It designates an end of input. *)
+  if Writer.is_open writer then
+    Writer.writef writer "%s\n" msg
+  else
+    Log.printf "Warning: writing to a closed Emacs writer.  This is probably OK. (%s)" msg
+
+module Sync = struct
+  let send writer fmt = ksprintf (send_str writer) fmt
+  let message writer fmt =
+    ksprintf (fun s -> send_str writer (Elisp.message s)) fmt
+end
+
+module Async = struct
+  let send_gen ?pid ?id fmt =
+    ksprintf (fun msg ->
+      Hashtbl.iter table ~f:(fun ~key:_ ~data:t ->
+        let msg = String.map msg ~f:(function '\n' -> ' ' | s -> s) in
+        let send () = send_str t.writer msg in
+        match pid, id with
+        | None, None -> send ()
+        | Some pid, None -> if Pid.equal pid t.pid then send ()
+        | None, Some id -> if Hash_set.mem t.watching id then send ()
+        | Some pid, Some id ->
+          if Pid.equal pid t.pid && Hash_set.mem t.watching id then
+            send ())) fmt
+
+  let send pid fmt = send_gen ~pid fmt
+  let send_all fmt = send_gen fmt
+  let send_all_watching id fmt = send_gen ~id fmt
+  let message id fmt =
+    ksprintf (fun s -> send_gen ~id "%s" (Elisp.message s)) fmt
+  let load_elisp_file id = send_gen ~id "%s" (Elisp.load (Files.elisp id))
+  let load_server_state_file () = send_all "%s" (Elisp.load Files.server_state)
+end
+
+let kill_model id =
+  (* Async.send_all_watching id *)
+  (*   "(Omake.Model.kill (Omake.Id.of-path \"%s\"))" (Id.to_string id); *)
+  Hashtbl.iter table ~f:(fun ~key:_ ~data:t -> Hash_set.remove t.watching id)

File ocaml/omake/lib/emacs.mli

+
+open Std
+
+type t
+type pid = Emacs_pid.t
+
+(* Register a pid and writer.  The writer is used to send
+   asyncronous messages to the emacs with the corresponding pid. *)
+val register : pid -> Writer.t -> unit
+
+(* Unregister the pid.  This does not close the associated writer. *)
+val unregister : pid -> unit deferred
+val registered : pid -> bool
+val find : pid -> t option
+val find_exn : pid -> t
+val with_t : pid -> (t -> 'a) -> 'a
+val writer : t -> Writer.t
+val watch : t -> Id.t -> unit
+val unwatch : t -> Id.t -> unit
+val watching : t -> Id.t list
+
+val pp : unit -> string
+val list : unit -> t list
+
+(* Send a syncronous message to a given writer *)
+module Sync : sig
+  val send : Writer.t -> ('a, unit, string, unit) format4 -> 'a
+  val message : Writer.t -> ('a, unit, string, unit) format4 -> 'a
+end
+
+(* Send asyncronous messages to Emacs instances.  These functions strip newlines, since
+   the Emacs filter-function is line-based. *)
+module Async : sig
+  val send : pid -> ('a, unit, string, unit) format4 -> 'a
+  val send_all : ('a, unit, string, unit) format4 -> 'a
+  val send_all_watching : Id.t -> ('a, unit, string, unit) format4 -> 'a
+  val message : Id.t -> ('a, unit, string, unit) format4 -> 'a
+
+  (* Tell all watching Emacsen to reload the elisp output file. *)
+  val load_elisp_file : Id.t -> unit
+
+  (* Tell all Emacsen to reload the server state. *)
+  val load_server_state_file : unit -> unit
+end
+
+(* Remove the model from ocaml and send messages to all Emacsen watching
+   the project *)
+val kill_model : Id.t -> unit

File ocaml/omake/lib/env.ml

+
+open Std
+
+type var =
+| FOUR_POINT_ZERO
+| LIMIT_SUBDIRS_FOR_SPEED
+| LINK_EXECUTABLES
+| VERSION_UTIL_SUPPORT
+| X_LIBRARY_INLINING
+with sexp
+
+let var_to_string x = Sexp.to_string (sexp_of_var x)
+let var_of_string x = var_of_sexp (Sexp.of_string x)
+
+type t = Config.t
+
+(* These defaults should match the variables in OMakeroot.  We
+   thought about parsing OMakeroot to get the defaults, but decided
+   it was too much trouble.  They shouldn't ever change. *)
+let default = function
+| FOUR_POINT_ZERO         -> false
+| LIMIT_SUBDIRS_FOR_SPEED -> false
+| LINK_EXECUTABLES        -> true
+| VERSION_UTIL_SUPPORT    -> true
+| X_LIBRARY_INLINING      -> true
+
+let all_vars =
+  [ FOUR_POINT_ZERO
+  ; LIMIT_SUBDIRS_FOR_SPEED
+  ; LINK_EXECUTABLES
+  ; VERSION_UTIL_SUPPORT
+  ; X_LIBRARY_INLINING ]
+
+let value t v =
+  let key = var_to_string v in
+  let default = Bool.to_string (default v) in
+  Bool.of_string (Config.lookup t ~key ~default)
+
+let to_elisp t = sprintf "
+      (Omake.Env.create
+        :four-point-zero %s
+        :limit-subdirs-for-speed %s
+        :link-executables %s
+        :version-util-support %s
+        :x-library-inlining %s)"
+  (Elisp.env_value (value t FOUR_POINT_ZERO))
+  (Elisp.env_value (value t LIMIT_SUBDIRS_FOR_SPEED))
+  (Elisp.env_value (value t LINK_EXECUTABLES))
+  (Elisp.env_value (value t VERSION_UTIL_SUPPORT))
+  (Elisp.env_value (value t X_LIBRARY_INLINING))
+
+(* Make sure all the env variables are set. *)
+let () =
+  let assure_set key =
+    let default = Bool.to_string (default key) in
+    let key = var_to_string key in
+    match Sys.getenv key with
+    | None -> Unix.putenv ~key ~data:default
+    | Some _ -> ()
+  in
+  List.iter ~f:assure_set all_vars
+
+(* Save the variables in a file in ~/.omake-server/PROJ/env.sexp *)
+
+let get_exn key = match Sys.getenv key with
+| None -> failwithf "No env: %s" key ()
+| Some data -> data
+
+let home = get_exn "HOME"
+
+let env_dir id = sprintf "%s/.omake-server/%s" home id
+
+let env_file id = sprintf "%s/%s" (env_dir id) "env.sexp"
+
+let save id t =
+  let ids = Id.to_string id in
+  Shell.mkdir ~p:() (env_dir ids);
+  Config.write_file (env_file ids) t
+
+let ensure_set t var =
+  let env key = get_exn (var_to_string key) |! Bool.of_string in
+  let key = var_to_string var in
+  let default = Bool.to_string (env var) in
+  ignore (Config.lookup t ~key ~default)
+
+(* Read the initial state of the variables out of the process environment
+   if there is no file.  We do this instead of using the defaults because
+   the user may set the variable in their .bashrc *)
+let create_default id =
+  let t = Config.create () in
+  List.iter ~f:(ensure_set t) all_vars;
+  save id t;
+  t
+
+let get id =
+  let file = env_file (Id.to_string id) in
+  if Sys.file_exists_exn file then
+    begin
+      match Config.read_file file with
+      | Ok t ->
+        List.iter ~f:(ensure_set t) all_vars;
+        save id t;
+        t
+      | Error exn ->
+        Log.printf
+          "Can't read env file for %s (%s).  Writing new file from bash env."
+          (Id.to_string id)
+          (Exn.to_string exn);
+        create_default id
+    end
+  else
+    create_default id
+
+(* Set the variable of a project. *)
+let set id x b =
+  let t = get id in
+  Config.update t ~key:(var_to_string x) ~value:(Bool.to_string b);
+  save id t
+
+(* Set the variables before starting the process. *)
+let set_env t =
+  let put k =
+    let key = var_to_string k in
+    let default = Bool.to_string (default k) in
+    let data = Config.lookup t ~key ~default in
+    Unix.putenv ~key ~data
+  in
+  List.iter ~f:put all_vars

File ocaml/omake/lib/env.mli

+
+open Std
+
+type var =
+| FOUR_POINT_ZERO
+| LIMIT_SUBDIRS_FOR_SPEED
+| LINK_EXECUTABLES
+| VERSION_UTIL_SUPPORT
+| X_LIBRARY_INLINING
+with sexp
+
+val var_to_string : var -> string
+val var_of_string : string -> var
+
+type t
+
+val value : t -> var -> bool
+
+val to_elisp : t -> Elisp.t
+val get : Id.t -> t
+val set : Id.t -> var -> bool -> unit
+val set_env : t -> unit

File ocaml/omake/lib/error.ml

+
+open Std
+
+module Make = struct
+  type t = {
+    relpath : path;
+    file : path;
+    line : int;
+    char_beg : int;
+    char_end : int;
+    text : string;
+    full_text : string option;
+  }
+end
+
+type t = {
+  hash : int;
+  relpath : path;
+  file : path;
+  line : int;
+  char_beg : int;
+  char_end : int;
+  text : string;
+  full_text : string option;
+} with sexp, fields
+
+(* Emacs compiled on a 32 bit machine can only handle 2^28 hash.  Not sure why. *)
+let hash m = Hashtbl.hash m mod 268435456
+
+let make m =
+  let hash = hash m in
+  { hash
+  ; relpath = m.Make.relpath
+  ; file = m.Make.file
+  ; line = m.Make.line
+  ; char_beg = m.Make.char_beg
+  ; char_end = m.Make.char_end
+  ; text = m.Make.text
+  ; full_text = m.Make.full_text }
+
+let to_string = Sexp.to_string_hum ** sexp_of_t
+
+let rootpath e = e.relpath ^/ e.file
+
+let compare e1 e2 =
+  match String.compare (rootpath e1) (rootpath e2) with
+  | 0 -> Int.compare e1.line e2.line
+  | n -> n
+
+let equal x y = x.hash = y.hash
+  (* String.equal x.file y.file && *)
+  (*   Int.equal x.line y.line && *)
+  (*   Int.equal x.char_beg x.char_beg && *)
+  (*   Int.equal x.char_end y.char_end *)
+
+(* n^2 dedup.  Errors must maintain their relative order in the raw buffer.
+   Of the equal errors, keep the last. *)
+let rec dedup l = match l with
+| [] -> l
+| x :: xs ->
+  let xs = dedup xs in
+  if List.exists ~f:(equal x) xs then xs else x :: xs
+
+(* truncate long lines that may wrap to the next line *)
+let shorten_lines s =
+  let lines = String.split ~on:'\n' s in
+  let lines = List.map lines ~f:truncate in
+  String.concat lines ~sep:"\n"
+
+let abbreviate s =
+  let lines = String.split ~on:'\n' s in
+  let n = List.length lines in
+  if n < 10 then None
+  else
+    List.take lines 3 @ "       ..." :: List.drop lines (n - 3)
+    |! String.concat ~sep:"\n"
+    |! some
+
+(* Some errors have bad indentation in the raw output, e.g.
+   File "util/check_inotify_max_user_watches.ml", line 9, characters 14-15:
+                                 Parse error: [module_longident]
+*)
+let cleanup_indentation s =
+  Regex.rewrite (Regex.of_string "[ \t]+(Parse error:.*)") ~template:"$1" s
+
+(* to_elisp corresponds to the elisp constructor *)
+let to_elisp ~id t =
+  let text = String.escaped (cleanup_indentation t.text) in
+  let full_text = match t.full_text with
+  | None -> text
+  | Some ftext -> String.escaped ftext
+  in
+  sprintf "
+      (Omake.Error :hash %d
+                   :id \"%s\"
+                   :relpath \"%s\"
+                   :file \"%s\"
+                   :line %d
+                   :char-beg %d
+                   :char-end %d
+                   :text \"%s\"
+                   :full-text \"%s\")"
+    t.hash id t.relpath t.file t.line t.char_beg t.char_end
+    text full_text

File ocaml/omake/lib/error.mli

+
+open Std
+
+type t with sexp
+
+module Make : sig
+  type t = {
+    relpath : path;
+    file : path;
+    line : int;
+    char_beg : int;
+    char_end : int;
+    text : string;
+    full_text : string option;
+  }
+end
+
+val make : Make.t -> t
+
+val relpath : t -> path
+val text : t -> string
+val full_text : t -> string option
+val file : t -> path
+
+val to_string : t -> string
+val to_elisp : id:string -> t -> Elisp.t
+  (* path from the omake root *)
+val rootpath : t -> path
+val dedup : t list -> t list
+val shorten_lines : string -> string
+val abbreviate : string -> string option
+val compare : t -> t -> int
+val equal : t -> t -> bool

File ocaml/omake/lib/files.ml

+
+open Std
+
+let check_perms f = match Unix.access f [`Read; `Write] with
+| Ok () -> ()
+| Error _ ->
+  begin
+    printf "I can't read and write %s.  Please fix the permissions and try again.\n" f;
+    exit 1
+  end
+
+let shared_root = "/tmp/omake-server"
+let _ = Shell.mkdir ~p:() ~perm:0o777 shared_root
+let _ = check_perms shared_root
+let root = sprintf "%s/%s" shared_root Util.user
+let _ = Shell.mkdir ~p:() root
+let _ = check_perms root
+
+let project_dir id =
+  let dir = sprintf "%s%s" root (Id.to_string id) in
+  Shell.mkdir ~p:() dir;
+  dir
+
+let project_file name id =
+  sprintf "%s/%s" (project_dir id) name
+
+let server_log_dir = sprintf "%s/log/server" root
+let _ = Shell.mkdir ~p:() server_log_dir
+let controller = sprintf "%s/controller" server_log_dir
+
+let omake = project_file "omake"
+let elisp = project_file "elisp.el"
+let log = project_file "log"
+let env = project_file "env"
+let server_log () =
+  let date = Date.to_string (Date.today ()) in
+  sprintf "%s/%s" server_log_dir date
+
+let socket = sprintf "%s/socket" root
+let server_state = sprintf "%s/server-state.el" root
+
+let rec omakeroot_dir = function
+| "/" | "" -> None
+| p ->
+  match
+    Array.findi (Sys.readdir p)
+      ~f:(fun _ -> function "OMakeroot" -> true | _ -> false)
+  with
+  | Some _ -> Some p
+  | None -> omakeroot_dir (Filename.dirname p)

File ocaml/omake/lib/files.mli

+
+open Std
+
+val omake         : Id.t -> path
+val elisp         : Id.t -> path
+val log           : Id.t -> path
+val env           : Id.t -> path
+val server_state  : path
+val controller    : path
+val server_log    : unit -> path
+val socket        : path
+val omakeroot_dir : path -> path option

File ocaml/omake/lib/id.ml

+
+open Std
+
+include String

File ocaml/omake/lib/id.mli

+
+open Std
+
+type t with sexp
+
+include Hashable.S with type t := t
+include Stringable.S with type t := t
+

File ocaml/omake/lib/inline_tests.ml

+(* This file was autogenerated; don't edit it by hand*)
+
+let tests () = OUnit.TestList [
+    Config.ounit_tests ();
+    Elisp.ounit_tests ();
+    Emacs.ounit_tests ();
+    Env.ounit_tests ();
+    Error.ounit_tests ();
+    Files.ounit_tests ();
+    Id.ounit_tests ();
+    Log.ounit_tests ();
+    Omake.ounit_tests ();
+    Omake_command.ounit_tests ();
+    Omake_inotify.ounit_tests ();
+    Process.ounit_tests ();
+    Project.ounit_tests ();
+    Projects.ounit_tests ();
+    Query.ounit_tests ();
+    Regex.ounit_tests ();
+    Server.ounit_tests ();
+    Server_config.ounit_tests ();
+    Std.ounit_tests ();
+    Top.ounit_tests ();
+    Util.ounit_tests ();
+    Version.ounit_tests ();
+];;
+
+let run () =  ignore (OUnit.run_test_tt_main (tests ()):OUnit.test_result list)

File ocaml/omake/lib/inline_tests_runner.ml

+let () = Omake_lib.Inline_tests.run ();;

File ocaml/omake/lib/log.ml

+
+open Std
+
+type t = { mutable path : path option
+         ; mutable writer : Writer.t }
+
+let t = { path = None
+        ; writer = Lazy.force Writer.stdout }
+
+let log_writer () =
+  let log = Files.server_log () in
+  let has_writer = is_some t.path in
+  if t.path = Some log then return t.writer
+  else
+    begin
+      t.path <- Some log;
+      Writer.open_file ~append:true (Files.server_log ()) >>= fun writer ->
+      (if has_writer then Writer.close t.writer else Deferred.unit) >>| fun () ->
+      t.writer <- writer;
+      writer
+    end
+
+let wait () = log_writer () >>| ignore
+
+let time_prefix () = sprintf "[%s]" (Time.to_string (Time.now ()))
+
+let msg s = sprintf "%s %s\n" (time_prefix()) s
+
+let printf fmt =
+  match Deferred.peek (log_writer ()) with
+  | None ->
+    eprintf "WARNING: no log writer.  Writing to stderr.\n";
+    ksprintf (fun s -> eprintf "%s" (msg s)) fmt
+  | Some writer ->
+    ksprintf (fun s -> Writer.writef writer "%s" (msg s)) fmt
+
+let exn ?(msg = "Caught exception") e =
+  printf "%s: %s" msg (Exn.to_string e)

File ocaml/omake/lib/log.mli

+
+open Std
+
+val printf : ('a, unit, string, unit) format4 -> 'a
+val wait : unit -> unit deferred
+val exn : ?msg:string -> exn -> unit
+val msg : string -> string

File ocaml/omake/lib/omake.ml

+
+(* TODO:
+
+   Handle the event
+   'Preprocessing error on file chris.ml'
+
+   Sometimes it's ok, as in
+
+   File "chris.ml", line 74, characters 14-15:
+   Parse error: [module_longident] expected after "." (in [module_longident])
+   Preprocessing error on file chris.ml
+
+   But other times, for example when hacking camlp4, there is no
+   file position to jump to.
+
+   File "core_set.ml", line 807, characters 68-69:
+   Parse error: [ctyp level ctyp2] expected after ")" (in [ctyp])
+   Preprocessing error on file core_set.ml
+*)
+
+open Std
+
+(* -------------------------------------------------------------------------- *)
+(*  Util                                                                      *)
+(* -------------------------------------------------------------------------- *)
+
+let debug = ref false
+
+(* Limit the number of errors being sent to Emacs.  It happens
+   very often, and we're not being smart about remembering which
+   we've sent. *)
+let max_sent_errors = 50
+
+type debug =
+| Event
+| Debug
+
+let genprintf d s =
+  if !debug then
+    match d with
+    | Event -> Printf.eprintf ("[event] " ^^ s ^^ "\n%!")
+    | Debug -> Printf.eprintf ("[debug] " ^^ s ^^ "\n%!")
+  else Printf.ifprintf Out_channel.stderr s
+
+let eprintf fmt = genprintf Event fmt
+let dprintf fmt = genprintf Debug fmt
+
+(* -------------------------------------------------------------------------- *)
+(*  Rex                                                                       *)
+(* -------------------------------------------------------------------------- *)
+
+module Rex = struct
+  let reading_omakefiles = Regex.of_string
+    (sprintf "(%s|%s)"
+       "omake: reading OMakefiles"
+       "omake: a configuration file changed, restarting")
+
+  let finished_omakefiles = Regex.of_string
+    "\\*\\*\\* omake: finished reading OMakefiles"
+
+  let reading_omakefiles_failed = Regex.of_string
+    "\\*\\*\\* omake: reading OMakefiles failed"
+
+  (* *** omake: 11789/11796 targets are up to date *)
+  let targets_up_to_date = Regex.of_string
+    "\\*\\*\\* omake: (?P<num>[0-9]+)/(?P<denom>[0-9]+) targets are up to date"
+
+  (* [=======================  ] 11789 / 11796 *)
+  let progress_bar = Regex.of_string
+    "\\[=* *\\] (?P<num>[0-9]+) / (?P<denom>[0-9]+)"
+
+  (* - build base/core/lib inline_tests.ml.  This will set
+     base/core/lib as the relative path and inline_tests.ml as the file.
+     The former changes the state for all following errors until a reset.
+
+     Dir examples: eye/2.0/mama_tally_channel
+  *)
+  let build = Regex.of_string
+    "- (build|scan) (?P<dir>[a-zA-Z/_0-9.-]+) (?P<file>[a-zA-Z_0-9-]+)\\..*"
+
+  let start_build = Regex.of_string
+    "- build \\. <\\.BUILD_BEGIN>"
+
+  (* *** omake: file base/core/lib/core_list.mli changed *)
+  let changed = Regex.of_string
+    "\\*\\*\\* omake: file ((?P<dir>[^ ]+)/)?(?P<file>[^ /]+)\\..* changed"
+
+  (* File "marcin.ml", line 24, characters 2-5: *)
+  let ocaml_error = Regex.of_string
+    (String.concat
+       [ "File \"(?P<file>.+)\", "
+       ; "line (?P<line>[0-9]+), "
+       ; "characters (?P<charbeg>[0-9]+)-(?P<charend>[0-9]+)[^\n]*"
+       ])
+
+  (* File "bug.ml", line 1:
+     Error: The implementation a.ml does not match the interface a.cmi:
+            The field `y' is required but not provided
+
+     Also error-enabled warnings. *)
+  let ocaml_error_no_chars = Regex.of_string
+    "File \"(?P<file>.+)\", line (?P<line>[0-9]+):"
+
+  let polling = Regex.of_string
+    "\\*\\*\\* omake: polling for filesystem changes.*"
+
+  let rebuilding = Regex.of_string
+    "\\*\\*\\* omake: rebuilding"
+
+  let done_ = Regex.of_string
+    "\\*\\*\\* omake: done"
+
+  (* Don't show errors like this
+
+        File "lib/bug.ml", line 1, characters 0-1:
+        Error: Error-enabled warnings (1 occurrences)
+  *)
+  let error_enabled_warnings = Regex.of_string
+    "Error-enabled warnings"
+
+  (* We used to process blocked messages, but I think you get
+     either a 'done' or 'blocked' message when compilation stops.
+     If this is true, than the absence of 'done' means it's blocked.
+  *)
+  (* let blocked = Regex.of_string
+   *   "\\*\\*\\* omake: blocked" *)
+
+  (* Handle varied omake errors.
+
+   Examples:
+
+   Error: Files inline_tests.cmo and std.cmo
+          make inconsistent assumptions over interface Std
+
+   File "core.cmx", line 1, characters 0-1:
+        Error: File caml.cmx
+        was not compiled with the `-for-pack Core' option
+  *)
+  let omake_error =
+    let error1 = "\\*\\*\\* omake error:" in
+    let error2 = " *Error: Forward reference" in
+    let error3 = " *Error: No implementations provided" in
+    let error4 = " *Error: Cannot find file" in
+    let error5 = "omake: \".*\" failed on" in
+    let error6 = " *Error: Files" in
+    let error7 = " *File \".*\\.cmx\"" in
+    let error8 = "\\*\\*\\* omake: deadlock" in
+    let error9 = "ocamlfind: Package `.*' not found" in
+    let error10 = "\\*\\*\\* omake: the project is currently locked." in
+    (* *** omake: the current directory /home/seanmcl/ocaml/ocaml1/lib/abc
+       *** omake: is not part of the root project in /home/seanmcl/ocaml/ocaml1 *)
+    let error11 = "\\*\\*\\* omake: the current directory" in
+    let error12 = "\\*\\*\\* omake: is a dependency of" in
+    let error13 = " *Error: Preprocessor error" in
+    (* Don't use "waiting for project lock" because the line takes a long time
+       to end while omake spits out ............. *)
+    (* let error10 = "\\*\\*\\* omake: waiting for project lock:" in *)
+    Regex.of_string (sprintf "(%s|%s|%s|%s|%s|%s|%s|%s|%s|%s|%s|%s|%s)"
+                       error1 error2 error3 error4 error5 error6
+                       error7 error8 error9 error10 error11 error12
+                       error13)
+end
+
+(* -------------------------------------------------------------------------- *)
+(*  Filter                                                                    *)
+(* -------------------------------------------------------------------------- *)
+
+(* Remove useless lines *)
+
+module Filter : sig
+  type how = Error | Failure
+  val f : how -> string list -> string list
+end = struct
+  type how = Error | Failure
+
+  let error_regexps = List.map ~f:Regex.of_string
+    [ "^[[:space:]]*$"
+    ; "\\*\\*\\*.*"
+    ; "- build.*"
+    ; "- exit.*"
+    ; "\\+ ocaml.*"
+    ; "^\\[=+"
+    ; "depends on:.*"
+    ; "make\\[.*"
+    ; ".*\\.cmx.*"
+      (* Need *.cmi for
+         "does not match the interface top_state.cmi:"
+         It seems paths with / are ok to delete.
+      *)
+    ; ".*/.*\\.cmi"
+    ; ".*/.*\\.cmo"
+    ; ".*/.*\\.o"
+    ; ".*/.*\\.c"
+    ; ".*/.*\\.d"
+    ; "ln -sf.*"
+    ; "cp .*\\.a.*"
+    ; "<scanner.*"
+    ; "Preprocessing error.*"
+    ; "^\\[saved .omakedb"
+    ]
+
+  let failure_regexps = List.map ~f:Regex.of_string
+    [ "^[[:space:]]*$"
+    ; "- build.*"
+    ; "- exit.*"
+    ; "^\\[=+"
+    (* ; "depends on:.*" *)
+    ; "ln -sf.*"
+    ; "cp .*\\.a.*"
+    ]
+
+  (* Remove status bar from the end of lines *)
+  let remove_progress_bar =
+    let status_regex = Regex.of_string "([^\\[].*)\\[=+\\].*" in
+    fun l -> Regex.rewrite status_regex l ~template:"\\1"
+
+  let spaces_before_text s =
+    let n = String.length s in
+    let k = ref 0 in
+    while !k < n && String.get s !k = ' ' do incr k done;
+    !k
+
+  let unindent lines =
+    let indent = List.fold lines ~init:1000 ~f:(fun k s ->
+      let k' = spaces_before_text s in
+      if k' < k then k' else k)
+    in
+      (* let str = String.concat ~sep:"\n" lines in
+       * dprintf "Unindenting %d chars\n%d lines\n%s" indent (List.length lines) str; *)
+    List.map lines ~f:(fun s ->
+      let n = String.length s in
+      String.sub s ~pos:indent ~len:(n - indent))
+
+  (* Clean up the error message by deleting irrelevant lines and
+     removing the status bar. *)
+  let f how lines =
+    let regexps = match how with
+    | Error -> error_regexps
+    | Failure -> failure_regexps
+    in
+    let lines = List.map lines ~f:remove_progress_bar in
+    let lines = List.filter lines ~f:(fun line ->
+      let keep = not (List.exists regexps ~f:(fun regex -> Regex.has_match regex line)) in
+      if not keep then dprintf "Ignoring line: %s" line; keep)
+    in
+    lines
+    |! unindent
+end
+
+(* -------------------------------------------------------------------------- *)
+(*  Output window                                                             *)
+(* -------------------------------------------------------------------------- *)
+
+module Window : sig
+  val failure_string : unit -> string
+  val add_line : string -> unit
+end = struct
+  module D = Doubly_linked
+  let max_window_size = 200
+  let show_lines = 30
+  let size = ref 0
+  let t = D.create ()
+  let add_line s =
+    ignore (D.insert_last t s);
+    if !size > max_window_size then
+      ignore (D.remove_first t)
+
+  (* Matches known good points in the buffer.  Don't show any lines before
+     the last good point. *)
+  let ends_block = [
+    Rex.done_;
+    Rex.finished_omakefiles;
+    Rex.polling
+  ]
+
+  let failure_string () =
+    let lines = D.to_list t in
+    let lines = List.rev lines in
+    (* If the last line is polling, remove it so we can find the penultimate
+       polling line. *)
+    let lines = match lines with
+    | [] -> []
+    | l :: ls ->
+      if Regex.has_match Rex.polling l then ls
+      else lines
+    in
+    let lines =
+      let f _ l = List.exists ends_block ~f:(fun rex -> Regex.has_match rex l) in
+      match List.findi lines ~f with
+      | None -> lines
+      | Some (i, _) -> List.take lines i
+    in
+    let lines = Filter.f Filter.Failure lines in
+    let lines = List.take lines show_lines in
+    let lines = List.rev lines in
+    String.concat ~sep:"\n" lines
+end
+
+(* -------------------------------------------------------------------------- *)
+(*  Failures                                                                  *)
+(* -------------------------------------------------------------------------- *)
+
+module Failure : sig
+  type t = {
+    msg : string;
+    window : string;
+  } with sexp_of
+  val equal : t -> t -> bool
+  val to_string : t -> string
+end = struct
+  type t = {
+    msg : string;
+    window : string;
+  } with sexp_of
+  let equal { msg; window } { msg = m; window = w } = msg = m && window = w
+  let to_string = Sexp.to_string_hum ** sexp_of_t
+end
+
+(* -------------------------------------------------------------------------- *)
+(*  Partial errors                                                            *)
+(* -------------------------------------------------------------------------- *)
+
+module Partial_error : sig
+  type t
+  val create_ocaml
+    :  relpath:path
+    -> file:string
+    -> line:int
+    -> char_beg:int
+    -> char_end:int
+    -> text:string
+    -> t
+  val create_omake
+    :  text:string
+    -> t
+  val add_line : t -> string -> unit
+  val reify : t -> [`Ocaml of Error.t | `Omake of Failure.t ]
+end = struct
+  type ocaml = {
+    relpath : path;
+    file : string;
+    line : int;
+    char_beg : int;
+    char_end : int;
+    mutable lines : string list;
+  }
+
+  type omake = {
+    mutable lines_ : string list;
+  }
+
+  type t = [`Ocaml of ocaml | `Omake of omake]
+
+  let create_ocaml ~relpath ~file ~line ~char_beg ~char_end ~text =
+    `Ocaml { relpath; file; line; char_beg; char_end; lines = [ text ] }
+
+  let create_omake ~text = `Omake { lines_ = [ text ] }
+
+  let add_line t s =
+    (* CR sweeks: I disabled the following line. *)
+    if false then printf "adding error line: %s\n" s;
+    match t with
+    | `Ocaml ocaml -> ocaml.lines <- s :: ocaml.lines
+    | `Omake omake -> omake.lines_ <- s :: omake.lines_
+
+  let to_ocaml_error t =
+    let lines = Filter.f Filter.Error (List.rev t.lines) in
+    (* In OCaml 4.0, error-enabled warnings are attached to the
+       warning.  Remove the last two lines.
+
+       File "pa_variants_conv.ml", line 95, characters 6-19:
+       Warning 32: unused value variant_names.
+       File "pa_variants_conv.ml", line 1:
+       Error: Error-enabled warnings (1 occurrences) *)
+    let text = String.concat ~sep:"\n" lines in
+    let text, full_text = match Error.abbreviate text with
+      | None -> Error.shorten_lines text, None
+      | Some short_text -> Error.shorten_lines short_text, Some text
+    in
+    Error.make { Error.Make.relpath = t.relpath
+               ; file = t.file
+               ; line = t.line
+               ; char_beg = t.char_beg
+               ; char_end = t.char_end
+               ; text
+               ; full_text
+               }
+
+  let to_omake_error t =
+    (* Don't remove lines from omake errors.  Often the lines we don't care about
+       in ocaml errors are relevant in omake errors. *)
+    let lines = Filter.f Filter.Failure (List.rev t.lines_) in
+    let msg = String.concat ~sep:"\n" lines in
+    let window = Window.failure_string () in
+    { Failure.msg; window }
+
+  let reify = function
+    | `Ocaml t -> `Ocaml (to_ocaml_error t)
+    | `Omake t -> `Omake (to_omake_error t)
+end
+
+(* -------------------------------------------------------------------------- *)
+(*  Status                                                                    *)
+(* -------------------------------------------------------------------------- *)
+
+module Status = struct
+  type t =
+  | Starting
+  | Polling
+  | Reading_omakefiles
+  | Reading_omakefiles_failed
+  | Finished_omakefiles
+  | Building
+  with sexp_of
+  let to_string s = Sexp.to_string (sexp_of_t s)
+  let to_elisp = function
+    | Starting -> "Omake.Status.Starting"
+    | Polling -> "Omake.Status.Polling"
+    | Reading_omakefiles -> "Omake.Status.Reading_omakefiles"
+    | Reading_omakefiles_failed -> "Omake.Status.Reading_omakefiles_failed"
+    | Finished_omakefiles -> "Omake.Status.Finished_omakefiles"
+    | Building -> "Omake.Status.Building"
+  let _ = ignore_unused_warning (to_string)
+end
+
+(* -------------------------------------------------------------------------- *)
+(*  Events                                                                    *)
+(* -------------------------------------------------------------------------- *)
+
+module Event : sig
+  type t =
+  | Status of Status.t
+  | Progress_bar of int * int
+  | Targets_up_to_date of int * int
+  | New_error of [`Ocaml of Error.t | `Omake of Failure.t]
+  | Refresh_file of [`Dir of path] * [`Filename_with_no_extension of string]
+  | Done
+  | Last_line of string
+  | Eof
+  with sexp_of
+  val parse_events : string Pipe.Reader.t -> t result Pipe.Reader.t
+end = struct
+  type t =
+  | Status of Status.t
+  | Progress_bar of int * int
+  | Targets_up_to_date of int * int
+  | New_error of [`Ocaml of Error.t | `Omake of Failure.t]
+  | Refresh_file of [`Dir of path] * [`Filename_with_no_extension of string]
+  | Done
+  | Last_line of string
+  | Eof
+  with sexp_of
+
+  let parse_events string_reader =
+    let (event_reader, event_writer) = Pipe.create () in
+    let write t =
+      (* dprintf "parse_events: ok: %s" (Sexp.to_string (sexp_of_t t)); *)
+      Pipe.write event_writer (Ok t)
+    in
+    let relpath = ref None in
+    let partial_error = ref None in
+    let add_error_line l = match !partial_error with
+      | None -> ()
+      | Some e -> Partial_error.add_line e l
+    in
+    let finish_error () = match !partial_error with
+      | None -> Deferred.unit
+      | Some p ->
+        dprintf "finishing";
+        let e = Partial_error.reify p in
+        write (New_error e) >>| fun () ->
+        partial_error := None
+    in
+    (* Don't write progress bars as last lines *)
+    let last_line s =
+      if Regex.has_match Rex.progress_bar s then Deferred.unit
+      else
+        begin
+          Window.add_line s;
+          write (Last_line s)
+        end
+    in
+    let eq s1 s2 = String.equal (String.strip s1) s2 in
+    let iter () : unit deferred = Pipe.iter string_reader ~f:(function
+      | s when eq s "" ->
+        Deferred.unit
+      | s when eq s "EOF" ->
+        write Eof
+      | s ->
+        last_line s >>= fun () ->
+        if Regex.has_match Rex.reading_omakefiles s then
+          begin
+            finish_error () >>= fun () ->
+            write (Status Status.Reading_omakefiles)
+          end
+        else if Regex.has_match Rex.reading_omakefiles_failed s then
+          begin
+            finish_error () >>= fun () ->
+            write (Status Status.Reading_omakefiles_failed)
+          end
+        else if Regex.has_match Rex.finished_omakefiles s then
+          begin
+            finish_error () >>= fun () ->
+            write (Status Status.Finished_omakefiles)
+          end
+        else if Regex.has_match Rex.start_build s then
+          begin
+            finish_error () >>= fun () ->
+            write (Status Status.Building)
+          end
+        else if Regex.has_match Rex.polling s then
+          begin
+            finish_error () >>= fun () ->
+            write (Status Status.Polling)
+          end
+        else if Regex.has_match Rex.rebuilding s then
+          begin
+            finish_error () >>= fun () ->
+            write (Status Status.Building)
+          end
+        else if Regex.has_match Rex.done_ s then
+          begin
+            finish_error () >>= fun () ->
+            write Done
+          end
+        else if Regex.has_match Rex.omake_error s then
+          begin
+            dprintf "omake error";
+            let partial = Partial_error.create_omake ~text:s in
+            finish_error () >>| fun () ->
+            partial_error := Some partial
+          end
+        else
+          (* Please keep the nonstandard indentation *)
+          let rex = Rex.targets_up_to_date in
+          match Regex.matches rex s with
+          | m :: _ ->
+            let num = match Regex.get rex ~sub:(`Name "num") m with
+            | None -> 0
+            | Some n -> Int.of_string n
+            in
+            let denom = match Regex.get rex ~sub:(`Name "denom") m with
+            | None -> 0
+            | Some n -> Int.of_string n
+            in
+            finish_error () >>= fun () ->
+            write (Targets_up_to_date (num, denom))
+          | [] ->
+          let rex = Rex.progress_bar in
+          match Regex.matches rex s with
+          | m :: _ ->
+            let num = match Regex.get rex ~sub:(`Name "num") m with
+            | None -> 0
+            | Some s -> Int.of_string s
+            in
+            let denom = match Regex.get rex ~sub:(`Name "denom") m with
+            | None -> 0
+            | Some s -> Int.of_string s
+            in
+            finish_error () >>= fun () ->
+            write (Progress_bar (num, denom))
+          | [] ->
+          let rex = Rex.build in
+          match Regex.matches rex s with
+          | m :: _ ->
+            let dir = match Regex.get rex ~sub:(`Name "dir") m with
+            | None -> "."
+            | Some d -> d
+            in
+            let file = match Regex.get rex ~sub:(`Name "file") m with
+            | None -> "NO_FILE"
+            | Some s -> s
+            in
+            relpath := Some dir;
+            finish_error () >>= fun () ->
+            write (Status Status.Building) >>= fun () ->
+            write (Refresh_file (`Dir dir, `Filename_with_no_extension file))
+          | [] ->
+          let rex = Rex.changed in
+          match Regex.matches rex s with
+          | m :: _ ->
+            let dir = match Regex.get rex ~sub:(`Name "dir") m with
+            | None -> "."
+            | Some d -> d
+            in
+            let file = match Regex.get rex ~sub:(`Name "file") m with
+            | None -> "NO_FILE"