Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * Copyright (C) 1997-2000 NEC Research Institute. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | structure System: SYSTEM = | |
10 | struct | |
11 | fun insertBackslashes (ss: string list, | |
12 | width: int, | |
13 | indent: int): string list = | |
14 | let | |
15 | val indentation = String.make (indent, #" ") | |
16 | fun loop (ss, pos, line, lines) = | |
17 | (* pos + 2 < width (so the backslash can be inserted) *) | |
18 | case ss of | |
19 | [] => rev (concat (rev line) :: lines) | |
20 | | s :: ss => | |
21 | let | |
22 | val n = String.size s | |
23 | val (pos, line') = | |
24 | case line of | |
25 | [] => (pos + n, [s]) | |
26 | | _ => (pos + n + 1, s :: " " :: line) | |
27 | fun newLine () = | |
28 | loop (ss, indent + n, [s, indentation], | |
29 | concat (rev (" \\" :: line)) :: lines) | |
30 | in | |
31 | if pos <= width | |
32 | then | |
33 | case ss of | |
34 | [] => rev (concat (rev line') :: lines) | |
35 | | _ => | |
36 | if pos + 2 <= width | |
37 | then loop (ss, pos, line', lines) | |
38 | else newLine () | |
39 | else newLine () | |
40 | end | |
41 | in loop (ss, 0, [], []) | |
42 | end | |
43 | ||
44 | fun system (com: string, args: string list): unit = | |
45 | let | |
46 | (* Many terminal emulators do the line folding one character early, | |
47 | * so we use 79 instead of 80 columns. | |
48 | *) | |
49 | val width = 79 | |
50 | val indentAmount = 4 | |
51 | val s = concat (List.separate (com :: args, " ")) | |
52 | val _ = | |
53 | let | |
54 | open Control | |
55 | in | |
56 | message (Top, fn () => | |
57 | Layout.align | |
58 | (List.map (insertBackslashes | |
59 | (com :: args, | |
60 | width - getDepth (), | |
61 | indentAmount), | |
62 | Layout.str))) | |
63 | end | |
64 | in | |
65 | Process.wait (MLton.Process.spawnp {file = com, args = com :: args}) | |
66 | handle e => Error.bug (concat ["call to system failed with ", | |
67 | Exn.toString e, ":\n", s]) | |
68 | end | |
69 | end |