1structure trailingwspace = 2struct 3 4val WSOK = ".holwsok" 5infix ++ 6val op++ = OS.Path.concat 7 8fun warn s = TextIO.output(TextIO.stdErr, s ^ "\n") 9 10datatype extra_avoid = ALL_FILES | SOME_FILES of string list 11 12fun iLine is = 13 Option.map (fn s => String.extract(s, 0, SOME (size s - 1))) 14 (TextIO.inputLine is) 15 16fun read_wsok_file dname = 17 let 18 val fname = dname ++ WSOK 19 fun read instrm = 20 let 21 fun recurse (emptyp, acc) = 22 case iLine instrm of 23 NONE => (emptyp, acc) 24 | SOME s => 25 if size s > 0 andalso String.sub(s, 0) = #"#" orelse 26 size s = 0 27 then 28 recurse (false, acc) 29 else 30 recurse (false, s::acc) 31 val (was_empty, files) = recurse (true, []) 32 in 33 if was_empty then ALL_FILES else SOME_FILES files 34 end 35 in 36 if OS.FileSys.access(fname, [OS.FileSys.A_READ]) then 37 SOME (read (TextIO.openIn fname)) 38 else NONE 39 end 40 41fun lastchar s = String.sub(s, size s - 1) 42 43datatype action = ShowLines | ShowFile | Fix 44 45fun numNONWS s = 46 let 47 val i = size s - 1 48 fun recurse i = 49 if i < 0 then 0 50 else if Char.isSpace (String.sub(s, i)) then recurse (i - 1) 51 else i + 1 52 in 53 recurse i 54 end 55fun pr s = TextIO.output(TextIO.stdOut, s ^ "\n") 56 57fun scanOneFile quietp action full_fname = 58 let 59 fun stdcont (s:string) a k = k a 60 fun fixfinish a = 61 let 62 val _ = if quietp then () else pr full_fname 63 val os = TextIO.openOut full_fname 64 in 65 app (fn s => TextIO.output(os, s)) (List.rev a); 66 TextIO.closeOut os 67 end 68 val (readAction, rdflt, finish) = 69 case action of 70 ShowLines => ((fn s => fn ln => fn a => fn k => 71 (pr (full_fname ^ ":" ^ Int.toString ln ^ ":" ^ s); 72 k a)), 73 stdcont, 74 fn a => ()) 75 | ShowFile => 76 ((fn _ => fn _ => fn a => fn _ => (pr full_fname; (true, a))), 77 stdcont, fn a => ()) 78 | Fix => ((fn s => fn ln => fn a => fn k => 79 k((String.extract(s, 0, SOME (numNONWS s))^"\n")::a)), 80 (fn s => fn a => fn k => k ((s ^ "\n")::a)), 81 fixfinish) 82 val is = TextIO.openIn full_fname 83 fun recurse seenws lnum acc act dfltact = 84 case iLine is of 85 NONE => (seenws, acc) 86 | SOME s => 87 if size s > 0 andalso Char.isSpace (lastchar s) then 88 act s lnum acc (fn acc => recurse true (lnum + 1) acc act dfltact) 89 else 90 dfltact s acc (fn acc => recurse seenws (lnum + 1) acc act dfltact) 91 val (seenws, acc) = 92 recurse false 1 [] readAction rdflt before TextIO.closeIn is 93 in 94 if seenws then (finish acc; true) else false 95 end 96 97fun mem x [] = false 98 | mem x (y::ys) = x = y orelse mem x ys 99 100fun ignorable fname = 101 let 102 val {base, ext} = OS.Path.splitBaseExt fname 103 in 104 case ext of 105 SOME s => if s = "sml" then 106 String.isSuffix "Theory" base orelse 107 String.isSuffix "ML" base 108 else if s = "sig" then String.isSuffix "Theory" base 109 else s <> "tex" andalso s <> "ML" andalso s <> "lem" andalso 110 s <> "doc" andalso s <> "bib" 111 | NONE => true 112 end 113 114fun handleDir quietp action seenws dname = 115 let 116 open OS.FileSys 117 val ds = openDir dname 118 fun recurse P seenws acc = 119 case readDir ds of 120 NONE => (closeDir ds; (seenws, acc)) 121 | SOME f0 => 122 let 123 val f = dname ++ f0 124 in 125 if isDir f then recurse P seenws (f::acc) 126 else if isLink f orelse P f orelse ignorable f then 127 recurse P seenws acc 128 else 129 let 130 val b = scanOneFile quietp action f 131 in 132 recurse P (b orelse seenws) acc 133 end 134 end 135 in 136 case read_wsok_file dname of 137 SOME ALL_FILES => 138 (if quietp then () 139 else warn ("Not checking files in "^dname^" because of "^ 140 WSOK^" file"); 141 recurse (fn _ => true) seenws []) 142 | SOME (SOME_FILES fs) => recurse (fn n => mem n fs) seenws [] 143 | NONE => recurse (fn _ => false) seenws [] 144 end 145 146fun doall quietp action seenws ds = 147 case ds of 148 [] => seenws 149 | d::ds => 150 let 151 val (seenws', newds) = handleDir quietp action seenws d 152 in 153 doall quietp action seenws' (newds @ ds) 154 end 155 156datatype cline_record = CR of { quiet : bool, action : action, help : bool} 157val init = CR {quiet = false, action = Fix, help = false} 158fun quiet_upd b (CR {action, help, ...}) = 159 CR {action = action, quiet = b, help = help} 160fun act_upd a (CR {quiet, help, ...}) = 161 CR {action = a, quiet = quiet, help = help} 162fun help_upd b (CR{quiet, action, ...}) = 163 CR {action = action, quiet = quiet, help = b} 164val NoArg = GetOpt.NoArg 165 166val cline_options = [ 167 {short = "h", long = ["help"], desc = NoArg (fn () => help_upd true), 168 help = "Show this message"}, 169 {short = "q", long = ["quiet"], desc = NoArg (fn () => quiet_upd true), 170 help = "be quieter"}, 171 {short = "n", long = [], desc = NoArg (fn () => act_upd ShowFile), 172 help = "No action; just list files (overrides -q)"}, 173 {short = "l", long = ["showlines"], desc = NoArg (fn () => act_upd ShowLines), 174 help = "No action; list files and lines"}] 175 176 177fun main () = 178 let 179 val uheader = CommandLine.name() ^ " [options] dir1 dir2 ..." 180 val uinfo = GetOpt.usageInfo {header = uheader, options = cline_options} 181 val (cline_upds, dirs) = 182 GetOpt.getOpt {argOrder = GetOpt.Permute, 183 options = cline_options, 184 errFn = warn} 185 (CommandLine.arguments()) 186 val CR {quiet, action, help} = 187 List.foldl (fn (f, acc) => f acc) init cline_upds 188 val _ = not help orelse 189 (TextIO.output(TextIO.stdOut, uinfo); 190 OS.Process.exit OS.Process.success) 191 val _ = not (null dirs) orelse 192 (warn uinfo; OS.Process.exit OS.Process.failure) 193 val seenws = doall quiet action false dirs 194 val output_actionp = case action of Fix => false | _ => true 195 val resultcode = if seenws andalso output_actionp then OS.Process.failure 196 else OS.Process.success 197 in 198 OS.Process.exit resultcode 199 end 200 201end 202