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