<> <> <> <> <> <<>> DIRECTORY BasicTime USING [Now], Commander USING [CommandProc, Register], CommandTool USING [ArgumentVector, Failed, Parse], EditSpan USING [Copy], FS USING [defaultStreamOptions, Error, FileInfo, StreamOpen, StreamOptions], IO USING [Close, EndOfStream, GetCedarToken, GetCedarTokenRope, GetChar, GetIndex, GetLine, noWhereStream, PeekChar, Put, PutChar, PutF, PutRope, SetIndex, SkipWhitespace, STREAM, TokenKind], NodeProps USING [PutProp], Process USING [CheckForAbort], PutGet USING [FromFile], RefText USING [AppendChar, Equal, TrustTextAsRope], Rope USING [Cat, Concat, Equal, Fetch, Find, Flatten, FromChar, FromRefText, Length, Match, ROPE, Substr], SymTab USING [Create, EachPairAction, Fetch, FetchText, Insert, Pairs, Ref], TextNode USING [LastWithin, Level, MakeNodeLoc, MakeNodeSpan, NodeRope, Ref, StepForward], TiogaFileOps USING [AddLooks, CreateRoot, InsertAsLastChild, Ref, SetContents, Store]; Waterlily: CEDAR PROGRAM IMPORTS BasicTime, Commander, CommandTool, EditSpan, FS, IO, NodeProps, Process, PutGet, RefText, Rope, SymTab, TextNode, TiogaFileOps = { ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; SymbolTableEntry: TYPE = REF SymbolTableEntryRep; SymbolTableEntryRep: TYPE = RECORD[ oldList: InstanceList, -- the old instances newList: InstanceList, -- the new instances rope: Rope.ROPE_NIL, -- the line (or token) itself key: Rope.ROPE -- the key used for the lookup ]; InstanceList: TYPE = LIST OF InstanceRep; InstanceRep: TYPE = RECORD [ line: INT, -- -1 => not yet assigned position: INT, -- -1 => not yet assigned (node number if mergeFiles) node: TextNode.Ref_NIL, -- the node, if mergeFiles, instead of line peek: CHAR -- non-blank character after this token ]; FileArray: TYPE = REF FileArrayRep; FileArrayRep: TYPE = RECORD [entry: SEQUENCE index: NAT OF FileArrayEntry]; FileArrayEntry: TYPE = REF FileArrayEntryRep; FileArrayEntryRep: TYPE = RECORD [ symTableKey: SymbolTableEntry, posInThisFile: INT, lineNumInOtherFile: INT, node: TextNode.Ref_NIL, typeOfPntr: {symTable, lineNum}]; Ref: TYPE = TextNode.Ref; Node: TYPE = REF NodeBody; NodeBody: TYPE = RECORD [root: Ref_NIL, node: Ref_NIL ]; LongHelpMsgW: ROPE = "Waterlily compares two source files. The command format is one of: Waterlily file1 file2 Waterlily difFile _ file1 file2 where switches are syntactically before any argument. Differences found are written on the difFile, with default extension '.dif'. The available switches are: t Tioga format files (comments & formatting not seen) b Bravo format files (formatting not seen) u Unformatted files i Ignore blank lines (default: TRUE) x Output file is a merger of input files (ran out of mnemonics already!) Input files must be Tioga-format files. #m # of matching lines (default: 3) #c # of trailing context lines (default: 1) "; LongHelpMsgC: ROPE = "CedarLily compares two Cedar-program source files. Comparison is made at the source-language token level, so that only lexical differences will be found (formatting changes and modified comments will not affect the comparison). The command format is one of: CedarLily file1 file2 CedarLily difFile _ file1 file2 where switches are syntactically before any argument. Differences found are written on the difFile, with default extension '.dif'. The available switches are: u Unformatted files i Ignore blank lines (default: TRUE) #m # of matching lines (default: 3) #c # of trailing context lines (default: 1) "; LongHelpMsgM: ROPE = "Tigerlily produces a merged version of two Tioga-format files. Nodes unique to file1 are included and indicated by overstriking. Nodes unique to file2 are included and indicated by underlining. Nodes that are common to both files are unchanged. The command format is one of: Tigerlily file1 file2 Tigerlily mergedFile _ file1 file2 where switches are syntactically before any argument. The merged file is written on the mergedFile, with default extension '.merger'. The available switches are: #m # of matching lines (default: 3) #c # of trailing context lines (default: 1) "; repeats: NAT _ 1; <> debugging: BOOL _ FALSE; <> WaterlilyProc: Commander.CommandProc = { <> Alarm: ERROR = CODE; oldArray: FileArray; newArray: FileArray; out: STREAM _ cmd.out; pData: REF _ cmd.procData.clientData; totalLinesInNewFile: INT _ 0; totalLinesInOldFile: INT _ 0; posInNewFile: INT _ 0; posInOldFile: INT _ 0; nodeCount: INT _ 0; newFile: REF; -- IO.STREAM or Node; oldFile: REF; -- IO.STREAM or Node; difFile: STREAM; difFileNode: Node_NIL; newFileName: ROPE _ NIL; oldFileName: ROPE _ NIL; difFileName: ROPE _ NIL; Asterisks: ROPE = "**************************************"; filler: ROPE = "->->->->->->"; <> FileType: TYPE = {tioga, bravo, unform}; switchNewFileType, switchOldFileType: FileType _ tioga; switchIgnoreEmptyLinesNewFile, switchIgnoreEmptyLinesOldFile: BOOL _ TRUE; switchTokens: BOOL _ FALSE; switchMergeFiles: BOOL_FALSE; <> switchLinesForMatch: INTEGER _ 3; switchLinesForContext: INTEGER _ 1; anyDifferencesSeen: BOOL _ FALSE; indexN: INT; indexO: INT; LineType: TYPE = { new, old, both }; Vintage: TYPE = LineType[new..old]; SetSymbolTableEntry: PROC [key, line: ROPE, node: TextNode.Ref, newOrOld: Vintage, lineNum: INT, pos: INT, peek: CHAR] = { symTabEntry: SymbolTableEntry _ NIL; list: InstanceList _ LIST[[lineNum, pos, node, peek]]; WITH SymTab.Fetch[symbolTable, key].val SELECT FROM x: SymbolTableEntry => symTabEntry _ x; ENDCASE => { symTabEntry _ NEW[SymbolTableEntryRep _ [ oldList: NIL, newList: NIL, rope: line, key: key]]; [] _ SymTab.Insert[symbolTable, key, symTabEntry]; }; SELECT newOrOld FROM new => { list.rest _ symTabEntry.newList; symTabEntry.newList _ list; }; old => { list.rest _ symTabEntry.oldList; symTabEntry.oldList _ list; }; ENDCASE => ERROR; }; PruneList: PROC [list: InstanceList, pos: INT] RETURNS [pruned: InstanceList] = { IF list = NIL THEN RETURN [NIL]; IF list.first.position = pos THEN RETURN [list.rest]; pruned _ list; DO lag: InstanceList _ list; list _ list.rest; IF list = NIL THEN RETURN; IF list.first.position = pos THEN {lag.rest _ list.rest; RETURN}; ENDLOOP; }; ConnectEntries: PROC [symTabEntry: SymbolTableEntry, indexO, indexN: INT, entryO, entryN: FileArrayEntry] = { entryN.typeOfPntr _ entryO.typeOfPntr _ lineNum; entryN.lineNumInOtherFile _ indexO; entryO.lineNumInOtherFile _ indexN; symTabEntry.newList _ PruneList[symTabEntry.newList, entryN.posInThisFile]; symTabEntry.oldList _ PruneList[symTabEntry.oldList, entryO.posInThisFile]; }; EndOfFile: ERROR = CODE; buffer: REF TEXT _ NEW[TEXT[128]]; ReadLineFromFile: PROC [source: REF, localSwitchFileType: FileType, localSwitchIgnoreEmpties: BOOL] RETURNS [key, line: ROPE_NIL, node: TextNode.Ref_NIL, peek: CHAR, pos: INT] = { token: REF TEXT _ NIL; in: STREAM; inNode: Node; WITH source SELECT FROM str: STREAM => in _ str; ref: Node => inNode _ ref; ENDCASE => ERROR; peek _ 0C; DO index: INT; Process.CheckForAbort[]; SELECT pData FROM $Cedar => { kind: IO.TokenKind; char: CHAR; buffer.length _ 0; line _ NIL; [tokenKind: kind, token: token, charsSkipped: ] _ IO.GetCedarToken[in, buffer ! IO.EndOfStream => ERROR EndOfFile]; [] _ IO.SkipWhitespace[stream: in, flushComments: TRUE ! IO.EndOfStream => CONTINUE]; peek _ IO.PeekChar[in ! IO.EndOfStream => CONTINUE]; IF kind = tokenEOF THEN ERROR EndOfFile; pos _ in.GetIndex[] - token.length; <> char _ token[0]; IF token.length = 1 THEN { SELECT char FROM '; => LOOP; <> ', => line _ ","; ': => line _ ":"; '. => line _ "."; '_ => line _ "_"; '! => line _ "!"; '= => line _ "="; '# => line _ "#"; '< => line _ "<"; '> => line _ ">"; '[ => line _ "["; '] => line _ "]"; '{ => line _ "{"; '} => line _ "}"; '- => line _ "-"; '+ => line _ "+"; '$ => line _ "$"; '^ => line _ "^"; '0 => line _ "0"; '1 => line _ "1"; '2 => line _ "2"; '3 => line _ "3"; ENDCASE; } ELSE SELECT char FROM 'B => SELECT TRUE FROM RefText.Equal[token, "BEGIN"] => line _ "{"; RefText.Equal[token, "BOOLEAN"], RefText.Equal[token, "BOOL"] => line _ "BOOL"; ENDCASE; 'C => SELECT TRUE FROM RefText.Equal[token, "CHARACTER"], RefText.Equal[token, "CHAR"] => line _ "CHAR"; ENDCASE; 'E => SELECT TRUE FROM RefText.Equal[token, "END"] => {line _ "}"; char _ '} }; RefText.Equal[token, "ELSE"] => line _ "ELSE"; ENDCASE; 'I => SELECT TRUE FROM RefText.Equal[token, "IF"] => line _ "IF"; ENDCASE; 'L => SELECT TRUE FROM RefText.Equal[token, "LONG"] => { line _ IO.GetCedarTokenRope[in].token; SELECT TRUE FROM Rope.Equal[line, "CARDINAL"] => line _ "CARD"; Rope.Equal[line, "INTEGER"] => line _ "INT"; ENDCASE => line _ Rope.Concat["LONG ", line]; }; ENDCASE; 'N => SELECT TRUE FROM RefText.Equal[token, "NIL"] => line _ "NIL"; RefText.Equal[token, "NOT"] => line _ "NOT"; RefText.Equal[token, "NEW"] => line _ "NEW"; ENDCASE; 'P => SELECT TRUE FROM RefText.Equal[token, "PROCEDURE"], RefText.Equal[token, "PROC"] => line _ "PROC"; ENDCASE; 'T => SELECT TRUE FROM RefText.Equal[token, "THEN"] => line _ "THEN"; ENDCASE; ENDCASE; IF line = NIL THEN { <> WITH SymTab.FetchText[symbolTable, token].val SELECT FROM symTabEntry: SymbolTableEntry => line _ symTabEntry.rope; ENDCASE => line _ Rope.FromRefText[token]; }; key _ line; SELECT peek FROM ':, '_ => SELECT char FROM IN ['A..'Z], IN ['a..'z] => { <> token _ RefText.AppendChar[token, peek]; WITH SymTab.FetchText[symbolTable, token].val SELECT FROM symTabEntry: SymbolTableEntry => key _ symTabEntry.key; ENDCASE => key _ Rope.FromRefText[token]; }; ENDCASE; '. => IF char = '} THEN ERROR EndOfFile; ENDCASE; EXIT; }; ENDCASE; <> IF switchMergeFiles THEN { pos _ nodeCount; nodeCount _ nodeCount+1; node _ inNode.node _ inNode.node.StepForward[]; IF node = NIL THEN ERROR EndOfFile; line _ node.NodeRope[]; } ELSE { pos _ IO.GetIndex[in]; token _ IO.GetLine[in, buffer ! IO.EndOfStream => ERROR EndOfFile]; WITH SymTab.FetchText[symbolTable, token].val SELECT FROM symTabEntry: SymbolTableEntry => line _ symTabEntry.rope; ENDCASE => line _ Rope.FromRefText[token]; }; key _ line; IF localSwitchFileType = bravo AND (NOT((index _ Rope.Find[line, Rope.FromChar['\032], 0, ]) = -1)) THEN <> line _ Rope.Substr[line, 0, index]; IF NOT AdvanceOverBlanks[line, localSwitchIgnoreEmpties] THEN EXIT; ENDLOOP; }; FinishUp: PROC [difMsg: ROPE] = { IO.PutRope[out, difMsg]; IO.PutRope[out, "\n"]; IF switchMergeFiles THEN RETURN; IF difFile = NIL THEN OpenDifFileAndWriteHeader[]; IO.PutRope[difFile, difMsg]; IO.PutRope[difFile, "\n"]; IO.Close[difFile]; }; WorkingMsg: PROC [char: CHAR] = { Process.CheckForAbort[]; IO.PutChar[out, IF debugging THEN char ELSE '.]; }; OpenDifFileAndWriteHeader: PROC = { IF anyDifferencesSeen THEN RETURN; anyDifferencesSeen _ TRUE; difFileName _ DefaultExtension[difFileName, IF switchMergeFiles THEN ".merger" ELSE ".dif"]; IF switchMergeFiles THEN { difFile _ IO.noWhereStream; difFileNode _ NewNode[]; RETURN; }; difFile _ FS.StreamOpen[difFileName, $create]; IO.PutRope[difFile, IF pData = $Cedar THEN "\nCedarlily" ELSE "\nWaterlily"]; IO.PutF[difFile, "\n run on %g\n File 1: %g\n File 2: %g\n\n", [time[BasicTime.Now[]]], [rope[oldFileName]], [rope[newFileName]]]; }; OpenFile: PROC [tempFileName: ROPE, switchFileType: FileType] RETURNS [fileName: ROPE, file: REF] = { streamOptions: FS.StreamOptions _ FS.defaultStreamOptions; streamOptions[tiogaRead] _ (switchFileType = tioga); tempFileName _ DefaultExtension[tempFileName, ".mesa"]; fileName _ FS.FileInfo[tempFileName].fullFName; IF switchMergeFiles THEN file _ NodeFromFile[fileName] ELSE file _ FS.StreamOpen[fileName, $read, streamOptions]; }; <> symbolTable: SymTab.Ref _ SymTab.Create[mod: 1023, case: TRUE]; fillerNode: Node _ NewNode[]; fillerNode.node _ TR[TiogaFileOps.InsertAsLastChild[FR[fillerNode.root]]]; TiogaFileOps.SetContents[FR[fillerNode.node], filler]; TiogaFileOps.AddLooks[FR[fillerNode.node], 0, filler.Length[], 'b, FR[fillerNode.root]]; NodeProps.PutProp[fillerNode.node, $Comment, NEW[BOOL_TRUE]]; result _ NIL; msg _ NIL; <> { args: CommandTool.ArgumentVector _ CommandTool.Parse[cmd ! CommandTool.Failed => {msg _ "Syntax error."; GO TO fatalError} ]; fileCount: NAT _ 0; defaultFileType: FileType _ tioga; ignoreEmptyLines: BOOL _ TRUE; IF pData=$Merge THEN { switchMergeFiles _ TRUE; ignoreEmptyLines _ FALSE; }; FOR i: NAT IN [1..args.argc) DO arg: ROPE = args[i]; sense: BOOL _ TRUE; IF Rope.Match["-*", arg] THEN { <> len: NAT _ Rope.Length[arg]; number: INT _ 0; FOR i: NAT IN [1..len) DO c: CHAR _ Rope.Fetch[arg, i]; SELECT c FROM '~ => sense _ NOT sense; 'b, 'B => defaultFileType _ bravo; 't, 'T => defaultFileType _ tioga; 'u, 'U => defaultFileType _ unform; 'i, 'I => ignoreEmptyLines _ sense; 'x, 'X => { switchMergeFiles _ sense; IF sense THEN ignoreEmptyLines _ FALSE; }; IN ['0..'9] => {number _ number*10 + (c-'0); LOOP}; 'm, 'M => IF number >= 1 THEN switchLinesForMatch _ number; 'c, 'C => IF number >= 1 THEN switchLinesForContext _ number; ENDCASE; number _ 0; ENDLOOP; LOOP; }; IF Rope.Match["_", arg] THEN { <> IF fileCount # 1 THEN GO TO usageError; fileCount _ 0; difFileName _ oldFileName; LOOP; }; SELECT fileCount FROM 0 => { fileCount _ 1; switchOldFileType _ defaultFileType; switchIgnoreEmptyLinesOldFile _ ignoreEmptyLines; oldFileName _ arg; IF difFileName = NIL THEN difFileName _ ShortName[arg]; }; 1 => { fileCount _ 2; switchNewFileType _ defaultFileType; switchIgnoreEmptyLinesNewFile _ ignoreEmptyLines; newFileName _ arg; }; ENDCASE => {GO TO usageError}; ENDLOOP; IF fileCount # 2 THEN GO TO usageError; out.PutRope["Comparing "]; { ENABLE FS.Error => { IF error.group # bug THEN msg _ error.explanation; GO TO fatalError; }; [oldFileName, oldFile] _ OpenFile[oldFileName, switchOldFileType]; [newFileName, newFile] _ OpenFile[newFileName, switchNewFileType]; }; WorkingMsg['-]; }; <> { <> <> nextLine: ROPE _ NIL; nextNode: TextNode.Ref _ NIL; peek: CHAR; DO key: ROPE; [key, nextLine, nextNode, peek, posInNewFile] _ ReadLineFromFile[newFile, switchNewFileType, switchIgnoreEmptyLinesNewFile ! EndOfFile => GOTO donewithfile]; SetSymbolTableEntry[key, nextLine, nextNode, new, totalLinesInNewFile, posInNewFile, peek]; totalLinesInNewFile _ totalLinesInNewFile + 1; REPEAT donewithfile => { IF totalLinesInNewFile = 0 THEN GOTO emptyfile; }; ENDLOOP; newArray _ NEW[FileArrayRep[totalLinesInNewFile]]; WorkingMsg['!]; <> <> DO key: ROPE; [key, nextLine, nextNode, peek, posInOldFile] _ ReadLineFromFile[oldFile, switchOldFileType, switchIgnoreEmptyLinesOldFile ! EndOfFile => GOTO donewithfile]; SetSymbolTableEntry[key, nextLine, nextNode, old, totalLinesInOldFile, posInOldFile, peek]; totalLinesInOldFile _ totalLinesInOldFile + 1; REPEAT donewithfile => { IF totalLinesInOldFile = 0 THEN GOTO emptyfile; }; ENDLOOP; oldArray _ NEW[FileArrayRep[totalLinesInOldFile]]; WorkingMsg['@]; <> <> { Test: SymTab.EachPairAction = { <<[key: SymTab.Key, val: SymTab.Val] RETURNS [quit: BOOL]>> symTabEntry: SymbolTableEntry _ NARROW[val]; newList: InstanceList _ symTabEntry.newList; oldList: InstanceList _ symTabEntry.oldList; FOR each: InstanceList _ newList, each.rest WHILE each # NIL DO newArray[each.first.line] _ NEW[FileArrayEntryRep _ [ symTableKey: symTabEntry, posInThisFile: each.first.position, lineNumInOtherFile: -1, node: each.first.node, typeOfPntr: symTable]]; ENDLOOP; FOR each: InstanceList _ oldList, each.rest WHILE each # NIL DO oldArray[each.first.line] _ NEW[FileArrayEntryRep _ [ symTableKey: symTabEntry, posInThisFile: each.first.position, lineNumInOtherFile: -1, node: each.first.node, typeOfPntr: symTable]]; ENDLOOP; RETURN[FALSE]; }; [] _ SymTab.Pairs[symbolTable, Test]; WorkingMsg['#]; }; EXITS emptyfile => FinishUp["At least one of these files is effectively empty."]; }; THROUGH [0..repeats) DO <> <> { Test: SymTab.EachPairAction = { <<[key: SymTab.Key, val: SymTab.Val] RETURNS [quit: BOOL]>> symTabEntry: SymbolTableEntry _ NARROW[val]; newList: InstanceList _ symTabEntry.newList; oldList: InstanceList _ symTabEntry.oldList; Process.CheckForAbort[]; SELECT TRUE FROM newList = NIL, oldList = NIL => {}; newList.rest # NIL, oldList.rest # NIL => { }; ENDCASE => { indexO _ oldList.first.line; indexN _ newList.first.line; ConnectEntries[symTabEntry, indexO, indexN, oldArray[indexO], newArray[indexN]]; }; RETURN[FALSE]; }; [] _ SymTab.Pairs[symbolTable, Test]; WorkingMsg['$]; }; <> <> { indexN _ 0; WHILE indexN < totalLinesInNewFile DO entry: FileArrayEntry = newArray[indexN]; Process.CheckForAbort[]; indexN _ indexN + 1; IF entry.typeOfPntr = lineNum THEN { indexO _ entry.lineNumInOtherFile + 1; WHILE indexN < totalLinesInNewFile AND indexO < totalLinesInOldFile DO entryN: FileArrayEntry = newArray[indexN]; entryO: FileArrayEntry = oldArray[indexO]; symTabEntry: SymbolTableEntry _ entryN.symTableKey; SELECT TRUE FROM entryN.typeOfPntr = symTable AND entryO.typeOfPntr = symTable AND symTabEntry = entryO.symTableKey => ConnectEntries[symTabEntry, indexO, indexN, entryO, entryN]; entryN.typeOfPntr # lineNum OR entryO.typeOfPntr # lineNum OR entryN.lineNumInOtherFile # indexO OR entryO.lineNumInOtherFile # indexN => EXIT; ENDCASE; indexN _ indexN + 1; indexO _ indexO + 1; ENDLOOP; }; ENDLOOP; WorkingMsg['%]; }; <> <> { indexN _ totalLinesInNewFile - 1; WHILE indexN >= 0 DO entry: FileArrayEntry = newArray[indexN]; Process.CheckForAbort[]; indexN _ indexN - 1; IF entry.typeOfPntr = lineNum THEN { indexO _ entry.lineNumInOtherFile - 1; WHILE indexN >= 0 AND indexO >= 0 DO entryN: FileArrayEntry = newArray[indexN]; entryO: FileArrayEntry = oldArray[indexO]; symTabEntry: SymbolTableEntry _ entryN.symTableKey; Process.CheckForAbort[]; SELECT TRUE FROM entryN.typeOfPntr = symTable AND entryO.typeOfPntr = symTable AND symTabEntry = entryO.symTableKey => { ConnectEntries[symTabEntry, indexO, indexN, entryO, entryN]; }; entryN.typeOfPntr # lineNum OR entryO.typeOfPntr # lineNum OR entryN.lineNumInOtherFile # indexO OR entryO.lineNumInOtherFile # indexN => EXIT; ENDCASE; indexN _ indexN - 1; indexO _ indexO - 1; ENDLOOP; }; ENDLOOP; WorkingMsg['~]; }; ENDLOOP; <> { CancelMatch: PROC [array1, array2: FileArray, totalNumOfLinesFile1, index: INT] = { DO entry1: FileArrayEntry _ array1[index]; IF entry1.typeOfPntr = symTable THEN EXIT; entry1.typeOfPntr _ symTable; array2[entry1.lineNumInOtherFile].typeOfPntr _ symTable; index _ index + 1; IF ((index >= totalNumOfLinesFile1) OR (entry1.lineNumInOtherFile # array1[index - 1].lineNumInOtherFile + 1)) THEN EXIT; ENDLOOP; }; <> <> IF switchLinesForMatch > 1 THEN { indexN _ 0; DO oldIndexN: INT _ indexN; indexN _ indexN + 1; Process.CheckForAbort[]; IF indexN >= totalLinesInNewFile THEN EXIT; IF newArray[indexN].typeOfPntr = lineNum THEN { WHILE ((indexN < totalLinesInNewFile) AND (newArray[indexN].lineNumInOtherFile = newArray[indexN - 1].lineNumInOtherFile + 1)) DO indexN _ indexN + 1; ENDLOOP; IF (indexN - oldIndexN) < switchLinesForMatch AND indexN < totalLinesInNewFile THEN CancelMatch[newArray, oldArray, totalLinesInNewFile, oldIndexN]; }; ENDLOOP; }; WorkingMsg['&]; <> <> { LeadingNumber: PROC [char: CHAR, number: INT] = { <> leadingZeroes: CARDINAL _ columns - 1; tempIndex: INT _ number; IF switchMergeFiles THEN RETURN; Process.CheckForAbort[]; DO tempIndex _ tempIndex/10; IF tempIndex = 0 THEN EXIT; leadingZeroes _ leadingZeroes - 1; ENDLOOP; difFile.PutF["%g/", [character[char]]]; THROUGH [0..leadingZeroes) DO difFile.PutChar['0]; ENDLOOP; difFile.Put[[integer[number]]]; difFile.PutRope[") "]; }; PrintCedarDelta: PROC [file: STREAM, index, start, total: INT, array: FileArray] RETURNS [INT] = { <> IF start < total THEN { leadChar: CHAR _ IF file = oldFile THEN '1 ELSE '2; lastChar: CHAR _ 0C; lastIndex: CARDINAL _ MIN[index+1, total] - 1; lastEntry: FileArrayEntry = array[lastIndex]; startPos: INT _ array[start].posInThisFile; endPos: INT _ lastEntry.posInThisFile + Rope.Length[lastEntry.symTableKey.rope]; WHILE startPos > 0 DO IO.SetIndex[file, startPos - 1]; lastChar _ IO.GetChar[file]; IF lastChar = '\n THEN EXIT; startPos _ startPos - 1; ENDLOOP; LeadingNumber[leadChar, startPos]; FOR p: INT IN [startPos..endPos) DO IO.PutChar[difFile, lastChar _ IO.GetChar[file ! IO.EndOfStream => EXIT]]; IF lastChar = '\n AND p+1 # endPos THEN LeadingNumber[leadChar, IO.GetIndex[file]]; ENDLOOP; WHILE lastChar # '\n DO IO.PutChar[difFile, lastChar _ IO.GetChar[file ! IO.EndOfStream => EXIT]]; ENDLOOP; <> endPos _ IO.GetIndex[file]; WHILE index < total DO IF array[index].posInThisFile >= endPos THEN EXIT; index _ index + 1; ENDLOOP; }; RETURN [index]; }; DumpOutDiffAndMoveAhead: PROC = { index: INT; IF NOT anyDifferencesSeen THEN { OpenDifFileAndWriteHeader[]; difFile.PutF["%g%g\n", [rope[Asterisks]], [rope[Asterisks]]]; }; SELECT TRUE FROM (indexN >= totalLinesInNewFile) OR (indexO >= totalLinesInOldFile) => { indexN _ totalLinesInNewFile; indexO _ totalLinesInOldFile; }; newArray[indexN].typeOfPntr = lineNum => indexO _ newArray[indexN].lineNumInOtherFile ENDCASE => indexN _ oldArray[indexO].lineNumInOtherFile; SELECT pData FROM $Cedar => { indexO _ PrintCedarDelta[NARROW[oldFile], indexO, startDifO, totalLinesInOldFile, oldArray]; difFile.PutF["%g\n", [rope[Asterisks]]]; indexN _ PrintCedarDelta[NARROW[newFile], indexN, startDifN, totalLinesInNewFile, newArray]; }; ENDCASE => { IF switchMergeFiles THEN CopySpan[oldArray, startDifO, indexO-1, oldFile, old, totalLinesInOldFile] ELSE FOR index IN [startDifO..indexO) DO entry: FileArrayEntry = oldArray[index]; LeadingNumber['1, entry.posInThisFile]; difFile.PutF["%g\n", [rope[entry.symTableKey.rope] ]]; ENDLOOP; IF ~switchMergeFiles THEN FOR index IN [indexO..indexO + switchLinesForContext) WHILE (index < totalLinesInOldFile) DO entry: FileArrayEntry = oldArray[index]; LeadingNumber['1, entry.posInThisFile]; difFile.PutF["%g\n", [rope[entry.symTableKey.rope] ]]; ENDLOOP; indexO _ indexO + switchLinesForContext; difFile.PutF["%g\n", [rope[Asterisks]]]; IF switchMergeFiles THEN CopySpan[newArray, startDifN, indexN-1, newFile, new, totalLinesInNewFile] ELSE FOR index IN [startDifN..indexN) DO entry: FileArrayEntry = newArray[index]; LeadingNumber['2, entry.posInThisFile]; difFile.PutF["%g\n", [rope[entry.symTableKey.rope] ]]; ENDLOOP; IF ~switchMergeFiles THEN FOR index IN [indexN..indexN + switchLinesForContext) WHILE (index < totalLinesInNewFile) DO entry: FileArrayEntry = newArray[index]; LeadingNumber['2, entry.posInThisFile]; difFile.PutF["%g\n", [rope[entry.symTableKey.rope] ]]; ENDLOOP; indexN _ indexN + switchLinesForContext; }; difFile.PutF["\n%g%g\n", [rope[Asterisks]], [rope[Asterisks]]]; <> IF switchMergeFiles THEN CopySpan[newArray, indexN-switchLinesForContext, indexN-1, newFile, both, totalLinesInNewFile]; <> startDifN _ indexN; WHILE indexN < totalLinesInNewFile AND newArray[indexN].typeOfPntr # symTable DO IF newArray[indexN].lineNumInOtherFile # newArray[indexN - 1].lineNumInOtherFile + 1 THEN EXIT; indexN _ indexN + 1; indexO _ indexO + 1; ENDLOOP; IF switchMergeFiles AND indexN>startDifN THEN CopySpan[newArray, startDifN, indexN-1, newFile, both, totalLinesInNewFile]; startDifN _ indexN; startDifO _ indexO; }; TryToResolveConflicts: PROC [array1, array2: FileArray, index1, index2: INT] RETURNS [okToDumpDiff: BOOL] = { entry1: FileArrayEntry _ array1[index1]; lastRange1: INT _ index1 + entry1.lineNumInOtherFile - index2; FOR tempIndex: INT IN [index2..entry1.lineNumInOtherFile) DO entry2: FileArrayEntry _ array2[tempIndex]; IF entry2.typeOfPntr = lineNum THEN { IF entry2.lineNumInOtherFile > lastRange1 THEN CancelMatch[array2, array1, totalLinesInOldFile, tempIndex] ELSE { CancelMatch[array1, array2, totalLinesInNewFile, index1]; RETURN[FALSE]; }; }; ENDLOOP; RETURN[TRUE]; }; CopySpan: PROC [array: FileArray, index1, index2: INT, in: REF, lineType: LineType _ both, limit: INT_-1] = { inNode: Node = NARROW[in]; nesting: INT; IF limit>=0 THEN { IF index1 >= limit THEN RETURN; index2 _ MIN[index2, limit-1]; }; IF index1>index2 THEN RETURN; nesting _ TextNode.Level[array[index1].node] - TextNode.Level[difFileNode.node]; WHILE nesting > 1 DO []_EditSpan.Copy[difFileNode.root, fillerNode.root, TextNode.MakeNodeLoc[difFileNode.node], TextNode.MakeNodeSpan[fillerNode.node, fillerNode.node], after, 1]; nesting _ nesting - 1; ENDLOOP; []_EditSpan.Copy[difFileNode.root, inNode.root, TextNode.MakeNodeLoc[difFileNode.node], TextNode.MakeNodeSpan[array[index1].node, array[index2].node], after, nesting]; IF lineType=both THEN difFileNode.node _ TextNode.LastWithin[difFileNode.root] ELSE { node: TextNode.Ref; WHILE (node_TextNode.StepForward[difFileNode.node])#NIL DO len: INT = Rope.Length[TextNode.NodeRope[node]]; difFileNode.node _ node; SELECT lineType FROM old => TiogaFileOps.AddLooks[FR[node], 0, len, 'y]; new => TiogaFileOps.AddLooks[FR[node], 0, len, 'z]; ENDCASE; ENDLOOP; }; }; startDifN: INT; startDifO: INT; dumpDiff: BOOL; columns: [0..255] _ 1; max: INT _ MAX[posInNewFile, posInOldFile]; DO max _ max/10; IF max = 0 THEN EXIT; columns _ columns + 1; ENDLOOP; indexN _ 0; indexO _ 0; IF switchMergeFiles THEN OpenDifFileAndWriteHeader[]; DO IF indexN >= totalLinesInNewFile OR indexO >= totalLinesInOldFile THEN EXIT ELSE { entryN: FileArrayEntry _ newArray[indexN]; entryO: FileArrayEntry _ oldArray[indexO]; IF entryN.typeOfPntr # lineNum THEN EXIT; IF entryO.typeOfPntr # lineNum THEN EXIT; IF entryN.lineNumInOtherFile # indexO THEN EXIT; IF entryO.lineNumInOtherFile # indexN THEN EXIT; indexN _ indexN + 1; indexO _ indexO + 1; }; ENDLOOP; IF switchMergeFiles AND indexN>0 THEN CopySpan[newArray, 0, indexN-1, newFile, both]; startDifN _ indexN; startDifO _ indexO; dumpDiff _ FALSE; WHILE ((indexN < totalLinesInNewFile) AND (indexO < totalLinesInOldFile)) DO entryN: FileArrayEntry = newArray[indexN]; entryO: FileArrayEntry = oldArray[indexO]; IF entryN.typeOfPntr = lineNum OR entryO.typeOfPntr = lineNum THEN { IF entryN.typeOfPntr = lineNum AND entryO.typeOfPntr = lineNum THEN { IF entryN.lineNumInOtherFile = indexO AND entryO.lineNumInOtherFile = indexN THEN GOTO dumpoutthedifference; IF (entryN.lineNumInOtherFile - indexO) > (entryO.lineNumInOtherFile - indexN) THEN CancelMatch[newArray, oldArray, totalLinesInNewFile, indexN] ELSE CancelMatch[oldArray, newArray, totalLinesInOldFile, indexO]; }; IF entryN.typeOfPntr = lineNum THEN dumpDiff _ TryToResolveConflicts[newArray, oldArray, indexN, indexO] ELSE dumpDiff _ TryToResolveConflicts[oldArray, newArray, indexO, indexN]; EXITS dumpoutthedifference => dumpDiff _ TRUE; }; IF dumpDiff THEN { DumpOutDiffAndMoveAhead[]; dumpDiff _ FALSE; } ELSE { indexN _ indexN + 1; indexO _ indexO + 1; }; ENDLOOP; IF startDifN < totalLinesInNewFile OR startDifO < totalLinesInOldFile THEN DumpOutDiffAndMoveAhead[]; WorkingMsg['*]; IF switchMergeFiles THEN TiogaFileOps.Store[FR[difFileNode.root], difFileName]; }; IF anyDifferencesSeen THEN FinishUp[Rope.Cat[IF switchMergeFiles THEN "merged version written on file " ELSE " differences written on file ", difFileName, ".\n"]] ELSE FinishUp[" no differences encountered.\n"]; IF ~switchMergeFiles THEN { IO.Close[NARROW[oldFile]]; IO.Close[NARROW[newFile]]; } }; EXITS usageError => {msg _ "Usage error: Waterlily file1 file2\n"; result _ $Failed}; fatalError => {result _ $Failed}; }; AdvanceOverBlanks: PROC [line: ROPE, localSwitchIgnoreEmpties: BOOL] RETURNS [BOOL] = { index: CARDINAL _ 0; length: CARDINAL = Rope.Length[line]; WHILE index < length DO char: CHAR _ Rope.Fetch[line, index]; SELECT char FROM ' , '\t => index _ index + 1; ENDCASE => RETURN [FALSE]; ENDLOOP; <> RETURN [localSwitchIgnoreEmpties]; }; ShortName: PROC [name: ROPE] RETURNS [ROPE] = { bang: INT _ Rope.Length[name]; pos: INT _ bang; WHILE (pos _ pos - 1) > 0 DO SELECT Rope.Fetch[name, pos] FROM '>, '/, '] => {pos _ pos + 1; EXIT}; '!, '. => bang _ pos; ENDCASE; ENDLOOP; RETURN [Rope.Flatten[name, pos, bang - pos]]; }; DefaultExtension: PROC [name: ROPE, ext: ROPE] RETURNS [ROPE] = { len: INT _ Rope.Length[name]; pos: INT _ len; WHILE (pos _ pos - 1) > 0 DO SELECT Rope.Fetch[name, pos] FROM '>, '/, '] => EXIT; '., '! => RETURN [name]; ENDCASE; ENDLOOP; RETURN [Rope.Concat[name, ext]]; }; <> <<>> TR: PROC[ref: REF] RETURNS [TextNode.Ref] = TRUSTED INLINE { RETURN[LOOPHOLE[ref]]; }; FR: PROC[ref: REF] RETURNS [TiogaFileOps.Ref] = TRUSTED INLINE { RETURN[LOOPHOLE[ref]]; }; NewNode: PROC RETURNS [node: Node] = { node _ NEW[NodeBody _ [TR[TiogaFileOps.CreateRoot[]]]]; node.node _ node.root; }; NodeFromFile: PROC[fileName: ROPE] RETURNS [node: Node] = { node _ NEW[NodeBody _ []]; node.root _ PutGet.FromFile[fileName]; node.node _ node.root; }; Commander.Register[key: "Waterlily", proc: WaterlilyProc, doc: LongHelpMsgW, clientData: NIL]; Commander.Register[key: "Cedarlily", proc: WaterlilyProc, doc: LongHelpMsgC, clientData: $Cedar]; Commander.Register[key: "Tigerlily", proc: WaterlilyProc, doc: LongHelpMsgM, clientData: $Merge]; Commander.Register[key: "MergeLily", proc: WaterlilyProc, doc: LongHelpMsgM, clientData: $Merge]; -- The old name }.