Merge branch 'dev' of gitlab.com:WzukW/oclaunch into dev

.gitlab-ci.yml

@@ -11,5 +11,5 @@ ocaml_402:
   script: "./gitlab-ci.sh 4.02.3"
 
 # OCaml version 4.03
-ocaml_403:
-  script: "./gitlab-ci.sh 4.03.0+beta2"
+#ocaml_403:
+#  script: "./gitlab-ci.sh 4.03.0"

0install.sh

@@ -18,7 +18,7 @@ if [ ! -d $dist ]; then
   mkdir $dist
 fi
 # Archive name, _the bin emphasis the difference with source tarball
-id=`git describe --abbrev=40 --candidates=50 HEAD`
+id=`git describe --abbrev=10 --candidates=50 HEAD`
 name=oclaunch-${id}_$(arch)_bin
 final_binary_path=./$name/oclaunch
 final_binary_name=oclaunch
@@ -41,14 +41,16 @@ tar_name=${name}.tar
 tar -cvaf ${tar_name} $name >> $dbg_log
 
 echo "========= Creating first archive ========="
-coproc lzma -f -9 ${tar_name} >> $dbg_log
+coproc lzma -kf -9 ${tar_name} >> $dbg_log
+coproc gzip -kf -9 ${tar_name} >> $dbg_log
 
 # Create stripped archive
 tar_name_stripped=${name}_stripped.tar
 strip $final_binary_path
 tar -cvaf ${tar_name_stripped} $name >> $dbg_log
 echo "========= Creating second (stripped) archive ========="
-coproc lzma -f -9 ${tar_name_stripped} >> $dbg_log
+coproc lzma -kf -9 ${tar_name_stripped} >> $dbg_log
+coproc gzip -kf -9 ${tar_name_stripped} >> $dbg_log
 
 # Wait for the detached compression process  to finish
 # (see lines starting with 'coproc')

CHANGELOG.md

@@ -34,7 +34,7 @@ This version introduce major changes in the tmp and rc file.
       command or the next one. The problem is that you can't call it with an
       option. To do this, use the **`run` subcommand**.
  + Improve **list subcommand**, now using Textutils library, displaying in an
-   array. Add `--el` argument to limit the length of displayed entries.
+   array. Add `--length` argument to limit the length of displayed entries.
  + Improve **edit subcommand** (explain how to use to add commands, improve
    messages, offer to reedit when nothing was done).
 
@@ -56,7 +56,9 @@ This version introduce major changes in the tmp and rc file.
  + Add licence warning.
  + Remove core\_extended dependency, incorporating some code from the library
    directly in the program, and using Textutils and Re2 library instead.
- + Display debugging information before each message.
+ + Display debugging information before each message. Flush stdout on each
+   message.
+ + Adapt code a bit for OCaml 4.03.
  + TODO XXX Add basic signal handling (`--signals`), to relaunch when doing
    ctrl-C. See issue #14 for known problems.
 

gitlab-ci.sh

@@ -30,3 +30,7 @@ opam pin add oclaunch-ci .
 # Building OcLaunch and running tests
 ./configure --enable-tests
 make test
+
+# Test the produced binary
+oclaunch -version
+echo "En" | oclaunch

myocamlbuild.ml

