plotgitsch: introduce --relative option

fix #50

Author: jnavila

plotkicadsch/src/gitFs.ml

@@ -4,7 +4,7 @@ open DiffFs
 exception InternalGitError of string
 exception PathNotFound of string list
 
-let make commitish =
+let make commitish relative_path =
   ( module struct
     open Git_unix
     module Search = Git.Search.Make (Digestif.SHA1) (Store)
@@ -26,7 +26,9 @@ let make commitish =
         try%lwt
           let%lwt _ = Lwt_unix.stat new_gitdir in
           (* that's a git repo and d is the root *)
-          Lwt.return (d, b)
+          Lwt.return (match relative_path with
+          | None -> (d, b)
+          | Some p -> (d, String.split_on_char ~sep:'/' p))
         with
         | UnixLabels.Unix_error (UnixLabels.ENOENT, _, _) ->
           let new_d = dirname d in

plotkicadsch/src/kicadDiff.ml

@@ -13,9 +13,10 @@ let true_fs rootname = TrueFS rootname
 
 type differ = Internal of string | Image_Diff
 
-let fs_mod = function
-  | GitFS r -> GitFs.make r
-  | TrueFS r -> TrueFs.make r
+let fs_mod s r =
+  match s with
+  | GitFS s -> GitFs.make s r
+  | TrueFS s -> TrueFs.make s r
 
 let is_suffix ~suffix s =
   let suff_length = String.length suffix in
@@ -101,7 +102,7 @@ let diff_cmd f t filename =
     , [| fc ^ Filename.dir_sep ^ filename
        ; tc ^ Filename.dir_sep ^ filename |] )
 
-let doit from_fs to_fs file_to_diff differ textdiff libs keep colors zone_color allow_missing_component =
+let doit from_fs to_fs file_to_diff differ textdiff libs keep colors zone_color allow_missing_component relative_path =
   let module_d =
     match differ with
     | Image_Diff ->
@@ -110,8 +111,8 @@ let doit from_fs to_fs file_to_diff differ textdiff libs keep colors zone_color
       InternalDiff.internal_diff s colors zone_color
   in
   let module D = (val module_d : Differ) in
-  let module F = (val (fs_mod from_fs) : Simple_FS) in
-  let module T = (val (fs_mod to_fs) : Simple_FS) in
+  let module F = (val (fs_mod from_fs relative_path) : Simple_FS) in
+  let module T = (val (fs_mod to_fs relative_path) : Simple_FS) in
   let module FromP = FSPainter (D.S) (F) in
   let module ToP = FSPainter (D.S) (T) in
   let file_list =
@@ -147,7 +148,7 @@ let doit from_fs to_fs file_to_diff differ textdiff libs keep colors zone_color
   let catch_errors =
     Lwt.catch
       (fun _ ->
-         Lwt_io.printf "%s between %s and %s\n" D.doc (doc from_fs) (doc to_fs)
+         Lwt_io.printf "%s between %s and %s\n" D.doc (doc F.label) (doc T.label)
          >>= fun _ -> compare_all )
       (function
         | GitFs.InternalGitError s ->

plotkicadsch/src/kicadDiff.mli

@@ -16,11 +16,11 @@ val true_fs: string -> t
 (** [doc fs] outputs the doc string of the file system [fs] *)
 val doc: t -> string
 
-(** [doit fs_from fs_to filename differ textdiff libs keep colors allow_missing]
-    performs the diff of [filename] between [fs_from] and [fs_to]
+(** [doit fs_from fs_to filename differ textdiff libs keep colors allow_missing relative_path]
+    performs the diff of [filename] from [relative_path] if present between [fs_from] and [fs_to]
     using strategy [differ] and using common [libs] and [colors]
     scheme. If [textdiff], then a text diff is shown when no visual
     diff, if [keep] then the diff file isn't removed after *)
 val doit: t -> t -> string option ->
   differ -> bool -> string list -> bool ->
-  SvgPainter.diff_colors option -> string option -> bool -> unit
+  SvgPainter.diff_colors option -> string option -> bool -> string option -> unit

plotkicadsch/src/plotgitsch.ml

@@ -158,10 +158,16 @@ let zone_color =
   let env = Arg.env_var ~doc:"Color for plotting frames around changes" "PLOTGITSCH_CHANGE_COLOR" in
   Arg.(value & opt get_zone_color None & info ["z"; "zone"] ~env ~doc ~docv)
 
+let relative_path =
+  let doc =
+    "force relative path to git working tree root. Detected automatically from current dir by default" in
+  let docv = "path" in
+  Arg.(value & opt (some string) None & info ["r"; "relative"] ~doc ~docv)
+
 let plotgitsch_t =
   Term.(
     const doit $ from_ref $ to_ref $ diff_of_file $ internal_diff
-    $ textual_diff $ preloaded_libs $ keep_files $ colors $ zone_color $ continue_on_missing_component)
+    $ textual_diff $ preloaded_libs $ keep_files $ colors $ zone_color $ continue_on_missing_component $ relative_path)
 
 let info =
   let doc =

plotkicadsch/src/trueFs.ml

@@ -2,11 +2,9 @@ open StdLabels
 open Lwt.Infix
 open DiffFs
 
-let make rootname =
+let make rootname relative =
   ( module struct
 
-    let label = TrueFS rootname
-
     let lstrip c s =
       let rec find_non_c c s n =
         if s.[n] != c then
@@ -16,14 +14,18 @@ let make rootname =
       in
       find_non_c c s 0
 
-    let rootname = lstrip '/' rootname
+    let rootname = (lstrip '/' rootname) ^ (match relative with
+        | None -> ""
+        | Some p -> "/" ^ (lstrip '/' p))
+
+    let label = TrueFS rootname
+
     let rootlength = (String.length rootname) + 1
 
     let get_content filename =
+      let filepath = (String.concat ~sep:Filename.dir_sep (rootname::filename)) in
       try%lwt
-        Lwt_io.with_file ~mode:Lwt_io.input
-          (String.concat ~sep:Filename.dir_sep filename)
-          Lwt_io.read
+        Lwt_io.with_file ~mode:Lwt_io.input  filepath Lwt_io.read
       with
         _ -> Lwt.return ""