Merge pull request #757 from tleedjarv/system-win

Reduce the amount of Windows-specific code in the System module

Author: gdt

src/.depend

@@ -205,7 +205,6 @@ fileinfo.cmx : \
     fileinfo.cmi
 fileinfo.cmi : \
     ubase/umarshal.cmi \
-    system.cmi \
     props.cmi \
     ubase/prefs.cmi \
     path.cmi \
@@ -275,7 +274,6 @@ files.cmx : \
     files.cmi
 files.cmi : \
     uutil.cmi \
-    system.cmi \
     props.cmi \
     path.cmi \
     lwt/lwt_util.cmi \
@@ -338,17 +336,18 @@ fpcache.cmx : \
     fileinfo.cmx \
     fpcache.cmi
 fpcache.cmi : \
-    system.cmi \
     props.cmi \
     path.cmi \
     osx.cmi \
     os.cmi \
     fspath.cmi \
     fileinfo.cmi
 fs.cmo : \
+    system.cmi \
     fspath.cmi \
     fs.cmi
 fs.cmx : \
+    system.cmx \
     fspath.cmx \
     fs.cmi
 fs.cmi : \
@@ -431,7 +430,6 @@ fspath.cmx : \
     fspath.cmi
 fspath.cmi : \
     ubase/umarshal.cmi \
-    system.cmi \
     path.cmi \
     name.cmi
 fswatch.cmo : \
@@ -555,8 +553,7 @@ lock.cmx : \
     ubase/util.cmx \
     system.cmx \
     lock.cmi
-lock.cmi : \
-    system.cmi
+lock.cmi :
 lwt/example/editor.cmo : \
     lwt/lwt_unix.cmi
 lwt/example/editor.cmx : \
@@ -598,9 +595,11 @@ lwt/pqueue.cmx : \
     lwt/pqueue.cmi
 lwt/pqueue.cmi :
 lwt/win/lwt_unix_impl.cmo : \
+    system/system_win.cmo \
     lwt/pqueue.cmi \
     lwt/lwt.cmi
 lwt/win/lwt_unix_impl.cmx : \
+    system/system_win.cmx \
     lwt/pqueue.cmx \
     lwt/lwt.cmx
 lwt/win/lwt_win.cmo : \
@@ -711,7 +710,6 @@ osx.cmo : \
     ubase/util.cmi \
     ubase/umarshal.cmi \
     ubase/trace.cmi \
-    system.cmi \
     ubase/safelist.cmi \
     ubase/prefs.cmi \
     path.cmi \
@@ -725,7 +723,6 @@ osx.cmx : \
     ubase/util.cmx \
     ubase/umarshal.cmx \
     ubase/trace.cmx \
-    system.cmx \
     ubase/safelist.cmx \
     ubase/prefs.cmx \
     path.cmx \
@@ -868,10 +865,8 @@ remote.cmo : \
     lwt/lwt_unix.cmi \
     lwt/lwt.cmi \
     fspath.cmi \
-    fs.cmi \
     common.cmi \
     clroot.cmi \
-    case.cmi \
     bytearray.cmi \
     remote.cmi
 remote.cmx : \
@@ -888,10 +883,8 @@ remote.cmx : \
     lwt/lwt_unix.cmx \
     lwt/lwt.cmx \
     fspath.cmx \
-    fs.cmx \
     common.cmx \
     clroot.cmx \
-    case.cmx \
     bytearray.cmx \
     remote.cmi
 remote.cmi : \
@@ -998,21 +991,15 @@ system/system_intf.cmo : \
 system/system_intf.cmx : \
     ubase/umarshal.cmx
 system/system_win.cmo : \
-    unicode.cmi \
-    ubase/umarshal.cmi \
     system/system_generic.cmo \
     ubase/rx.cmi
 system/system_win.cmx : \
-    unicode.cmx \
-    ubase/umarshal.cmx \
     system/system_generic.cmx \
     ubase/rx.cmx
 system/win/system_impl.cmo : \
-    system/system_win.cmo \
-    system/system_generic.cmo
+    system/system_win.cmo
 system/win/system_impl.cmx : \
-    system/system_win.cmx \
-    system/system_generic.cmx
+    system/system_win.cmx
 terminal.cmo : \
     ubase/util.cmi \
     system.cmi \
@@ -1174,8 +1161,7 @@ ubase/prefs.cmx : \
     ubase/prefs.cmi
 ubase/prefs.cmi : \
     ubase/util.cmi \
-    ubase/umarshal.cmi \
-    system.cmi
+    ubase/umarshal.cmi
 ubase/projectInfo.cmo :
 ubase/projectInfo.cmx :
 ubase/proplist.cmo : \
