<<>> <> <> <> DIRECTORY BasicTime, Commander, CommanderOps, Convert, FileNames, FS, IO, MessageWindow, PFS, Process, Rope, TiogaMenuOps, ViewerClasses, ViewerIO, ViewerTools; CmdTrixImpl: CEDAR PROGRAM IMPORTS BasicTime, Commander, CommanderOps, Convert, FileNames, FS, IO, MessageWindow, PFS, Process, Rope, TiogaMenuOps, ViewerIO, ViewerTools ~ BEGIN ROPE: TYPE ~ Rope.ROPE; RopeSequence: TYPE ~ RECORD [length: INTEGER ¬ 0, s: SEQUENCE max: INT OF ROPE]; <> Base: PROC [name: ROPE, includeExtension: BOOL ¬ FALSE] RETURNS [base: ROPE] ~ { fullFName: ROPE; cp: FS.ComponentPositions; dirOmitted: BOOL; [fullFName, cp, dirOmitted] ¬ FS.ExpandName[FileNames.ResolveRelativePath[name]]; base ¬ Rope.Substr[fullFName, cp.base.start, cp.base.length]; IF includeExtension AND cp.ext.length # 0 THEN base ¬ Rope.Cat[base, ".", Rope.Substr[fullFName, cp.ext.start, cp.ext.length]]; }; InSequence: PROC [rope: ROPE, ropes: REF RopeSequence] RETURNS [yes: BOOL ¬ FALSE] ~ { FOR n: NAT IN [0..ropes.length) DO IF Rope.Equal[rope, ropes[n], FALSE] THEN RETURN[TRUE]; ENDLOOP; }; LastChar: PROC [rope: ROPE, char: CHAR] RETURNS [BOOL] ~ { ropeLength: INT ¬ Rope.Length[rope]; RETURN[ropeLength > 0 AND Rope.Fetch[rope, ropeLength-1] = char]; }; ProperDirectoryName: PROC [name: ROPE] RETURNS [dir: ROPE] ~ { RopeShorten: PROC [rope: ROPE, n: INT] RETURNS [ROPE] ~ { ropeLength: INT ¬ Rope.Length[rope]; IF ropeLength >= n THEN rope ¬ Rope.Substr[rope, 0, ropeLength-n]; RETURN[rope]; }; dir ¬ name; WHILE LastChar[dir, '*] DO dir ¬ RopeShorten[dir, 1]; ENDLOOP; dir ¬ FileNames.ConvertToSlashFormat[FileNames.ResolveRelativePath[dir]]; IF NOT LastChar[dir, '/] THEN dir ¬ Rope.Concat[dir, "/"]; dir ¬ RopeShorten[FS.ExpandName[Rope.Concat[dir, "*"]].fullFName, 1]; dir ¬ FileNames.ConvertToSlashFormat[dir]; }; RopeDate: PROC [gmt: BasicTime.GMT] RETURNS [date: ROPE] ~ { u: BasicTime.Unpacked ¬ BasicTime.Unpack[gmt]; date ¬ IO.PutFLR["%g-%g-%g %g:%02g:%02g %g", LIST[ IO.int[1+ORD[u.month]], IO.int[u.day], IO.int[u.year MOD 100], IO.int[u.hour MOD 12], IO.int[u.minute], IO.int[u.second], IO.rope[IF u.hour < 12 THEN "am" ELSE "pm"]]]; }; Eq: PROC [r1, r2: ROPE] RETURNS [b: BOOL] ~ {b ¬ Rope.Equal[r1, r2, FALSE]}; GetFileNames: PROC [dir: ROPE, files: LIST OF ROPE ¬ NIL] RETURNS [names: REF RopeSequence] ~ { AddToRopes: PROC [ropes: REF RopeSequence, r: ROPE] RETURNS [REF RopeSequence] ~ { IF ropes.length = ropes.max THEN { old: REF RopeSequence ¬ ropes; ropes ¬ NEW[RopeSequence[MAX[2*old.length, 3]]]; ropes.length ¬ old.length; FOR n: NAT IN [0..old.length) DO ropes[n] ¬ old[n]; ENDLOOP; }; ropes[ropes.length] ¬ r; ropes.length ¬ ropes.length+1; RETURN[ropes]; }; EachFile: PROC [fullFName: ROPE] RETURNS [continue: BOOL ¬ TRUE] ~ { Process.CheckForAbort[]; IF LastChar[fullFName, '~] THEN RETURN; IF FS.FileInfo[fullFName].fileType = FS.tDirectory THEN RETURN; names ¬ AddToRopes[names, fullFName]; }; <> names ¬ NEW[RopeSequence[1]]; IF files = NIL THEN FS.EnumerateForNames[Rope.Concat[dir, "*"], EachFile ! FS.Error => {names ¬ NIL; CONTINUE}] ELSE FOR l: LIST OF ROPE ¬ files, l.rest WHILE l # NIL DO FS.EnumerateForNames[Rope.Concat[dir, l.first], EachFile ! FS.Error => CONTINUE]; ENDLOOP; }; <> Enumerate: PROC [pattern: ROPE, proc: PROC [name: ROPE]] RETURNS [err: ROPE ¬ NIL] ~ { Inner: PROC [fullFName: ROPE] RETURNS [continue: BOOL ¬ TRUE] ~ { once ¬ TRUE; proc[fullFName]; }; once: BOOL ¬ FALSE; FS.EnumerateForNames[pattern, Inner ! FS.Error => {err ¬ error.explanation; CONTINUE}]; IF err = NIL AND NOT once THEN err ¬ "no such files"; }; CmdTrix: Commander.CommandProc ~ { ENABLE UNWIND => NULL; OutputError: PROC [r: ROPE] ~ {IF r # NIL THEN IO.PutF1[cmd.out, "%g\n", IO.rope[r]]}; NoSwitchArg: PROC [i:INT] RETURNS [b:BOOL] ~ {b¬i {makeBelieve ¬ TRUE; RemoveArg[i]}; Eq[args[i], "-i"] => {interactive ¬ TRUE; RemoveArg[i]}; Eq[args[i], "-all"] => {all ¬ TRUE; RemoveArg[i]}; Eq[args[i], "-namesOnly"] => {namesOnly ¬ TRUE; RemoveArg[i]}; Eq[args[i], "-files"] => { RemoveArg[i]; WHILE i < nArgs DO IF Rope.Fetch[args[i]] = '- THEN EXIT; files ¬ IF files = NIL THEN LIST[args[i]] ELSE CONS[args[i], files]; RemoveArg[i]; ENDLOOP; }; ENDCASE => i ¬ i+1; ENDLOOP; i ¬ 1; WHILE i < nArgs DO argError: ERROR = CODE; NextArg: PROC RETURNS [arg: ROPE] ~ { IF i = args.argc-1 THEN ERROR argError; arg ¬ args[i ¬ i+1]; }; SELECT TRUE FROM Eq[args[i], "-undateDf"] => { EachFile: PROC [name: ROPE] ~ { in, out: IO.STREAM; base: ROPE ¬ Base[name, TRUE]; Process.CheckForAbort[]; IO.PutF1[cmd.out, "processing %g...\n", IO.rope[base]]; <> < GOTO Bad];>> in ¬ PFS.StreamOpen[ fileName: PFS.PathFromRope[name], streamOptions: [TRUE, TRUE] ! PFS.Error => GOTO Bad]; out ¬ FS.StreamOpen[name, $create]; DO line: ROPE ¬ IO.GetLineRope[in ! IO.EndOfStream => EXIT]; IF all THEN { n: INT ¬ Rope.Find[line, "."]; IF n # -1 THEN line ¬ Rope.Substr[line, 0, Rope.SkipTo[line, n, "!"]]; } ELSE { n: INT ¬ Rope.Find[line, base, 0, FALSE]; IF n # -1 THEN line ¬ Rope.Substr[line, 0, n+Rope.Length[base]]; }; IO.PutF1[out, "%g\n", IO.rope[line]]; ENDLOOP; IO.Close[out]; EXITS Bad => IO.PutF1[cmd.out, "can't open %g\n", IO.rope[name]]; }; WHILE NoSwitchArg[i+1] DO OutputError[Enumerate[NextArg[], EachFile]]; ENDLOOP; }; Eq[args[i], "-calc"] => { result: REAL ¬ 1.0; op: {divide, multiply, add, subtract} ¬ multiply; WHILE NoSwitchArg[i+1] DO arg: ROPE ¬ NextArg[]; SELECT TRUE FROM Eq[arg, "-"] => op ¬ subtract; Eq[arg, "+"] => op ¬ add; Eq[arg, "/"] => op ¬ divide; Eq[arg, "*"] => op ¬ multiply; ENDCASE => { val: REAL ¬ Convert.RealFromRope[arg ! Convert.Error => { IO.PutF1[cmd.out, "bad argument: %g\n", IO.rope[arg]]; EXIT; }]; result ¬ SELECT op FROM divide => result/val, multiply => result*val, subtract => result-val, add => result+val, ENDCASE => result; }; ENDLOOP; IO.PutF1[cmd.out, "= %g\n", IO.real[result]]; }; Eq[args[i], "-huh"] => FOR l: LIST OF ROPE ¬ MessageWindow.GetHistory[], l.rest WHILE l # NIL DO IO.PutRope[cmd.out, Rope.Concat[l.first, "\n"]]; ENDLOOP; < {>> <> <> <> <> <> <> <> <<[] ¬ CommanderOps.DoCommand[Rope.Cat["Open ", column, newArgs], cmd];>> <> <<};>> <<};>> <> <<};>> Eq[args[i], "-vuxify"] => { EachFile: PROC [name: ROPE] ~ { lastChar: CHAR ¬ Rope.Fetch[name, Rope.Length[name]-1]; Process.CheckForAbort[]; IF lastChar # '~ AND lastChar # '. THEN { Low: Rope.TranslatorType~{RETURN[IF old IN['A..'Z] THEN old-'A+'a ELSE old]}; base: ROPE ¬ Base[name, TRUE]; case: ROPE ¬ Rope.Concat[".~case~", base]; new: ROPE ¬ Rope.Concat[Rope.Translate[base,,, Low], ".~1~"]; [] ¬ CommanderOps.DoCommand[Rope.Cat["Rename ", new, " _ ", base], cmd]; [] ¬ CommanderOps.DoCommand[Rope.Concat["Echo > ", case], cmd]; }; }; WHILE NoSwitchArg[i+1] DO OutputError[Enumerate[NextArg[], EachFile]]; ENDLOOP; }; Eq[args[i], "-top"] => IF cmd.in # NIL THEN { viewer: ViewerClasses.Viewer ¬ ViewerIO.GetViewerFromStream[cmd.out]; IF viewer = NIL OR viewer.class = NIL OR viewer.class.scroll = NIL THEN RETURN; Process.Pause[Process.MsecToTicks[100]]; [] ¬ viewer.class.scroll[viewer, thumb, 100]; ViewerTools.SetSelection[viewer]; }; Eq[args[i], "-detach"] => { EachFile: PFS.InfoProc ~ { IF attachedTo # NIL THEN { command: ROPE ¬ IO.PutFR["copy -c %g _ \"%g\"", IO.rope[PFS.RopeFromPath[fullFName]], IO.rope[PFS.RopeFromPath[attachedTo]]]; [] ¬ CommanderOps.DoCommand[command, cmd]; }; }; WHILE NoSwitchArg[i+1] DO PFS.EnumerateForInfo[PFS.PathFromRope[NextArg[]], EachFile ! PFS.Error => {IO.PutF1[cmd.out, "%g\n", IO.rope[error.explanation]];CONTINUE}]; ENDLOOP; }; Eq[args[i], "-fileBase"] => IF NOT NoSwitchArg[i+1] THEN IO.PutRope[cmd.out, fileBaseUsage] ELSE IO.PutRope[cmd.out, Rope.Concat[Base[NextArg[]], "\n"]]; Eq[args[i], "-difOpen"] => IF NOT NoSwitchArg[i+1] THEN IO.PutRope[cmd.out, difOpenUsage] ELSE [] ¬ TiogaMenuOps.Open[Rope.Concat[Base[NextArg[]], ".dif"]]; Eq[args[i], "-multiRename"] => { EachFile: PROC [name: ROPE] RETURNS [continue: BOOL ¬ TRUE] ~ { oldName: ROPE ~ FileNames.GetShortName[name]; n: INT ¬ Rope.Find[oldName, oldBase, 0, FALSE]; Process.CheckForAbort[]; IF n = -1 THEN IO.PutRope[cmd.err, Rope.Concat["Error renaming ", name]] ELSE { newName: ROPE ~ Rope.Concat[newBase, Rope.Substr[oldName, n+length]]; commandLine: ROPE ~ Rope.Cat["Rename ", newName, " _ ", oldName]; IF interactive THEN { IO.PutF[cmd.err, "Rename %g to %g? (RETURN: yes, DEL: no) ", IO.rope[oldName], IO.rope[newName]]; IF IO.GetChar[cmd.in ! IO.Error, IO.Rubout => GOTO No] # '\n THEN GOTO No; }; [] ¬ CommanderOps.DoCommand[commandLine, cmd]; }; EXITS No => IO.PutRope[cmd.err, " . . . aborted\n"]; }; length: NAT; oldBase, newBase: ROPE ¬ NIL; WHILE NoSwitchArg[i+1] DO arg: ROPE ¬ NextArg[]; IF oldBase = NIL THEN oldBase ¬ arg ELSE newBase ¬ arg; ENDLOOP; length ¬ Rope.Length[oldBase]; IF Rope.IsEmpty[oldBase] OR Rope.IsEmpty[newBase] THEN IO.PutRope[cmd.out, multiRenameUsage] ELSE FS.EnumerateForNames[Rope.Concat[oldBase, "*!H"], EachFile ! FS.Error => {IO.PutRope[cmd.out, Rope.Concat[error.explanation, "\n"]]; CONTINUE}]; }; Eq[args[i], "-capitalize"] => { EachFile: PROC [name: ROPE] ~ { old: ROPE ~ FileNames.GetShortName[name]; char: CHAR ~ Rope.Fetch[old]; Process.CheckForAbort[]; IF char IN ['a..'z] THEN { new: ROPE ~ Rope.Replace[old, 0, 1, Rope.FromChar[VAL[ORD[char]+'A-'a]]]; commandLine: ROPE ~ Rope.Cat["Rename ", new, " _ ", old]; [] ¬ CommanderOps.DoCommand[commandLine, cmd]; }; }; WHILE NoSwitchArg[i+1] DO OutputError[Enumerate[NextArg[], EachFile]]; ENDLOOP; }; Eq[args[i], "-updateDirectory"] => { DoIt: PROC [mode: {copy, update}, oldDir, newDir, name: ROPE] ~ { new: ROPE ¬ Rope.Concat[newDir, name]; old: ROPE ¬ Rope.Concat[oldDir, name]; IF NOT namesOnly THEN { IO.PutF1[cmd.out, "%l", IO.rope["b"]]; IF mode = copy THEN IO.PutF1[cmd.out, "\t%g doesn't exist\n", IO.rope[old]] ELSE IO.PutFL[cmd.out, "\t%g (%g) newer than\n\t%g (%g)\n", LIST[ IO.rope[new], IO.rope[RopeDate[FS.FileInfo[new].created]], IO.rope[old], IO.rope[RopeDate[FS.FileInfo[old].created]]]]; IO.PutF1[cmd.out, "%l", IO.rope["B"]]; }; IF interactive THEN { c: CHAR; IO.PutF[cmd.err, "\t\t? copy -c %g _\n\t\t\t\t\t%g ?\n\t\t(RET: yes, DEL: no)", IO.rope[old], IO.rope[new]]; c ¬ IO.GetChar[cmd.in ! IO.Error, IO.Rubout => CONTINUE]; IF c # '\n THEN { IO.PutF[cmd.out, "%l aborted%l\n", IO.rope["i"], IO.rope["I"]]; RETURN; }; }; nChanges ¬ nChanges+1; IF makeBelieve THEN { IF namesOnly THEN { ShortDir: PROC [dir: ROPE] RETURNS [short: ROPE] ~ { len: INTEGER ¬ Rope.Length[dir]; n: INTEGER ¬ 1+Rope.FindBackward[dir, "/", MAX[0, len-2]]; short ¬ Rope.Substr[dir, n, len-n]; }; IF mode = copy THEN IO.PutF[cmd.out, "\t%g (missing in %g)\n", IO.rope[name], IO.rope[ShortDir[oldDir]]] ELSE IO.PutF[cmd.out, "\t%g (%g newer)\n", IO.rope[name], IO.rope[ShortDir[newDir]]]; } ELSE IO.PutF[cmd.out, "\t\twould copy -c %g _\n\t\t\t\t\t\t %g\n", IO.rope[old], IO.rope[new]]; } ELSE { reply: ROPE ¬ CommanderOps.DoCommandRope[ Rope.Cat["copy -c ", old, " _ ", new],, NIL].out; reply ¬ Rope.Substr[reply, Rope.SkipOver[reply,, " "]]; reply ¬ Rope.Substr[reply, 0, Rope.Length[reply]-1]; IF Rope.Find[reply, "_"] # -1 THEN reply ¬ IO.PutFR["%g\n\t\t%g", IO.rope[Rope.Substr[reply, 0, 1+Rope.Find[reply, "_"]]], IO.rope[Rope.Substr[reply, 2+Rope.Find[reply, "_"]]]]; IO.PutF1[cmd.out, "\t\t%g\n", IO.rope[reply]]; }; }; nChanges: INTEGER ¬ 0; remoteNames, localNames: REF RopeSequence; dir: ROPE ¬ ProperDirectoryName[NextArg[ ! argError => GOTO Bad]]; wdir: ROPE ¬ PFS.RopeFromPath[PFS.GetWDir[]]; IF Rope.IsEmpty[dir] THEN RETURN[$Failure, updateDirectoryUsage]; IF (remoteNames ¬ GetFileNames[dir, files]) = NIL THEN IO.PutF1[cmd.out, "Error enumerating files in %g\n", IO.rope[dir]]; IF (localNames ¬ GetFileNames[NIL, files]) = NIL THEN IO.PutRope[cmd.out, "Error enumerating files in local directory\n"]; IF remoteNames = NIL OR localNames = NIL THEN RETURN[$Failure, updateDirectoryUsage]; IF namesOnly THEN IO.PutRope[cmd.out, "Discrepancies exist for the following:\n"]; FOR n: NAT IN [0..remoteNames.length) DO remoteNames[n] ¬ FileNames.GetShortName[remoteNames[n]]; ENDLOOP; FOR n: NAT IN [0..localNames.length) DO localNames[n] ¬ FileNames.GetShortName[localNames[n]]; ENDLOOP; FOR n: NAT IN [0..remoteNames.length) DO IF InSequence[remoteNames[n], localNames] THEN { loc: ROPE ¬ Rope.Concat[wdir, remoteNames[n]]; rem: ROPE ¬ Rope.Concat[dir, remoteNames[n]]; SELECT BasicTime.Period[FS.FileInfo[loc].created, FS.FileInfo[rem].created] FROM < 0 => DoIt[update, dir, wdir, remoteNames[n]]; > 0 => DoIt[update, wdir, dir, remoteNames[n]]; ENDCASE; }; ENDLOOP; FOR n: NAT IN [0..remoteNames.length) DO local: ROPE ¬ FileNames.GetShortName[remoteNames[n]]; IF NOT InSequence[local, localNames] THEN DoIt[copy, wdir, dir, local]; ENDLOOP; FOR n: NAT IN [0..localNames.length) DO local: ROPE ¬ FileNames.GetShortName[localNames[n]]; IF NOT InSequence[local, remoteNames] THEN DoIt[copy, dir, wdir, local]; ENDLOOP; IF NOT namesOnly THEN IO.PutF[cmd.out, "\t%g change%g\n", IO.int[nChanges], IO.rope[IF nChanges = 1 THEN NIL ELSE "s"]]; }; Eq[args[i], "-noRedundantFiles"], Eq[args[i], "-noExtraneousFiles"] => { dir: ROPE ¬ ProperDirectoryName[NextArg[]]; mode: ATOM ¬ IF Rope.Find[cmd.command, "Extraneous", 0, FALSE] # -1 THEN $Extraneous ELSE $Redundant; use: ROPE ¬ IF mode = $Extraneous THEN noExtraneousUsage ELSE redundantUsage; IF NOT Rope.IsEmpty[dir] THEN { fsNames, localNames: REF RopeSequence; IF (fsNames ¬ GetFileNames[dir]) = NIL THEN IO.PutF1[cmd.out, "Error enumerating files in %g\n", IO.rope[dir]]; IF (localNames ¬ GetFileNames["*"]) = NIL THEN IO.PutRope[cmd.out, "Error enumerating files in local directory\n"]; IF fsNames # NIL AND localNames # NIL THEN { FOR n: NAT IN [0..localNames.length) DO localNames[n] ¬ FileNames.GetShortName[localNames[n]]; ENDLOOP; FOR n: NAT IN [0..fsNames.length) DO in: BOOL ¬ InSequence[FileNames.GetShortName[fsNames[n]], localNames]; IF (mode = $Extraneous AND NOT in) OR (mode = $Redundant AND in) THEN { IF interactive THEN { IO.PutF1[cmd.err,"\nDelete %g? (Return: yes, Delete: no) ", IO.rope[fsNames[n]]]; IF IO.GetChar[cmd.in ! IO.Error, IO.Rubout => LOOP] # '\n THEN LOOP; }; IF makeBelieve THEN IO.PutF1[cmd.out, "Would delete %g\n", IO.rope[fsNames[n]]] ELSE { IO.PutF1[cmd.out, "Deleting %g\n", IO.rope[fsNames[n]]]; FS.Delete[fsNames[n] ! FS.Error => CONTINUE]; }; }; ENDLOOP; }; } ELSE RETURN[$Failure, use]; }; Eq[args[i], "?"] => IO.PutRope[cmd.out, Usage[]]; ENDCASE => IO.PutF1[cmd.out, "bad argument: %g\n", IO.rope[args[i]]]; i ¬ i+1; ENDLOOP; EXITS Bad => RETURN[$Failure]; }; <> calcUsage: ROPE ~ "\t-calc <* | /> . . . \n\t\tevaluate the expression \n"; capitalizeUsage: ROPE ~ "\t-capitalize \n\t\t capitalize the first letter of all files beginning with \n"; detachUsage: ROPE ~ "\t-detach \n\t\tdetach attached files\n"; difOpenUsage: ROPE ~ "\t-dif \n\t\topen .dif\n"; fileBaseUsage: ROPE ~ "\t-fileBase \n\t\tprint base name of a file\n"; huhUsage: ROPE ~ "\t-huh\n\t\tprint the recent MessageWindow messages\n"; multiRenameUsage: ROPE ~ "\t-multiRename [-i] \t\trename the highest versions of files beginning with ; \t\t-i for interactive mode (requires confirmation per file)\n"; noExtraneousUsage: ROPE ~ "\t-noExtraneousFiles [-m] [-i] \t\tdelete any file in the given directory that is not in the working directory. \t\tonly file names need match; versions, file lengths, time stamps are not checked. \t\t-m: make believe (simply print, no delete); -i: interactive (confirm per file)\n"; <> <<"\t-open \n\t\topen the file(s) in the given column\n";>> <<>> redundantUsage: ROPE ~ "\t-noRedundantFiles [-m] [-i] \t\tdelete any file in the given directory that also exists in the working directory; \t\tonly file names need match; versions, file lengths, time stamps are not checked. \t\t-m: make believe (simply print, no delete); -i: interactive (confirm per file)\n"; topUsage: ROPE ~ "\t-top\n\t\tscroll typescript to top and set selection\n"; undateDfUsage: ROPE ~ "\t-undateDf [-all] \t\tremove self-referencing date from given df files \t\tif -all, remove all dates\n"; updateDirectoryUsage: ROPE ~ "\t-updateDirectory [-m] [-i] [-namesOnly] \t\tcopy from to files in that don't exist in or are newer. \t\tcopy from to files in that don't exist in or are newer. \t\tonly file names need match; versions and file lengths are not checked. \t\t-m: make believe (simply print, no copy); -i: interactive (confirm per file) \t\t-files to examine only those files matching \n"; vuxifyUsage: ROPE ~ "\t-vuxify \t\trename the specified files in accordance with vux \t\tdirectory convention, creating the appropriate .case files\n"; Usage: PROC RETURNS [usage: ROPE] ~ { usage ¬ "Usage: CmdTrix [-option], options include:\n"; FOR l: LIST OF ROPE ¬ LIST[ calcUsage, capitalizeUsage, detachUsage, difOpenUsage, fileBaseUsage, huhUsage, multiRenameUsage, noExtraneousUsage, <> redundantUsage, topUsage, undateDfUsage, updateDirectoryUsage, vuxifyUsage], l.rest WHILE l # NIL DO usage ¬ Rope.Concat[usage, l.first]; ENDLOOP; }; <> Commander.Register["CmdTrix", CmdTrix, Rope.Concat["\n", Usage[]]]; END.