1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
|
(* Unison file synchronizer: src/sortri.ml *)
(* Copyright 1999-2009, Benjamin C. Pierce
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
open Common
let dbgsort = Util.debug "sort"
(* Preferences *)
let bysize =
Prefs.createBool "sortbysize" false
"!list changed files by size, not name"
("When this flag is set, the user interface will list changed files "
^ "by size (smallest first) rather than by name. This is useful, for "
^ "example, for synchronizing over slow links, since it puts very "
^ "large files at the end of the list where they will not prevent "
^ "smaller files from being transferred quickly.\n\n"
^ "This preference (as well as the other sorting flags, but not the "
^ "sorting preferences that require patterns as arguments) can be "
^ "set interactively and temporarily using the 'Sort' menu in the "
^ "graphical user interface.")
let newfirst =
Prefs.createBool "sortnewfirst" false
"!list new before changed files"
("When this flag is set, the user interface will list newly created "
^ "files before all others. This is useful, for example, for checking "
^ "that newly created files are not `junk', i.e., ones that should be "
^ "ignored or deleted rather than synchronized.")
let sortfirst = Pred.create "sortfirst" ~advanced:true
("Each argument to \\texttt{sortfirst} is a pattern \\ARG{pathspec}, "
^ "which describes a set of paths. "
^ "Files matching any of these patterns will be listed first in the "
^ "user interface. "
^ "The syntax of \\ARG{pathspec} is "
^ "described in \\sectionref{pathspec}{Path Specification}.")
let sortlast = Pred.create "sortlast" ~advanced:true
("Similar to \\verb|sortfirst|, except that files matching one of these "
^ "patterns will be listed at the very end.")
type savedPrefs = {nf:bool; bs:bool; sf:string list; sl:string list}
let savedPrefs = ref(None)
let saveSortingPrefs () =
if !savedPrefs = None then
savedPrefs := Some {
sf = Pred.extern sortfirst;
sl = Pred.extern sortlast;
bs = Prefs.read bysize;
nf = Prefs.read newfirst }
let restoreDefaultSettings () =
match !savedPrefs with
None -> ()
| Some {nf=nf; bs=bs; sf=sf; sl=sl} ->
Prefs.set newfirst nf;
Prefs.set bysize bs;
Pred.intern sortfirst sf;
Pred.intern sortlast sl
let zeroSortingPrefs () =
Prefs.set newfirst false;
Prefs.set bysize false;
Pred.intern sortfirst [];
Pred.intern sortlast []
(* ------------------- *)
let sortByName () =
saveSortingPrefs();
zeroSortingPrefs()
let sortBySize () =
saveSortingPrefs();
zeroSortingPrefs();
Prefs.set bysize true
let sortNewFirst () =
saveSortingPrefs();
Prefs.set newfirst (not (Prefs.read newfirst))
(* ---------------------------------------------------------------------- *)
(* Main sorting functions *)
let shouldSortFirst ri =
Pred.test sortfirst (Path.toString ri.path)
let shouldSortLast ri =
Pred.test sortlast (Path.toString ri.path)
let newItem ri =
let newItem1 ri =
match ri.replicas with
Different((_, `Created, _, _), _, _, _) -> true
| _ -> false in
let newItem2 ri =
match ri.replicas with
Different(_, (_, `Created, _, _), _, _) -> true
| _ -> false
in newItem1 ri || newItem2 ri
(* Should these go somewhere else? *)
let rec combineCmp = function
[] -> 0
| c::cs -> if c<>0 then c else combineCmp cs
let invertCmp c = c * -1
let compareReconItems () =
let newfirst = Prefs.read newfirst in
fun ri1 ri2 ->
let pred p =
let b1 = p ri1 in let b2 = p ri2 in
if b1 && b2 then 0 else if b1 then -1 else if b2 then 1 else 0 in
let cmp =
combineCmp [
pred problematic;
pred shouldSortFirst;
invertCmp (pred shouldSortLast);
if newfirst then pred newItem else 0;
(if Prefs.read bysize then
let l1 = Common.riLength ri1 in
let l2 = Common.riLength ri2 in
if l1<l2 then -1 else if l2<l1 then 1 else 0
else 0);
(compare (Path.toString ri1.path) (Path.toString ri2.path))
] in
dbgsort (fun() -> Util.msg "%s <= %s --> %d\n"
(Path.toString ri1.path) (Path.toString ri2.path) cmp);
cmp
let sortReconItems items = Safelist.stable_sort (compareReconItems()) items
|