@@ -1241,8 +1227,7 @@ ubase/util.cmx : \
     ubase/safelist.cmx \
     ubase/projectInfo.cmx \
     ubase/util.cmi
-ubase/util.cmi : \
-    system.cmi
+ubase/util.cmi :
 ui.cmi :
 uicommon.cmo : \
     xferhint.cmi \

src/Makefile.OCaml

@@ -219,7 +219,7 @@ OCAMLOBJS += \
           ubase/rx.cmo \
 	  \
           unicode_tables.cmo unicode.cmo bytearray.cmo \
-          $(WINOBJS) system/system_generic.cmo \
+          system/system_generic.cmo $(WINOBJS) \
           system/$(SYSTEM)/system_impl.cmo \
           system.cmo \
           \

src/case.ml

@@ -48,10 +48,11 @@ let unicode =
     "When set to {\\tt true}, this flag causes Unison to perform \
      case insensitive file comparisons assuming Unicode encoding.  \
      This is the default.  When the flag is set to {\\tt false}, \
-     a Latin 1 encoding is assumed.  When Unison runs in case sensitive \
-     mode, this flag only makes a difference if one host is running \
-     Windows or Mac OS X.  Under Windows, the flag selects between using \
-     the Unicode or 8bit Windows API for accessing the filesystem. \
+     Latin 1 encoding is assumed (this means that all bytes that are \
+     not letters in Latin 1 encoding will be compared byte-for-byte, \
+     even if they may be valid characters in some other encoding).  \
+     When Unison runs in case sensitive mode, this flag only makes \
+     a difference if one host is running Mac OS X.  \
      Under Mac OS X, it selects whether comparing the filenames up to \
      decomposition, or byte-for-byte."
 
@@ -64,8 +65,6 @@ let useUnicode () =
   let pref = Prefs.read unicode in
   pref = `True || pref = `Default
 
-let useUnicodeAPI = useUnicode
-
 let unicodeCaseSensitive =
   Prefs.createBool "unicodeCS" false
     ~category:(`Internal `Pseudo)

src/case.mli

@@ -3,7 +3,6 @@
 
 val caseInsensitiveMode : [`True|`False|`Default] Prefs.t
 val unicodeEncoding : bool Prefs.t
-val useUnicodeAPI : unit -> bool
 
 type mode = Sensitive | Insensitive | UnicodeSensitive | UnicodeInsensitive
 

src/fileinfo.mli

@@ -17,7 +17,7 @@ val get : bool (* fromRoot *) -> Fspath.t -> Path.local -> t
 val set : Fspath.t -> Path.local ->
           [`Set of Props.t | `Copy of Path.local | `Update of Props.t] ->
           Props.t -> unit
-val get' : System.fspath -> t
+val get' : string -> t
 
 (* IF THIS CHANGES, MAKE SURE TO INCREMENT THE ARCHIVE VERSION NUMBER!       *)
 type stamp251 =

src/files.ml

@@ -51,9 +51,9 @@ let clearCommitLog tmpName =
 
   let commitLogNameWin () =
     (* Work around an issue in Windows where unlink may not be immediate. *)
-    let p = System.fspathAddSuffixToFinalName commitLogName (Filename.basename (Path.toString tmpName)) in
+    let p = commitLogName ^ (Filename.basename (Path.toString tmpName)) in
     let rec tmp n =
-      let p = System.fspathAddSuffixToFinalName p (string_of_int n) in
+      let p = p ^ (string_of_int n) in
       if System.file_exists p then tmp (n + 1)
       else (System.rename commitLogName p; p)
     in
@@ -74,7 +74,7 @@ let processCommitLog () =
             "Warning: the previous run of %s terminated in a dangerous state.
             Please consult the file %s, delete it, and try again."
                 Uutil.myName
-                (System.fspathToPrintString commitLogName)))
+                commitLogName))
   end else
     Lwt.return ()
 

src/files.mli

@@ -68,7 +68,7 @@ val diff :
 val processCommitLogs : unit -> unit
 
 (* List the files in a directory matching a pattern. *)
-val ls : System.fspath -> string -> string list
+val ls : string -> string -> string list
 
 val merge :
      Common.root                  (* first root *)

src/fpcache.mli

@@ -2,7 +2,7 @@
 (* Copyright 1999-2020, Benjamin C. Pierce (see COPYING for details) *)
 
 (* Initialize the cache *)
-val init : bool -> bool -> System.fspath -> unit
+val init : bool -> bool -> string -> unit
 
 (* Close the cache file and clear the in-memory cache *)
 val finish : unit -> unit