@@ -1,5 +1,5 @@
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 2948e791e5da69ac0f577932ef77419e) *)
+(* DO NOT EDIT (digest: a02f38e3e2213d6985da0d03d4f432d7) *)
 module OASISGettext = struct
 (* # 22 "src/oasis/OASISGettext.ml" *)
 
@@ -29,6 +29,166 @@ module OASISGettext = struct
 
 end
 
+module OASISString = struct
+(* # 22 "src/oasis/OASISString.ml" *)
+
+
+  (** Various string utilities.
+
+      Mostly inspired by extlib and batteries ExtString and BatString libraries.
+
+      @author Sylvain Le Gall
+    *)
+
+
+  let nsplitf str f =
+    if str = "" then
+      []
+    else
+      let buf = Buffer.create 13 in
+      let lst = ref [] in
+      let push () =
+        lst := Buffer.contents buf :: !lst;
+        Buffer.clear buf
+      in
+      let str_len = String.length str in
+        for i = 0 to str_len - 1 do
+          if f str.[i] then
+            push ()
+          else
+            Buffer.add_char buf str.[i]
+        done;
+        push ();
+        List.rev !lst
+
+
+  (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
+      separator.
+    *)
+  let nsplit str c =
+    nsplitf str ((=) c)
+
+
+  let find ~what ?(offset=0) str =
+    let what_idx = ref 0 in
+    let str_idx = ref offset in
+      while !str_idx < String.length str &&
+            !what_idx < String.length what do
+        if str.[!str_idx] = what.[!what_idx] then
+          incr what_idx
+        else
+          what_idx := 0;
+        incr str_idx
+      done;
+      if !what_idx <> String.length what then
+        raise Not_found
+      else
+        !str_idx - !what_idx
+
+
+  let sub_start str len =
+    let str_len = String.length str in
+    if len >= str_len then
+      ""
+    else
+      String.sub str len (str_len - len)
+
+
+  let sub_end ?(offset=0) str len =
+    let str_len = String.length str in
+    if len >= str_len then
+      ""
+    else
+      String.sub str 0 (str_len - len)
+
+
+  let starts_with ~what ?(offset=0) str =
+    let what_idx = ref 0 in
+    let str_idx = ref offset in
+    let ok = ref true in
+      while !ok &&
+            !str_idx < String.length str &&
+            !what_idx < String.length what do
+        if str.[!str_idx] = what.[!what_idx] then
+          incr what_idx
+        else
+          ok := false;
+        incr str_idx
+      done;
+      if !what_idx = String.length what then
+        true
+      else
+        false
+
+
+  let strip_starts_with ~what str =
+    if starts_with ~what str then
+      sub_start str (String.length what)
+    else
+      raise Not_found
+
+
+  let ends_with ~what ?(offset=0) str =
+    let what_idx = ref ((String.length what) - 1) in
+    let str_idx = ref ((String.length str) - 1) in
+    let ok = ref true in
+      while !ok &&
+            offset <= !str_idx &&
+            0 <= !what_idx do
+        if str.[!str_idx] = what.[!what_idx] then
+          decr what_idx
+        else
+          ok := false;
+        decr str_idx
+      done;
+      if !what_idx = -1 then
+        true
+      else
+        false
+
+
+  let strip_ends_with ~what str =
+    if ends_with ~what str then
+      sub_end str (String.length what)
+    else
+      raise Not_found
+
+
+  let replace_chars f s =
+    let buf = Buffer.create (String.length s) in
+    String.iter (fun c -> Buffer.add_char buf (f c)) s;
+    Buffer.contents buf
+
+  let lowercase_ascii =
+    replace_chars
+      (fun c ->
+         if (c >= 'A' && c <= 'Z') then
+           Char.chr (Char.code c + 32)
+         else
+           c)
+
+  let uncapitalize_ascii s =
+    if s <> "" then
+      (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+    else
+      s
+
+  let uppercase_ascii =
+    replace_chars
+      (fun c ->
+         if (c >= 'a' && c <= 'z') then
+           Char.chr (Char.code c - 32)
+         else
+           c)
+
+  let capitalize_ascii s =
+    if s <> "" then
+      (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+    else
+      s
+
+end
+
 module OASISExpr = struct
 (* # 22 "src/oasis/OASISExpr.ml" *)
 
@@ -129,7 +289,7 @@ module OASISExpr = struct
 end
 
 
-# 132 "myocamlbuild.ml"
+# 292 "myocamlbuild.ml"
 module BaseEnvLight = struct
 (* # 22 "src/base/BaseEnvLight.ml" *)
 
@@ -234,7 +394,7 @@ module BaseEnvLight = struct
 end
 
 
-# 237 "myocamlbuild.ml"
+# 397 "myocamlbuild.ml"
 module MyOCamlbuildFindlib = struct
 (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
 
@@ -516,7 +676,7 @@ module MyOCamlbuildBase = struct
                  | nm, [], intf_modules ->
                      ocaml_lib nm;
                      let cmis =
-                       List.map (fun m -> (String.uncapitalize m) ^ ".cmi")
+                       List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi")
                                 intf_modules in
                      dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
                  | nm, dir :: tl, intf_modules ->
@@ -529,7 +689,7 @@ module MyOCamlbuildBase = struct
                             ["compile"; "infer_interface"; "doc"])
                        tl;
                      let cmis =
-                       List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi")
+                       List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi")
                                 intf_modules in
                      dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
                          cmis)
@@ -603,7 +763,7 @@ module MyOCamlbuildBase = struct
 end
 
 
-# 606 "myocamlbuild.ml"
+# 766 "myocamlbuild.ml"
 open Ocamlbuild_plugin;;
 let package_default =
   {
@@ -618,6 +778,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
 
 let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
 
-# 622 "myocamlbuild.ml"
+# 782 "myocamlbuild.ml"
 (* OASIS_STOP *)
 Ocamlbuild_plugin.dispatch dispatch_default;;

opam

@@ -14,6 +14,7 @@ build: [
 install: [make "install"]
 remove: ["ocamlfind" "remove" "ocl"]
 depends: [
+  "ocamlbuild"
   "atdgen"
   "base-threads"
   "core" {>= "112.35.00"}

pkg.sh

@@ -10,7 +10,7 @@ fi
 
 # If no tag, use commit SHA1
 id=`git describe --abbrev=10 --candidates=50 HEAD`
-name=oclaunch_${id}_src # _src emphasis the difference with binary tarballs
+name=oclaunch_${id}_source # _source emphasis the difference with binary tarballs
 
 echo "Writing in" $name".*"
 git archive HEAD --prefix=${name}/ --format=zip -o dist/${name}.zip -9

setup.ml

@@ -1,9 +1,9 @@
 (* setup.ml generated for the first time by OASIS v0.4.5 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: ee3d9f571486e0f224e8dc93cc306657) *)
+(* DO NOT EDIT (digest: 258d28cc868fb8f51cc873723a895e58) *)
 (*
-   Regenerated by OASIS v0.4.5
+   Regenerated by OASIS v0.4.6
    Visit http://oasis.forge.ocamlcore.org for more information and
    documentation about functions used in this file.
 *)
@@ -246,6 +246,33 @@ module OASISString = struct
     String.iter (fun c -> Buffer.add_char buf (f c)) s;
     Buffer.contents buf
 
+  let lowercase_ascii =
+    replace_chars
+      (fun c ->
+         if (c >= 'A' && c <= 'Z') then
+           Char.chr (Char.code c + 32)
+         else
+           c)
+
+  let uncapitalize_ascii s =
+    if s <> "" then
+      (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+    else
+      s
+
+  let uppercase_ascii =
+    replace_chars
+      (fun c ->
+         if (c >= 'a' && c <= 'z') then
+           Char.chr (Char.code c - 32)
+         else
+           c)
+
+  let capitalize_ascii s =
+    if s <> "" then
+      (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
+    else
+      s
 
 end
 
@@ -315,19 +342,15 @@ module OASISUtils = struct
 
 
   let compare_csl s1 s2 =
-    String.compare (String.lowercase s1) (String.lowercase s2)
+    String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
 
 
   module HashStringCsl =
     Hashtbl.Make
       (struct
          type t = string
-
-         let equal s1 s2 =
-             (String.lowercase s1) = (String.lowercase s2)
-
-         let hash s =
-           Hashtbl.hash (String.lowercase s)
+         let equal s1 s2 = (compare_csl s1 s2) = 0
+         let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
        end)
 
   module SetStringCsl =
@@ -365,7 +388,7 @@ module OASISUtils = struct
           else
             buf
         in
-          String.lowercase buf
+          OASISString.lowercase_ascii buf
       end
 
 
@@ -471,7 +494,7 @@ module PropList = struct
         order     = Queue.create ();
         name_norm =
           (if case_insensitive then
-             String.lowercase
+             OASISString.lowercase_ascii
            else
              fun s -> s);
       }
@@ -1822,13 +1845,13 @@ module OASISUnixPath = struct
   let capitalize_file f =
     let dir = dirname f in
     let base = basename f in
-    concat dir (String.capitalize base)
+    concat dir (OASISString.capitalize_ascii base)
 
 
   let uncapitalize_file f =
     let dir = dirname f in
     let base = basename f in
-    concat dir (String.uncapitalize base)
+    concat dir (OASISString.uncapitalize_ascii base)
 
 
 end
@@ -2890,7 +2913,7 @@ module OASISFileUtil = struct
 end
 
 
-# 2893 "setup.ml"
+# 2916 "setup.ml"
 module BaseEnvLight = struct
 (* # 22 "src/base/BaseEnvLight.ml" *)
 
@@ -2995,7 +3018,7 @@ module BaseEnvLight = struct
 end
 
 
-# 2998 "setup.ml"
+# 3021 "setup.ml"
 module BaseContext = struct
 (* # 22 "src/base/BaseContext.ml" *)
 
@@ -5406,7 +5429,7 @@ module BaseSetup = struct
 end
 
 
-# 5409 "setup.ml"
+# 5432 "setup.ml"
 module InternalConfigurePlugin = struct
 (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
 
@@ -5845,8 +5868,8 @@ module InternalInstallPlugin = struct
     let make_fnames modul sufx =
       List.fold_right
         begin fun sufx accu ->
-          (String.capitalize modul ^ sufx) ::
-          (String.uncapitalize modul ^ sufx) ::
+          (OASISString.capitalize_ascii modul ^ sufx) ::
+          (OASISString.uncapitalize_ascii modul ^ sufx) ::
           accu
         end
         sufx
@@ -6270,7 +6293,7 @@ module InternalInstallPlugin = struct
 end
 
 
-# 6273 "setup.ml"
+# 6296 "setup.ml"
 module OCamlbuildCommon = struct
 (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
 
@@ -6648,7 +6671,7 @@ module OCamlbuildDocPlugin = struct
 end
 
 
-# 6651 "setup.ml"
+# 6674 "setup.ml"
 module CustomPlugin = struct
 (* # 22 "src/plugins/custom/CustomPlugin.ml" *)
 
@@ -6796,7 +6819,7 @@ module CustomPlugin = struct
 end
 
 
-# 6799 "setup.ml"
+# 6822 "setup.ml"
 open OASISTypes;;
 
 let setup_t =
@@ -6851,7 +6874,7 @@ let setup_t =
           alpha_features = ["stdfiles_markdown"; "compiled_setup_ml"];
           beta_features = [];
           name = "OcLaunch";
-          version = "0.3.0-pre2";
+          version = "0.3.0";
           license =
             OASISLicense.DEP5License
               (OASISLicense.DEP5Unit
@@ -7012,9 +7035,8 @@ let setup_t =
           plugin_data = []
        };
      oasis_fn = Some "_oasis";
-     oasis_version = "0.4.5";
-     oasis_digest =
-       Some "\174\191\233\233\167\133l\142G\192\146K\243\223\141)";
+     oasis_version = "0.4.6";
+     oasis_digest = Some "\248\223\204\171I\178C5l\005\217\254){P\"";
      oasis_exec = None;
      oasis_setup_args = [];
      setup_update = false
@@ -7022,6 +7044,6 @@ let setup_t =
 
 let setup () = BaseSetup.setup setup_t;;
 
-# 7026 "setup.ml"
+# 7048 "setup.ml"
 (* OASIS_STOP *)
 let () = setup ();;

src/add_command.ml

@@ -42,24 +42,27 @@ open Core.Std;;
 let new_list current_list position new_items =
   match position with
   | None -> List.append current_list new_items
-  | Some n -> (* If a number is given, add commands after position n by
-                 splitting the list and concatenating all. List.split_n works like this :
-               * #let l1 = [1;2;3;4;5;6] in
-               * # List.split_n l1 2;;
-               * - : int list * int list = ([1; 2], [3; 4; 5; 6]) *)
+  | Some n ->
+    (* If a number is given, add commands after position n by
+       splitting the list and concatenating all. List.split_n works like this:
+     * #let l1 = [1;2;3;4;5;6] in
+     * # List.split_n l1 2;;
+     * - : int list * int list = ([1; 2], [3; 4; 5; 6]) *)
     let l_begin,l_end = List.split_n current_list n in
     List.concat [ l_begin ; new_items ; l_end ]
 ;;
 
-
-
 (* Function which add the commands (one per line) ridden on stdin to the rc
  * file, and then display th new configuration *)
 let run ~(rc:File_com.t) position =
   (* Read command from stdin, as a list. fix_win_eol removes \r\n *)
   let cmd_list = In_channel.input_lines ~fix_win_eol:true In_channel.stdin in
   (* Create an updated rc file *)
-  let updated_rc = { rc with Settings_t.progs = (new_list rc.Settings_t.progs position cmd_list)} in
+  let updated_rc =
+    { rc with
+      Settings_t.progs = (new_list rc.Settings_t.progs position cmd_list)
+    }
+  in
   File_com.write updated_rc;
   (* Display the result *)
   let reread_rc = File_com.init_rc () in

src/clean_command.ml

@@ -37,6 +37,7 @@
 open Core.Std;;
 
 let run ~rc () =
+  (* Everything is done in background by File_com.write *)
   File_com.write rc;
   Messages.debug "Configuration file cleaned up";
 ;;

src/command_def.ml

@@ -42,7 +42,7 @@ open Command;;
 
 (* Type to return result of the work with common arguments *)
 type return_arg = {
-  rc : Settings_t.rc_file;
+  rc : Settings_t.rc_file Lazy.t;
 }
 
 (* A set of default arguments, usable with most of the commands *)
@@ -54,20 +54,31 @@ let shared_params =
          Const.verbosity := verbosity;
          (* Do not use color *)
          Const.no_color := no_color || !Const.no_color;
-         (* Use given rc file, should run the nth argument if present *)
-         Const.rc_file := (Lazy.return rc_file_name);
+         (* Use given rc file, preserving lazyness, since Const.rc_file is not
+          * yet evaluated *)
+         Const.rc_file :=
+           Option.value_map ~f:(fun rfn -> Lazy.return rfn)
+             ~default:!Const.rc_file rc_file_name
+         ;
          (* Active signal handling *)
          if handle_signal then
            Signals.handle ();
 
          (* Debugging *)
-         Messages.debug (sprintf "Verbosity set to %i" !Const.verbosity);
-         Messages.debug (sprintf "Color %s" (match !Const.no_color with true -> "off" | false -> "on"));
-         Messages.debug (sprintf "Configuration file is %s" (Lazy.force !Const.rc_file));
-         Messages.debug (sprintf "Tmp file is %s" Const.tmp_file);
+         let d = Messages.debug in
+         d (sprintf "Verbosity set to %i" !Const.verbosity);
+         d (sprintf "Color %s" (match !Const.no_color with true -> "off" | false -> "on"));
+         begin
+         match Option.try_with (fun () -> Lazy.force !Const.rc_file) with
+         | None -> d "Configuration file will fail if used";
+         | Some rc -> d (sprintf "Configuration file is %s" rc);
+         end;
+         d (sprintf "Tmp file is %s" Const.tmp_file);
 
          (* Obtain data from rc_file *)
-         let rc_content = File_com.init_rc () in
+         d "Reading rc_file...";
+         let rc_content = lazy (File_com.init_rc ()) in
+         d "Read rc_file";
          { rc = rc_content } (* We use type for futur use *)
        )
   (* Flag to set verbosity level *)
@@ -80,7 +91,7 @@ let shared_params =
         ~aliases:["-no-color"]
         ~doc:" Use this flag to disable color usage."
   (* Flag to use different rc file *)
-  <*> flag "-c" (optional_with_default (Lazy.force !Const.rc_file) file)
+  <*> flag "-c" (optional file)
         ~aliases:["--rc" ; "-rc"]
         ~doc:"file Read configuration from the given file and continue parsing."
   (* Flag to handle signals *)
@@ -113,6 +124,7 @@ let reset =
         * cmd = Some n
         * cmd: number of the command to be reseted
         * num: number to reset *)
+       let rc = Lazy.force rc in
        match ( num, cmd ) with
        | ( num, Some cmd ) -> Tmp_file.reset_cmd ~rc num cmd
        | ( num, None ) -> Tmp_file.reset2num ~rc num
@@ -138,14 +150,13 @@ let list =
     Spec.(
       empty
       +> shared_params
-    +> flag "--el" (optional int)
+    +> flag "-l" (optional int)
+    ~aliases:[ "--length" ; "-length" ; "--elength" ; "-elength" ]
          ~doc:" Max length of displayed entries, 0 keeps as-is"
   )
-  (fun { rc } length () ->
-    (* XXX A match case to deal with optionnal argument is tricky *)
-    match length with
-    | None -> List_rc.run ~rc ()
-    | Some l -> List_rc.run ~rc ~elength:l ())
+  (fun { rc } elength () ->
+    let rc = Lazy.force rc in
+    List_rc.run ~rc ?elength ())
 ;;
 
 (* To clean-up rc file *)
@@ -158,6 +169,7 @@ let clean =
       +> shared_params
     )
     (fun { rc } () ->
+      let rc = Lazy.force rc in
        Clean_command.run ~rc ()
     )
 ;;
@@ -173,6 +185,7 @@ let add =
       +> anon  (maybe ("number" %: int))
     )
     (fun { rc } num_cmd () ->
+      let rc = Lazy.force rc in
        Add_command.run ~rc num_cmd
     )
 ;;
@@ -188,6 +201,7 @@ let delete =
       +> anon (maybe ("command_number" %: int))
     )
     (fun { rc } num_cmd () ->
+      let rc = Lazy.force rc in
        (*Tmp_file.reset ~rc reset_cmd 0)*)
        Remove_command.run ~rc num_cmd)
 ;;
@@ -201,6 +215,7 @@ let state =
       +> shared_params
     )
     (fun { rc } () ->
+      let rc = Lazy.force rc in
        State.print_current ~rc ())
 ;;
 
@@ -217,6 +232,7 @@ let edit =
       +> anon (maybe ("command_number" %: int))
     )
     (fun { rc } n () ->
+      let rc = Lazy.force rc in
        let position = Option.value
                         ~default:(List.length (rc.Settings_t.progs) - 1) n
        in
@@ -250,6 +266,7 @@ let default =
       +> anon (maybe ("command_number" %: int))
     )
     (fun { rc } n () ->
+      let rc = Lazy.force rc in
        Default.run ~rc n)
 
 let run ~version ~build_info () =

src/const.ml

@@ -34,7 +34,7 @@
 (*  termes.                                                                   *)
 (******************************************************************************)
 
-(* File to stock configuration variables *)
+(* File to store configuration variables *)
 
 open Core.Std;;
 
@@ -48,7 +48,7 @@ let get_var: ?default:(string lazy_t) -> string lazy_t -> string lazy_t =
     let open Lazy in
     let msg =
       name >>| fun name ->
-      sprintf "ERROR: Couldn't get %s. Please consider setting it." name
+      sprintf "ERROR: Could not get $%s. Please consider setting it." name
     in
     (* Get the var *)
     name >>= fun name ->

src/edit_command.ml

@@ -73,7 +73,7 @@ let gen_modification items =
 ;;
 
 (* Function which get the nth element, put it in a file, let the user edit it,
- * and then remplace with the new result *)
+ * and then replace with the result *)
 let rec run ~(rc:File_com.t) position =
   (* Current list of commands *)
   let current_list = rc.Settings_t.progs in
@@ -83,26 +83,27 @@ let rec run ~(rc:File_com.t) position =
     "/tmp/oc_edit_" ;
     (Int.to_string (Random.int 100_000)) ;
     ".txt" ;
-  ] in
-  let tmp_edit = String.concat tmp_filename in
+  ]
+  |> String.concat
+  in
   (* Remove item to be edited *)
   let original_command,shorter_list =
     Remove_command.remove current_list position
   in
-  Out_channel.write_all tmp_edit original_command;
+  Out_channel.write_all tmp_filename original_command;
 
 
   (* Edit file *)
-  let edit = String.concat [ Lazy.force Const.editor ; " " ; tmp_edit ] in
+  let edit = String.concat [ Lazy.force Const.editor ; " " ; tmp_filename ] in
   Messages.debug edit;
   Sys.command edit
   |> (function
          0 -> ()
-       | n -> sprintf "Error while running %s: error code %i" edit n
-              |> Messages.warning);
+       | n -> sprintf
+         "Error while running %s: error code %i" edit n |> Messages.warning);
 
   (* Reading and applying the result *)
-  let new_commands = In_channel.read_lines tmp_edit |> epur in
+  let new_commands = In_channel.read_lines tmp_filename |> epur in
   let cmd_list = new_list shorter_list position new_commands in
   let updated_rc = { rc with Settings_t.progs = cmd_list} in
   File_com.write updated_rc;

src/exec_cmd.ml

@@ -41,22 +41,21 @@ open Core.Std;;
 let set_title new_title =
   (* Use echo command to set term  title *)
   Sys.command (sprintf "echo -en \"\\033]0;%s\\a\"" new_title)
-  |> function | 0 -> () | _ -> sprintf "Error while setting terminal title"
-                               |> Messages.warning
+  |> function
+    | 0 -> ()
+    | _ -> sprintf "Error while setting terminal title" |> Messages.warning
 ;;
 
 (* Function to return the less launched command, at least the first one *)
 (* Log is a list of entry (commands) associated with numbers *)
 let less_launched (log : (string * int) list) =
+  let open Option in
   let max = Const.default_launch in (* Number of launch, maximum *)
   (* Return smallest, n is the smaller key *)
-  let entries_by_number = List.Assoc.inverse log  in
+  let entries_by_number = List.Assoc.inverse log in
   List.min_elt ~cmp:(fun (n,_) (n',_) -> Int.compare n n') entries_by_number
-  |> (function Some (min,cmd) ->
-       if min < max
-       then Some cmd
-       else None
-             | None -> None)
+  |> fun smallest ->
+      bind smallest (fun (min, cmd) -> some_if (min < max) cmd)
 ;;
 
 (* Function to get the number corresponding to the next command to launch (less
@@ -73,10 +72,12 @@ let less_launched_num log =
          then None
          else Some ( entry_number, launch_number ))
   (* Find the less launched by sorting and taking the first *)
-  |> List.sort ~cmp:(fun ( _, launch_number1 ) ( _, launch_number2 ) -> Int.compare launch_number1 launch_number2)
+  |> List.sort
+    ~cmp:(fun ( _, launch_number1 ) ( _, launch_number2 ) ->
+      Int.compare launch_number1 launch_number2)
   |> List.hd
   |> function
-  | Some ( entry_number, launch_number) ->
+  | Some ( entry_number, launch_number ) ->
     launch_number |> sprintf "Launch number found: %i" |> Messages.debug;
     Messages.debug "Return launch number (printed bellow):";
     Some ( Tools.spy1_int entry_number )
@@ -99,7 +100,7 @@ let what_next ~tmp =
 let display_result command status =
   match status with
   | 0 -> (* No problem, do nothing *) ()
-  | _ -> (* Problem occur,  display it *)
+  | _ -> (* Problem occur, report it *)
     sprintf "Problem while running: '%s'\nExited with code: %i\n"
       command status
     |> Messages.warning

src/licencing.ml

@@ -1220,8 +1220,6 @@ let print ~cecill =
   in
 
   Messages.info "Choose your language 'Fr' or 'En': ";
-  (* XXX Be sure to show the message *)
-  Out_channel.(flush stdout);
 
   let ( warn, licence ) =
     def_lang ()
@@ -1234,6 +1232,7 @@ let print ~cecill =
     | false -> Messages.debug "Choosing warn"; warn
     | true -> Messages.debug "Choosing licence"; licence
   end
-  |> print_endline (* XXX Using print_endline to ensure we can't avoid printing
-                      with verbosity parameter *)
+  (* XXX Using print_endline, instead of a function from
+  Messages.ml to ensure we can't avoid printing with verbosity parameter *)
+  |> print_endline
 ;;

src/list_rc.ml

@@ -60,13 +60,13 @@ let truncate ?elength str =
    * - elength is not <= to the length of the indicator, otherwise the command
    * should pass untouched
    * - the command is longer than elength *)
-   if not(elength <= trunc_ind_l) && str_length > elength
+  if not(elength <= trunc_ind_l) && str_length > elength
   (* String.prefix is inclusive but incompatible with
    * 0 to keep whole string. Truncate to elength - trunc_ind_l since we add the
    * trunc_indicator (we need to cut a bit more) *)
-   then String.prefix str (elength - trunc_ind_l) |> fun short_entry ->
-        String.concat [ short_entry ; trunc_indicator ]
-   else str
+  then String.prefix str (elength - trunc_ind_l) |> fun short_entry ->
+       String.concat [ short_entry ; trunc_indicator ]
+  else str
 ;;
 
 (* Function which list, rc would be automatically reread, this optional
@@ -87,16 +87,17 @@ let run ?rc ?elength () =
   Tmp_file.get_accurate_log ~tmp ()
   (* Generate list to feed the table,
    * XXX assuming all will be in the right order *)
-  |> List.map ~f:(function
-           ( cmd, number ) ->
-           [ (* Number of a command in rc file, command, number of launch *)
-             (List.Assoc.find_exn rc_numbered cmd |> Int.to_string);
-             (* Limit length, to get better display with long command. A default
-              * length is involved when no length is specified *)
-             elength |> (function None -> truncate cmd
-                 | Some elength -> truncate ~elength cmd);
-             (Int.to_string number)
-           ])
+  |> List.map ~f:(function ( cmd, number ) ->
+         [ (* Number of a command in rc file, command, number of launch *)
+
+           (List.Assoc.find_exn rc_numbered cmd |> Int.to_string);
+
+           (* Limit length, to get better display with long command. A default
+            * length is involved when no length is specified *)
+           truncate ?elength cmd;
+
+           (Int.to_string number)
+         ])
   |> Textutils.Ascii_table.simple_list_table
        ~display:Textutils.Ascii_table.Display.column_titles
        [ "Id" ; "Command" ; "Number of launch" ]

src/messages.ml

@@ -95,7 +95,9 @@ let print ~color ~style message =
          | Underline -> underline_printf "%s" colored_msg
          | Normal -> printf "%s" colored_msg
       )
-    end
+    end;
+    (* Be sure to show the message *)
+    Out_channel.(flush stdout);
 ;;
 
 (* Behave in a conform way to verbosity
@@ -163,8 +165,6 @@ let rec confirm info =
   check_assume_yes ~f:(fun () ->
          print ~color:Cyan ~style:Normal info;
          print ~color:Cyan ~style:Normal "\n(Yes/No): ";
-         (* XXX Be sure to show the message *)
-         Out_channel.(flush stdout);
          let str_answer = In_channel.(input_line ~fix_win_eol:true stdin) in
          str_answer |> Option.map ~f:String.lowercase
          |> (function