Peter Szilagyi avatar Peter Szilagyi committed 2804a42 Merge

Automated merge with ssh://hg2//hg/jane-elisp/test

Comments (0)

Files changed (25)

+
+new stuff
+=========
+
+- ocp-indent can be used to indent ocaml code.
+
+    https://github.com/OCamlPro/ocp-indent
+
+  Currently only whole-buffer indentation is supported.  To use it, set
+
+    (setq ocaml-indenter 'ocp-indent)
+
+  to use Tuareg's indenter, use
+
+    (setq ocaml-indenter 'tuareg)
+
+  This is in its infancy, but we added a few regression tests so we
+  don't go backwards.
+
+  The code is in omake-mode/ocp-indent.  To run regression tests do
+  cd regressions; ./runtests
+
+- omake-mode works with the new core release, ocaml-core-108.07.00
+
+changes
+=======
+
+- We are using a new repo,
+
+    https://bitbucket.org/seanmcl/ocaml-core-108.07.00-seanmcl
+
+  to build omake-mode both externally and at Jane Street.  This makes
+  problems we faced with installing inotify in the two places easier to handle.
+
+bug fixes
+=========
+
+--------------------------------------------------------------------------------
 
 new stuff
 =========

elisp/jane/jane-ocaml.el

 
 (defvar jane-make-command "jomake -j 12 -P -w")
 
+(defcustom ocaml-indenter 'tuareg
+  "Whether to use tuareg or ocp-indent as an indentation engine.  To use ocp-indent,
+add the following to your .emacs file:
+   (setq ocaml-indenter 'ocp-indent)")
+
+(defun ocaml-indenter ()
+  (case ocaml-indenter
+    ('tuareg 'Jane.tuareg-indent-line-with-syntax)
+    ('ocp-indent 'Ocp.indent-buffer)
+    (t (error "bad key for Jane.Ocaml.indent.  Should be 'tuareg or 'ocp-indent"))))
+
 (defun jane-tuareg-mode-hook ()
   (auto-fill-mode 1)
   (setq fill-column 90)
   (set (make-local-variable 'compile-command) jane-make-command)
   (setq whitespace-style '(lines-tail tabs tab-mark trailing))
   (add-hook 'before-save-hook 'whitespace-cleanup)
-  (setq indent-line-function 'Jane.tuareg-indent-line-with-syntax)
+  ;;(setq indent-line-function 'Jane.tuareg-indent-line-with-syntax)
+  (setq indent-line-function (ocaml-indenter))
   (let ((mycaml (expand-file-name "mycaml" default-directory)))
     (when (file-exists-p mycaml)
       (set (make-local-variable 'tuareg-interactive-program) mycaml))))

elisp/omake/test/1/lib/pretty.ml

 let zero_width_text = sized_text 0
 
 let rec nil_beside g p = match p with
-| Empty -> Empty
-| Nest (_, p) -> nil_beside g p
-| _ ->
+  | Empty -> Empty
+  | Nest (_, p) -> nil_beside g p
+  | _ ->
     if g then text_beside_ space_text 1 p
     else p
 
 let reduce_ab = function
-| Above (Empty, _, q) -> q
-| Beside (Empty, _, q) -> q
-| p -> p
+  | Above (Empty, _, q) -> q
+  | Beside (Empty, _, q) -> q
+  | p -> p
 
 let char c = text_beside_ (Chr c) 1 Empty
 
 let union_ p q = Union (p, q)
 
 let rec mk_nest k p = match p with
-| Nest (k1, p) -> mk_nest (k + k1) p
-| No_doc -> No_doc
-| Empty -> Empty
-| _ -> match k with
+  | Nest (k1, p) -> mk_nest (k + k1) p
+  | No_doc -> No_doc
+  | Empty -> Empty
+  | _ -> match k with
   | 0 -> p
   | k -> nest_ k p
 
 let mk_union p q = match p with
-| Empty -> Empty
-| _ -> union_ p q
+  | Empty -> Empty
+  | _ -> union_ p q
 
 let empty = Empty
 
 let is_empty = function
-| Empty -> true
-| _ -> false
+  | Empty -> true
+  | _ -> false
 
 let char c = text_beside_ (Chr c) 1 Empty
 
 (* This is Haskell's beside_'.  It's not necessary to have both, and beside_'
    is better for partial application *)
 let beside_ g p q = match p, q with
-| _, Empty -> p
-| Empty, _ -> q
-| _ -> Beside (p, g, q)
+  | _, Empty -> p
+  | Empty, _ -> q
+  | _ -> Beside (p, g, q)
 
 (* See comment for beside_ *)
 let above_ g p q = match p, q with
-| _, Empty -> p
-| Empty, _ -> q
-| _ -> Above (p, g, q)
+  | _, Empty -> p
+  | Empty, _ -> q
+  | _ -> Above (p, g, q)
 
 let hcat = reduce_ab ** List.fold_right ~init:empty ~f:(beside_ false)
 let hsep = reduce_ab ** List.fold_right ~init:empty ~f:(beside_ true)
 let braces p = char '{' <> p <> char '}'
 
 let punctuate p = function
-| [] -> []
-| d :: ds ->
+  | [] -> []
+  | d :: ds ->
     let rec go d' = function
-    | [] -> [d']
-    | e :: es -> (d' <> p) :: go e es
+      | [] -> [d']
+      | e :: es -> (d' <> p) :: go e es
     in
     go d ds
 
 let rec nil_above_nest g k q = match q with
-| Empty -> Empty
-| Nest (k1, q) -> nil_above_nest g (k + k1) q
-| _ ->
+  | Empty -> Empty
+  | Nest (k1, q) -> nil_above_nest g (k + k1) q
+  | _ ->
     if not g && k > 0
     then text_beside_ (Str (indent k)) k q
     else nil_above_ (mk_nest k q)
 
 let rec above_nest p g k q = match p with
-| No_doc -> No_doc
-| Union (p1, p2) -> union_ (above_nest p1 g k q) (above_nest p2 g k q)
-| Empty -> mk_nest k q
-| Nest (k1, p) -> nest_ k1 (above_nest p g (k - k1) q)
-| Nil_above p -> nil_above_ (above_nest p g k q)
-| Text_beside (s, sl, p) ->
+  | No_doc -> No_doc
+  | Union (p1, p2) -> union_ (above_nest p1 g k q) (above_nest p2 g k q)
+  | Empty -> mk_nest k q
+  | Nest (k1, p) -> nest_ k1 (above_nest p g (k - k1) q)
+  | Nil_above p -> nil_above_ (above_nest p g k q)
+  | Text_beside (s, sl, p) ->
     let k1 = k - sl in
     let rest = match p with
     | Empty -> nil_above_nest g k1 q
     | _ -> above_nest p g k1 q
     in
     text_beside_ s sl rest
-| Above _ | Beside _ -> failwith "Impossible"
+  | Above _ | Beside _ -> failwith "Impossible"
 
 let rec reduce_doc p = match p with
-| Beside (p, g, q) -> beside p g (reduce_doc q)
-| Above (p, g, q) -> above p g (reduce_doc q)
-| _ -> p
+  | Beside (p, g, q) -> beside p g (reduce_doc q)
+  | Above (p, g, q) -> above p g (reduce_doc q)
+  | _ -> p
 
 and beside p g q = match p with
-| No_doc -> No_doc
-| Union (p1, p2) -> union_ (beside p1 g q) (beside p2 g q)
-| Empty -> q
-| Nest (k, p) -> nest_ k (beside p g q)
-| Beside (p1, g1, q1) ->
+  | No_doc -> No_doc
+  | Union (p1, p2) -> union_ (beside p1 g q) (beside p2 g q)
+  | Empty -> q
+  | Nest (k, p) -> nest_ k (beside p g q)
+  | Beside (p1, g1, q1) ->
     if Bool.equal g1 g then beside p1 g1 (beside q1 g q)
     else beside (reduce_doc p) g q
-| Above _ -> beside (reduce_doc p) g q
-| Nil_above p -> nil_above_ (beside p g q)
-| Text_beside (s, sl, p) ->
+  | Above _ -> beside (reduce_doc p) g q
+  | Nil_above p -> nil_above_ (beside p g q)
+  | Text_beside (s, sl, p) ->
     let rest = match p with
     | Empty -> nil_beside g q
     | _ -> beside p g q
     text_beside_ s sl rest
 
 and above p g q = match p with
-| Above (p, g1, q1) -> above p g1 (above q1 g q)
-| Beside _ -> above_nest (reduce_doc p) g 0 (reduce_doc q)
-| _ -> above_nest p g 0 (reduce_doc q)
+  | Above (p, g1, q1) -> above p g1 (above q1 g q)
+  | Beside _ -> above_nest (reduce_doc p) g 0 (reduce_doc q)
+  | _ -> above_nest p g 0 (reduce_doc q)
 
-(* -------------------------------------------------------------------------- *)
-(*  Fill                                                                      *)
-(* -------------------------------------------------------------------------- *)
+  (* -------------------------------------------------------------------------- *)
+  (*  Fill                                                                      *)
+  (* -------------------------------------------------------------------------- *)
 
 let rec one_liner = function
-| No_doc -> No_doc
-| Empty -> Empty
-| Nil_above _ -> No_doc
-| Text_beside (s, sl, p) -> text_beside_ s sl (one_liner p)
-| Nest (k, p) -> nest_ k (one_liner p)
-| Union (p, _) -> one_liner p
-| Above _ | Beside _ -> failwith "Impossible"
+  | No_doc -> No_doc
+  | Empty -> Empty
+  | Nil_above _ -> No_doc
+  | Text_beside (s, sl, p) -> text_beside_ s sl (one_liner p)
+  | Nest (k, p) -> nest_ k (one_liner p)
+  | Union (p, _) -> one_liner p
+  | Above _ | Beside _ -> failwith "Impossible"
 
 let elide_nest = function
-| Nest (_, d) -> d
-| d -> d
+  | Nest (_, d) -> d
+  | d -> d
 
 let rec fill g = function
-| [] -> empty
-| p :: ps -> fill1 g (reduce_doc p) 0 ps
+  | [] -> empty
+  | p :: ps -> fill1 g (reduce_doc p) 0 ps
 
 and fill1 g p k ys = match p with
-| No_doc -> No_doc
-| Union (p, q) -> union_ (fill1 g p k ys) (above_nest q false k (fill g ys))
-| Empty -> mk_nest k (fill g ys)
-| Nest (n, p) -> nest_ n (fill1 g p (k - n) ys)
-| Nil_above p -> nil_above_ (above_nest p false k (fill g ys))
-| Text_beside (s, sl, p) -> text_beside_ s sl (fill_nb g p (k - sl) ys)
-| Above _ | Beside _ -> failwith "Impossible"
+  | No_doc -> No_doc
+  | Union (p, q) -> union_ (fill1 g p k ys) (above_nest q false k (fill g ys))
+  | Empty -> mk_nest k (fill g ys)
+  | Nest (n, p) -> nest_ n (fill1 g p (k - n) ys)
+  | Nil_above p -> nil_above_ (above_nest p false k (fill g ys))
+  | Text_beside (s, sl, p) -> text_beside_ s sl (fill_nb g p (k - sl) ys)
+  | Above _ | Beside _ -> failwith "Impossible"
 
 and fill_nb g p k ys = match p, ys with
-| Nest (_, p), _ -> fill_nb g p k ys
-| Empty, [] -> Empty
-| Empty, Empty :: ys -> fill_nb g Empty k ys
-| Empty, y :: ys -> fill_nbe g k y ys
-| _ -> fill1 g p k ys
+  | Nest (_, p), _ -> fill_nb g p k ys
+  | Empty, [] -> Empty
+  | Empty, Empty :: ys -> fill_nb g Empty k ys
+  | Empty, y :: ys -> fill_nbe g k y ys
+  | _ -> fill1 g p k ys
 
 and fill_nbe g k y ys =
   let k1 = if g then k - 1 else k in
 (* -------------------------------------------------------------------------- *)
 
 let rec sep_nb g p k ys = match p with
-| Nest (_, p) -> sep_nb g p k ys
-| Empty ->
+  | Nest (_, p) -> sep_nb g p k ys
+  | Empty ->
     let rest = if g then hsep ys else hcat ys in
     mk_union
       (one_liner (nil_beside g (reduce_doc rest)))
       (nil_above_nest true k (reduce_doc (vcat ys)))
-| _ -> sep1 g p k ys
+  | _ -> sep1 g p k ys
 
 and sep1 g p k ys = match p with
-| No_doc -> No_doc
-| Union (p, q) -> union_ (sep1 g p k ys) (above_nest q false k (reduce_doc (vcat ys)))
-| Empty -> mk_nest k (sep_x g ys)
-| Nest (n, p) -> nest_ n (sep1 g p (k - n) ys)
-| Nil_above p -> nil_above_ (above_nest p false k (reduce_doc (vcat ys)))
-| Text_beside (s, sl, p) -> text_beside_ s sl (sep_nb g p (k - sl) ys)
-| Above _ | Beside _ -> failwith "Impossible"
+  | No_doc -> No_doc
+  | Union (p, q) -> union_ (sep1 g p k ys) (above_nest q false k (reduce_doc (vcat ys)))
+  | Empty -> mk_nest k (sep_x g ys)
+  | Nest (n, p) -> nest_ n (sep1 g p (k - n) ys)
+  | Nil_above p -> nil_above_ (above_nest p false k (reduce_doc (vcat ys)))
+  | Text_beside (s, sl, p) -> text_beside_ s sl (sep_nb g p (k - sl) ys)
+  | Above _ | Beside _ -> failwith "Impossible"
 
 and sep_x x = function
-| [] -> empty
-| p :: ps -> sep1 x (reduce_doc p) 0 ps
+  | [] -> empty
+  | p :: ps -> sep1 x (reduce_doc p) 0 ps
 
 let sep = sep_x true
 let cat = sep_x false
 (* -------------------------------------------------------------------------- *)
 
 let rec non_empty_set = function
-| No_doc -> false
-| Union _ | Empty | Nil_above _ -> true
-| Text_beside (_, _, p) | Nest (_, p) -> non_empty_set p
-| Above _ | Beside _ -> failwith "Impossible"
+  | No_doc -> false
+  | Union _ | Empty | Nil_above _ -> true
+  | Text_beside (_, _, p) | Nest (_, p) -> non_empty_set p
+  | Above _ | Beside _ -> failwith "Impossible"
 
 let first p q = if non_empty_set p then p else q
 
   let gap_width = page_width - ribbon_width in
   let shift = quot gap_width 2 in
   let rec lay k = function
-  | Nest (k1, p) -> lay (k + k1) p
-  | Empty -> end_
-  | Above _ | Beside _ | No_doc _ | Union _ -> failwith "Impossible"
-  | Nil_above p -> nl_text <> lay k p
-  | Text_beside (s, sl, p) -> begin match the_mode with
+    | Nest (k1, p) -> lay (k + k1) p
+    | Empty -> end_
+    | Above _ | Beside _ | No_doc _ | Union _ -> failwith "Impossible"
+    | Nil_above p -> nl_text <> lay k p
+    | Text_beside (s, sl, p) -> begin match the_mode with
     | Zig_zag_mode ->
-        if k >= gap_width
-        then
-          nl_text <> (Str (String.make shift '/') <> (nl_text <> lay1 (k - shift) s sl p))
-        else
-          nl_text <> (Str (String.make shift '\\') <> (nl_text <> lay1 (k + shift) s sl p))
+      if k >= gap_width
+      then
+        nl_text <> (Str (String.make shift '/') <> (nl_text <> lay1 (k - shift) s sl p))
+      else
+        nl_text <> (Str (String.make shift '\\') <> (nl_text <> lay1 (k + shift) s sl p))
     | _ -> lay1 k s sl p
     end
   and lay1 k s sl p = Str (indent k) <> (s <> lay2 (k + sl) p)
   and lay2 k = function
-  | Nil_above p -> nl_text <> lay k p
-  | Text_beside (s, sl, p) -> s <> lay2 (k + sl) p
-  | Nest (_, p) -> lay2 k p
-  | Empty -> end_
-  | Above _ | Beside _ | No_doc _ | Union _ -> failwith "Impossible"
+    | Nil_above p -> nl_text <> lay k p
+    | Text_beside (s, sl, p) -> s <> lay2 (k + sl) p
+    | Nest (_, p) -> lay2 k p
+    | Empty -> end_
+    | Above _ | Beside _ | No_doc _ | Union _ -> failwith "Impossible"
   in
   lay 0 doc
 
 let best mode w0 r p0 = match mode with
-| One_line_mode ->
+  | One_line_mode ->
     let rec get = function
-    | Empty -> Empty
-    | No_doc -> No_doc
-    | Nil_above p -> nil_above_ (get p)
-    | Text_beside (s, sl, p) -> text_beside_ s sl (get p)
-    | Nest (_, p) -> get p
-    | Union (p, q) -> first (get p) (get q)
-    | Above _ | Beside _ -> failwith "Impossible"
+      | Empty -> Empty
+      | No_doc -> No_doc
+      | Nil_above p -> nil_above_ (get p)
+      | Text_beside (s, sl, p) -> text_beside_ s sl (get p)
+      | Nest (_, p) -> get p
+      | Union (p, q) -> first (get p) (get q)
+      | Above _ | Beside _ -> failwith "Impossible"
     in
     get p0
-| _ ->
+  | _ ->
     let rec get w = function
-    | Empty -> Empty
-    | No_doc -> No_doc
-    | Nil_above p -> nil_above_ (get w p)
-    | Text_beside (s, sl, p) -> text_beside_ s sl (get1 w sl p)
-    | Nest (k, p) -> nest_ k (get (w - k) p)
-    | Union (p, q) -> nicest w r (get w p) (get w q)
-    | Above _ | Beside _ -> failwith "Impossible"
+      | Empty -> Empty
+      | No_doc -> No_doc
+      | Nil_above p -> nil_above_ (get w p)
+      | Text_beside (s, sl, p) -> text_beside_ s sl (get1 w sl p)
+      | Nest (k, p) -> nest_ k (get (w - k) p)
+      | Union (p, q) -> nicest w r (get w p) (get w q)
+      | Above _ | Beside _ -> failwith "Impossible"
     and get1 w sl = function
-    | Empty -> Empty
-    | No_doc -> No_doc
-    | Nil_above p -> nil_above_ (get (w - sl) p)
-    | Text_beside (t, tl, p) -> text_beside_ t tl (get1 w (sl + tl) p)
-    | Nest (_k, p) -> get1 w sl p
-    | Union (p, q) -> nicest1 w r sl (get1 w sl p) (get1 w sl q)
-    | Above _ | Beside _ -> failwith "Impossible"
+      | Empty -> Empty
+      | No_doc -> No_doc
+      | Nil_above p -> nil_above_ (get (w - sl) p)
+      | Text_beside (t, tl, p) -> text_beside_ t tl (get1 w (sl + tl) p)
+      | Nest (_k, p) -> get1 w sl p
+      | Union (p, q) -> nicest1 w r sl (get1 w sl p) (get1 w sl q)
+      | Above _ | Beside _ -> failwith "Impossible"
     in
     get w0 p0
 
   | One_line_mode -> easy_display space_text (<>) end_ (reduce_doc doc)
   | Left_mode -> easy_display nl_text (<>) end_ (reduce_doc doc)
   | _ ->
-      let hacked_line_length = match the_mode with
-      | Zig_zag_mode -> Int.max_value
-      | _ -> line_length
-      in
-      let ribbon_length = Float.iround_towards_zero_exn (Float.of_int line_length /. ribbons_per_line) in
-      let best_doc = best the_mode hacked_line_length ribbon_length (reduce_doc doc) in
-      display the_mode line_length ribbon_length (<>) end_ best_doc
+    let hacked_line_length = match the_mode with
+    | Zig_zag_mode -> Int.max_value
+    | _ -> line_length
+    in
+    let ribbon_length = Float.iround_towards_zero_exn (Float.of_int line_length /. ribbons_per_line) in
+    let best_doc = best the_mode hacked_line_length ribbon_length (reduce_doc doc) in
+    display the_mode line_length ribbon_length (<>) end_ best_doc
 
 let string_txt t s = match t with
-| Chr c -> Char.to_string c ^ s
-| Str s1 | Pstr s1 -> s1 ^ s
+  | Chr c -> Char.to_string c ^ s
+  | Str s1 | Pstr s1 -> s1 ^ s
 
 let show_doc doc rest = full_render Page_mode 100 1.5 string_txt rest doc
 
    (t 'local)))
 
 (defconst jane-dirs
-  '(
-    "ocp-indent"
+  '("ocp-indent"
     "elisp/jane"
     "elisp/omake"
     "elisp/contrib"
-    "elisp/contrib/tuareg"
-    ))
+    "elisp/contrib/tuareg"))
 
 (dolist (dir jane-dirs)
   (add-to-list 'load-path (expand-file-name dir jane-home)))
 (add-to-list 'Info-directory-list "/usr/share/info/" t)
 
 
+;; CR smclaughlin for sweeks: I propose changing the names jane-XXX to Jane.XXX
+
 (progn
   ;; The code below deals with [whitespace-style], which affects both highlighting of
   ;; whitespace via [whitespace-mode] and with cleanup of whitespace via
 ;; see jane-microfeatures
 
 ;;(Jane.advanced)
-;; CR cfalls: I think there's no reason to have auto-modes here --
-;; it's loaded in js-common.
-(Jane.auto-modes)
+;; XCR cfalls: I think there's no reason to have auto-modes here -- it's loaded in js-common.
+;; smclaughlin: deleted Jane.auto-modes
 ;;(Jane.auto-revert)
 ;;(Jane.backups)
 (Jane.bell)

ocaml/omake/emacs.ml

   t.writer <- writer
 | None ->
   let t = { pid; writer; watching = Id.Hash_set.create () } in
-  whenever (Writer.close_finished writer >>= fun () -> unregister pid);
+  don't_wait_for (Writer.close_finished writer >>= fun () -> unregister pid);
   Hashtbl.replace table ~key:pid ~data:t
 
 let writer t = t.writer

ocaml/omake/omake.ml

             add_error_line s;
             Deferred.unit)
     in
-    whenever (iter ());
+    don't_wait_for (iter ());
     event_reader
 end
 
     let span = Time.Span.of_sec 1.0 in
     let stop_ivar = Ivar.create () in
     Clock.every' span ~stop:(Ivar.read stop_ivar) update1;
-    (* whenever (Pipe.iter update_reader ~f:update); *)
+    (* don't_wait_for (Pipe.iter update_reader ~f:update); *)
     (* let update () = *)
-    (*   whenever (Pipe.write update_writer ()); *)
+    (*   don't_wait_for (Pipe.write update_writer ()); *)
     (*   Deferred.unit *)
     (* in *)
     (* update the model *)
           omake_error >>= fun () ->
           update ())
     in
-    whenever (iter ());
+    don't_wait_for (iter ());
     elisp_reader
 end
 
     let state = State.create ~omakeroot_dir in
     let lines = Pipe.map ~f:cleanup_chars reader in
     let (reader, writer) = Pipe.create () in
-    whenever (Pipe.iter lines ~f:(Deferred.List.iter ~f:(Pipe.write writer)));
+    don't_wait_for (Pipe.iter lines ~f:(Deferred.List.iter ~f:(Pipe.write writer)));
     let events = Event.parse_events reader in
     State.handle_events state events
 end

ocaml/omake/process.ml

   let stdin_text = stdin in
   let process_exited = ref false in
   let kill ~pid = if not !process_exited then term_or_kill pid in
-  In_thread.syscall_exn (fun () ->
+  In_thread.syscall_exn ~name:"omake-mode-process" (fun () ->
     Unix.create_process_env ~prog ~args ~env ?working_dir ())
   >>= fun proc_info ->
     let pid    = proc_info.Unix.Process_info.pid in
        unwelcomed extra complexity. What exactly are we guarding against? *)
     Kill_at_shutdown.register pid;
     let stdin =
-      Fd.create Fd.Kind.Fifo proc_info.Unix.Process_info.stdin ~name:"<stdin>"
+      Fd.create Fd.Kind.Fifo proc_info.Unix.Process_info.stdin (Info.of_string "<stdin>")
     in
     let stdout =
-      Fd.create Fd.Kind.Fifo proc_info.Unix.Process_info.stdout ~name:"<stdout>"
+      Fd.create Fd.Kind.Fifo proc_info.Unix.Process_info.stdout (Info.of_string "<stdout>")
     in
     let stderr =
-      Fd.create Fd.Kind.Fifo proc_info.Unix.Process_info.stderr ~name:"<stderr>"
+      Fd.create Fd.Kind.Fifo proc_info.Unix.Process_info.stderr (Info.of_string "<stderr>")
     in
     let stdin  = Writer.create stdin  in
     let stdout = Reader.create stdout in
         Unix.dup2 ~src:stdin ~dst:Unix.stdin;
         Unix.dup2 ~src:stdout ~dst:Unix.stdout;
         Unix.dup2 ~src:stderr ~dst:Unix.stderr;
-        Unix.execvp ~prog ~args:(Array.of_list (prog::args))
+        UnixLabels.execvp ~prog ~args:(Array.of_list (prog::args))
       with
       | _ ->
         Printf.eprintf "exec failed: %s\n%!" prog;
     create ?kill ~prog ~args ~env () ~f:(fun _pid ~stdin ~stdout ~stderr ->
       Ivar.fill readers (stdout, stderr);
       Writer.close stdin >>= fun () ->
-        Deferred.all_unit [Reader.closed stdout; Reader.closed stderr]
+        Deferred.all_unit [Reader.close_finished stdout; Reader.close_finished stderr]
     )
   in
   upon status (fun ((), status) ->

ocaml/omake/project.ml

         partial := last;
         Deferred.List.iter ~f:(Pipe.write w) complete)
     in
-    whenever (iter ());
+    don't_wait_for (iter ());
     r
   in
   let elisp_pipe = Omake.parse_omake_output ~omakeroot_dir reader in
   create1 t >>| fun t ->
   kill_when_unwatched t;
   (* start never returns *)
-  whenever (start t);
+  don't_wait_for (start t);
   t
 
 let to_elisp t =

ocaml/omake/server.ml

   Log.wait ()
   >>= fun () ->
   Log.printf "Starting controller on %s" Files.socket;
-  Tcp.serve_unix ~file:Files.socket ~on_handler_error:`Raise (fun _ reader writer ->
+  Tcp.Server.create ~on_handler_error:`Raise (Tcp.on_file Files.socket)
+    (fun _ reader writer ->
     (* NB: reader and writer are the same file descriptor. *)
-    try_with (fun () ->
-      Reader.read_sexp reader >>= function
-      | `Eof ->
-        Writer.close writer >>= fun () ->
-        Reader.close reader >>= fun () ->
-        failwith "Read error"
-      | `Ok s ->
+      try_with (fun () ->
+        Reader.read_sexp reader >>= function
+        | `Eof ->
+          Writer.close writer >>= fun () ->
+          Reader.close reader >>= fun () ->
+          failwith "Read error"
+        | `Ok s ->
         (* Don't close the reader.  The writer gets saved in the hashtable. *)
-        Log.printf "omake server received: %s" (Sexp.to_string s);
+          Log.printf "omake server received: %s" (Sexp.to_string s);
         (* When Emacs is killed, the server will still be writing messages to
            its writer for a few seconds until the server notices emacs is dead.
            Ignore the pipe failures. *)
-        Writer.set_raise_epipe writer false;
-        Query.handle writer (Query.t_of_sexp s)) >>= function
-    | Ok () -> Deferred.unit
-    | Error exn ->
-      Log.exn exn;
-      Writer.writef writer "%s" (Elisp.error (Exn.to_string exn));
-      Deferred.unit) >>= fun () ->
+          Writer.set_raise_when_consumer_leaves writer false;
+          Query.handle writer (Query.t_of_sexp s)) >>= function
+      | Ok () -> Deferred.unit
+      | Error exn ->
+        Log.exn exn;
+        Writer.writef writer "%s" (Elisp.error (Exn.to_string exn));
+        Deferred.unit) >>= fun _ ->
   (* The server should remain alive until shutdown is called explicitly. *)
   Log.printf "Accepting TCP connections.";
   watch_for_inotify_limit ();
   | `No | `Unknown ->
     failwithf "Missing socket file: %s" file ()
   | `Yes ->
-    Tcp.connect_unix ~file () >>= fun (reader, writer) ->
-    Writer.write writer msg;
-    Pipe.iter (Reader.pipe reader) ~f:(fun s ->
+    Tcp.with_connection (Tcp.to_file Files.socket) (fun reader writer ->
+      Writer.write writer msg;
+      Pipe.iter (Reader.pipe reader) ~f:(fun s ->
       (* Write to the process's stdout *)
-      printf "%s\n" s;
-      Deferred.unit)
+        printf "%s\n" s;
+        Deferred.unit))

ocaml/omake/std.ml

   end
   module Array = Array
   module Bool = Bool
-  module Service_command = Core_extended.Core_service_command
-  module Command = Core_extended.Core_command
+  module Service_command = Core_extended.Service_command
+  module Command = Core.Command
   module Date = Date
   module Doubly_linked = Doubly_linked
   module Filename = Filename
   let (>>=) = (>>=)
   let (>>|) = (>>|)
   let (>>>) = (>>>)
-  let whenever = whenever
+  let don't_wait_for = don't_wait_for
   let return = return
   let try_with = try_with
   let shutdown = shutdown

ocaml/omake/top.ml

       name = "omake_server";
       redirect_stdout = `File_append Files.controller;
       redirect_stderr = `File_append Files.controller; }
-    let slot_spec () = Command.Spec.( const slot )
+    let slot_spec () = Command.Spec.( empty +> const slot )
     let main_spec =
       Command.Spec.(
-        step (fun m debug -> if debug then Omake.debug := true; m ~foreground:false) ++
-          flag "-debug" no_arg ~doc:" Print debugging info into [omake-server-log]" )
+        step (fun m debug -> if debug then Omake.debug := true; m ~foreground:false)
+        ++ empty
+        +> flag "-debug" no_arg ~doc:" Print debugging info into [omake-server-log]"
+      )
     let main _ =
       schedule ~quit:false (fun () ->
         at_exit (fun () -> printf "Hello, world!\n");
 
   let stop = Command.basic
     ~summary:"Stop the server"
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.Stop_server)
 
   let controller = Command.group ~summary:"controller"
 
   let show = Command.basic
     ~summary:"Show the server state"
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.Show_state)
 
   let ping = Command.basic
     ~summary:"Ping the server"
-    Command.Spec.( flag "-pid" (required int) ~doc:"PID emacs pid"
-                   ++ flag "-version" (required int) ~doc:"INT emacs omake version"
-                   ++ flag "-counter" (required int) ~doc:"INT id"  )
+    Command.Spec.( empty
+                   +> flag "-pid" (required int) ~doc:"PID emacs pid"
+                   +> flag "-version" (required int) ~doc:"INT emacs omake version"
+                   +> flag "-counter" (required int) ~doc:"INT id"  )
     (fun pid version uid ->
       let pid = Pid.of_int pid in
       send (Q.Ping (pid, { Q.version; uid })))
 
   let version = Command.basic
     ~summary:"Print the version so we can sync with the elisp version."
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> Core.Std.printf "%d" Version.version)
 
   let running =
     Command.basic
       ~summary:"return 0 if the controller is listening on the socket, 1 otherwise"
-      Command.Spec.( const () )
+      Command.Spec.( empty +> const () )
       (fun () -> schedule (fun () ->
         (* Send an arbitrary query *)
         try_with (fun () -> Server.connect "Running") >>| function
     Command.basic
       ~summary:"Run on a given file."
       Command.Spec.(
-        flag "-debug" no_arg ~doc:" Print debugging info into [omake-server-log]"
-        ++ anon ("file" %: string) )
+        empty
+        +> flag "-debug" no_arg ~doc:" Print debugging info into [omake-server-log]"
+        +> anon ("file" %: string) )
       (fun debug file ->
         schedule ~quit:true (fun () ->
           if debug then Omake.debug := true;
 
   let send_to_emacs = Command.basic
     ~summary:"Send a command to emacs."
-    Command.Spec.( flag "-pid" (optional int) ~doc:"PID"
-                   ++ anon ("sexp" %: string) )
+    Command.Spec.( empty
+                   +> flag "-pid" (optional int) ~doc:"PID"
+                   +> anon ("sexp" %: string) )
     (fun pid msg ->
       let pid = Option.map ~f:Pid.of_int pid in
       send (Q.Send_to_emacs (pid, msg)))
 
   let register_emacs = Command.basic
     ~summary:"Register an emacs process."
-    Command.Spec.( anon ("pid" %: int) )
+    Command.Spec.( empty +> anon ("pid" %: int) )
     (fun pid ->
       let pid = Pid.of_int pid in
       send (Q.Register_emacs pid))
 
   let unregister_emacs = Command.basic
     ~summary:"Unregister an emacs process."
-    Command.Spec.( anon ("pid" %: int) )
+    Command.Spec.( empty +> anon ("pid" %: int) )
     (fun pid ->
       let pid = Pid.of_int pid in
       send (Q.Unregister_emacs pid))
 
   let watch = Command.basic
     ~summary:"Watch a project"
-    Command.Spec.( anon ("pid" %: int) ++ anon ("id" %: string) )
+    Command.Spec.( empty +> anon ("pid" %: int) +> anon ("id" %: string) )
     (fun pid id ->
       let pid = Pid.of_int pid  in
       let id = Id.of_string id in
 
   let unwatch = Command.basic
     ~summary:"Stop watching a project"
-    Command.Spec.( anon ("pid" %: int) ++ anon ("id" %: string) )
+    Command.Spec.( empty +> anon ("pid" %: int) +> anon ("id" %: string) )
     (fun pid id ->
       let pid = Pid.of_int pid  in
       let id = Id.of_string id in
 
   let list_watched = Command.basic
     ~summary:"List watched projects"
-    Command.Spec.( anon ("pid" %: int) )
+    Command.Spec.( empty +> anon ("pid" %: int) )
     (fun pid ->
       let pid = Pid.of_int pid in
       send (Q.List_watched pid))
 
   let create_project = Command.basic
     ~summary:"Create a project"
-    Command.Spec.( flag "-id" (required string) ~doc:"ID"
-                   ++ flag "-omakeroot-dir" (required string) ~doc:"DIR"
-                   ++ flag "-compilation-dir" (optional string) ~doc:"DIR"
-                   ++ flag "-user-command" (optional string) ~doc:"STRING")
+    Command.Spec.( empty
+                   +> flag "-id" (required string) ~doc:"ID"
+                   +> flag "-omakeroot-dir" (required string) ~doc:"DIR"
+                   +> flag "-compilation-dir" (optional string) ~doc:"DIR"
+                   +> flag "-user-command" (optional string) ~doc:"STRING")
     (fun id omakeroot_dir compilation_dir user_command ->
       let id = Id.of_string id in
       let compilation_dir = Option.value ~default:omakeroot_dir compilation_dir in
 
   let kill_project = Command.basic
     ~summary:"Kill a project"
-    Command.Spec.( anon ("id" %: string) )
+    Command.Spec.( empty +> anon ("id" %: string) )
     (fun id -> send (Q.Kill_project (`Id (Id.of_string id))))
 
   let list_projects = Command.basic
     ~summary:"List projects"
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.List_projects_emacs)
 
   let update_projects = Command.basic
     ~summary:"Update projects"
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.Update_projects)
 
   let get_project_env = Command.basic
     ~summary:"Get a project environment variable."
-    Command.Spec.( anon ("id" %: string) ++ anon ("var" %: string) )
+    Command.Spec.( empty +> anon ("id" %: string) +> anon ("var" %: string) )
     (fun id var ->
       let id = Id.of_string id in
       let var = Env.var_of_string var in
 
   let set_project_env = Command.basic
     ~summary:"Set a project environment variable."
-    Command.Spec.( anon ("id" %: string)
-                   ++ anon ("var" %: string)
-                   ++ anon ("value" %: bool) )
+    Command.Spec.( empty
+                   +> anon ("id" %: string)
+                   +> anon ("var" %: string)
+                   +> anon ("value" %: bool) )
     (fun id var v ->
       let id = Id.of_string id in
       let var = Env.var_of_string var in
 
   let list = Command.basic
     ~summary:"List projects"
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.List_projects)
 
   let kill = Command.basic
     ~summary:"Kill a project"
-    Command.Spec.( anon (maybe ("id|index" %: string)) )
+    Command.Spec.( empty +> anon (maybe ("id|index" %: string)) )
     (fun arg ->
       let arg = match arg with
       | None -> Sys.getcwd ()
 
   let create = Command.basic
     ~summary:"Create a project"
-    Command.Spec.( anon (maybe ("dir" %: string))
-                   ++ flag "-user-command" (optional string) ~doc:"STRING")
+    Command.Spec.( empty
+                   +> anon (maybe ("dir" %: string))
+                   +> flag "-user-command" (optional string) ~doc:"STRING")
     (fun dir cmd ->
       let dir = match dir with
       | None -> Sys.getcwd ()
 
   let kill_when_unwatched = Command.basic
     ~summary:"kill a project when unwatched?"
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.Kill_when_unwatched)
 
   let omake_command = Command.basic
     ~summary:"default omake command"
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.Omake_command)
 
   let warn_when_setting_env_vars = Command.basic
     ~summary:"warn that env changes only take effect on the next build."
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.Warn_when_setting_env_vars)
 
   let don't_warn_when_setting_env_vars = Command.basic
     ~summary:"Never warn about env changes again."
-    Command.Spec.( const () )
+    Command.Spec.( empty +> const () )
     (fun () -> send Q.Don't_warn_when_setting_env_vars)
 
 end

ocp-indent/model.ml

   -> int
 
 type t =
-| A
-| B
+  | A
+  | B
 
 let height = function
-| A -> 0
-| B -> 1
+  | A -> 0
+  | B -> 1
 
 let _ =
   if x then begin
     y
   end else if x then
-      y
+    y
   else z
 
 let _ = match x with

ocp-indent/ocp-indent-stdin

 
 set -e -u -o pipefail
 
-ocp-indent <(cat)
+ocp-indent /dev/stdin

ocp-indent/ocp-indent.el

 
 (defcustom Ocp.indent-program
   (concat (file-name-directory load-file-name) "ocp-indent-stdin")
-  ;; (format "%s/bin/ocp-indent-stdin" (getenv "HOME"))
-  "Program to use to indent your code"
-  )
+  "Program to use to indent your code")
 
 (defun Ocp.indentation ()
   (save-excursion
 ;; ;; If cursor is before any characters, tab sends you to the new indentation
 ;; ;; Otherwise, go to (oldCol - oldIndent + newIndent)
 ;; ;; oldCol - oldIndent is nonnegative
-(defun Ocp.indent-buffer ()
-  (interactive)
+(defun Ocp.indent-region (beg end)
+  (interactive "r")
   (let* ((coding-system-for-write 'utf-8)
          (coding-system-for-read 'utf-8)
          (windows (get-buffer-window-list (current-buffer)))
          (old-col (current-column))
          (ws (window-start))
          (ln (line-number-at-pos pt)))
-    (call-process-region (point-min) (point-max) Ocp.indent-program t t)
+    (call-process-region beg end Ocp.indent-program t t)
     (goto-char (point-min))
     (forward-line (1- ln))
     (if in-indentation (forward-to-indentation 0)
             (let ((w (nth 0 info))
                   (pt (nth 1 info))
                   (st (nth 2 info)))
-              ;;(set-window-point w pt)
               (set-window-start w st))) window-info)))
 
+(defun Ocp.indent-buffer ()
+  (interactive)
+  (Ocp.indent-region (point-min) (point-max)))
+
+;; (defun Ocp.indent-line ()
+;;   (interactive)
+;;   (let ((end
+;;          (progn
+;;            (end-of-line)
+;;            (point)))
+;;         (beg
+;;          (progn
+;;            (previous-line 1)
+;;            (beginning-of-line)
+;;            (point))))
+;;     (Ocp.indent-region beg end)
+;;     (forward-line 1)
+;;     (forward-to-indentation 0)
+;;     ))
+
 (provide 'ocp-indent)

ocp-indent/regressions/1.ml

+
+let (quot, _rem) =
+  let quot_rem n k =
+    let (d, m) = (n / k, n mod k) in
+    if d < 0 && m > 0 then (d+1, m-k)
+    else (d, m)
+  in
+  let quot n k = fst (quot_rem n k) in
+  let rem n k = snd (quot_rem n k) in
+  quot, rem

ocp-indent/regressions/2.ml

+
+type t =
+  | A
+  | B

ocp-indent/regressions/3.ml

+
+val f
+  :  int
+  -> int

ocp-indent/regressions/4.ml

+
+let height = function
+  | A -> 0
+  | B -> 1

ocp-indent/regressions/5.ml

+
+let _ =
+  if x then begin
+    y
+  end else if x then
+    y
+  else z

ocp-indent/regressions/6.ml

+
+let _ = match x with
+  1 |
+  2 |
+  3

ocp-indent/regressions/7.ml

+
+let _ =
+  if x then y else
+  if x then y else
+  x

ocp-indent/regressions/8.ml

+type t
+  =  int
+  -> int

ocp-indent/regressions/runtests

+#!/bin/bash
+
+tests=$(ls *.ml)
+
+fail=0
+
+indent=ocp-indent
+
+echo "Running $(ls *.ml | wc -l | sed 's/[^0-9]//g') tests"
+
+for test in $tests; do
+    out1=$test.out1
+    out=$test.out
+
+    # already indented
+    $indent $test > $out
+    if ! $(cmp $test $out &> /dev/null); then
+        fail=1
+        echo "Test $test failed when already indented!"
+    fi
+
+    # flushleft
+    sed -E 's/^ +//' $test > $out1
+    $indent $out1 > $out
+    if ! $(cmp $test $out &> /dev/null); then
+        fail=1
+        echo "Test $test failed on flush-left!"
+    fi
+
+    # spaces in front of lines
+    sed -E 's/^ *([^ ])/             \1/' $test > $out1
+    $indent $out1 > $out
+    if ! $(cmp $test $out &> /dev/null); then
+        fail=1
+        echo "Test $test failed on added spaces!"
+    fi
+
+    rm -f $out $out1
+done
+
+big=time/big.ml
+echo "Timing $big"
+#echo "lines : $(wc -l $big | sed 's/[^0-9]//g')"
+{ time -p $indent $big >/dev/null; } 2>&1 | grep real | sed 's/real/time  : /'
+
+exit $fail
+
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.