src/fs.ml

@@ -15,48 +15,50 @@
     along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)
 
-module System = System_impl.Fs
-
 type fspath = Fspath.t
 let mfspath = Fspath.m
 type dir_handle = System.dir_handle
                 = { readdir : unit -> string; closedir : unit -> unit }
 
-let symlink l f = System.symlink l (Fspath.toString f)
+let path p = Fspath.toString p |> System.extendedPath
+
+(****)
 
-let readlink f = System.readlink (Fspath.toString f)
+let symlink l f = System.symlink l (path f)
 
-let chown f usr grp = System.chown (Fspath.toString f) usr grp
+let readlink f = System.readlink (path f)
 
-let chmod f mode = System.chmod (Fspath.toString f) mode
+let chown f usr grp = System.chown (path f) usr grp
 
-let utimes f t1 t2 = System.utimes (Fspath.toString f) t1 t2
+let chmod f mode = System.chmod (path f) mode
 
-let unlink f = System.unlink (Fspath.toString f)
+let utimes f t1 t2 = System.utimes (path f) t1 t2
 
-let rmdir f = System.rmdir (Fspath.toString f)
+let unlink f = System.unlink (path f)
 
-let mkdir f mode = System.mkdir (Fspath.toString f) mode
+let rmdir f = System.rmdir (path f)
 
-let rename f f' = System.rename (Fspath.toString f) (Fspath.toString f')
+let mkdir f mode = System.mkdir (path f) mode
 
-let stat f = System.stat (Fspath.toString f)
+let rename f f' = System.rename (path f) (path f')
 
-let lstat f = System.lstat (Fspath.toString f)
+let stat f = System.stat (path f)
 
-let openfile f flags perms = System.openfile (Fspath.toString f) flags perms
+let lstat f = System.lstat (path f)
 
-let opendir f = System.opendir (Fspath.toString f)
+let openfile f flags perms = System.openfile (path f) flags perms
+
+let opendir f = System.opendir (path f)
 
 let open_in_gen flags mode f =
-  System.open_in_gen flags mode (Fspath.toString f)
+  System.open_in_gen flags mode (path f)
 
 let open_out_gen flags mode f =
-  System.open_out_gen flags mode (Fspath.toString f)
+  System.open_out_gen flags mode (path f)
 
 (****)
 
-let open_in_bin f = open_in_gen [Open_rdonly; Open_binary] 0 f
+let open_in_bin f = System.open_in_bin (path f)
 
 let file_exists f =
   try
@@ -66,11 +68,8 @@ let file_exists f =
 
 (****)
 
-let fingerprint f = System.fingerprint (Fspath.toString f)
+let fingerprint f = System.fingerprint (path f)
 
-let canSetTime f = System.canSetTime (Fspath.toString f)
 let hasInodeNumbers () = System.hasInodeNumbers ()
 let hasSymlink () = System.hasSymlink ()
 let hasCorrectCTime = System.hasCorrectCTime
-
-let setUnicodeEncoding = System.setUnicodeEncoding

src/fs.mli

@@ -4,5 +4,3 @@
 (* Operations on fspaths *)
 
 include System_intf.Core with type fspath = Fspath.t
-
-val setUnicodeEncoding : bool -> unit

src/fsmonitor/windows/watcher.ml

@@ -88,7 +88,7 @@ let get_win_path root dir ((ev_path, act) as ev) =
   let p = if event_kind ev = `DEL then None else
     follow_win_path dir (Lwt_win.longpathname root ev_path) 0 in
   match p with
-  | Some _ as pathnm -> (pathnm, ev)
+  | Some _ -> (p, ev)
   | None ->
     (* If path is not found or event is a deletion then look up the
        parent directory and report a modification on it. It is not
@@ -110,21 +110,11 @@ let flags =
 let watch_root_directory path dir =
   let h = Lwt_win.open_directory path in
   let path = Lwt_win.longpathname "" path in
-  let path =
-    if String.sub path 0 4 = "\\\\?\\" then begin
-      let n = String.sub path 4 (String.length path - 4) in
-      if String.sub n 0 3 = "UNC" then
-        "\\" ^ String.sub n 3 (String.length n - 3)
-      else
-        n
-    end else
-      path
-  in
   let rec loop () =
     Lwt_win.readdirectorychanges h true flags >>= fun l ->
     let time = Unix.gettimeofday () in
     List.iter
-      (fun ((ev_path, _) as ev) ->
+      (fun ev ->
          if !previous_event <> Some ev then begin
            previous_event := Some ev;
            if !Watchercommon.debug then print_event ev;