EditToolSortImpl.mesa
Copyright Ó 1985, 1986, 1988, 1991, 1992 by Xerox Corporation. All rights reserved.
Michael Plass, May 6, 1985 9:23:49 am PDT
Russ Atkinson (RRA) June 18, 1985 5:04:14 pm PDT
Alison Lee June 11, 1986 11:15:07 pm PDT
Swinehart, November 14, 1986 10:02:06 am PST
Doug Wyatt, March 15, 1992 4:33 pm PST
DIRECTORY
Ascii USING [CR, LF, Lower],
Basics USING [CompareCard, CompareInt, Comparison],
Buttons USING [ButtonProc],
Char USING [Set, Code],
CharOps USING [Blank, Punctuation],
EditSpan USING [Delete, Move],
EditToolBuilder USING [BuildButton, BuildPair, BuildTriple, ToMiddle, ToNext],
EditToolPrivate USING [ChangeState, CheckPSel, CycleTriple, DoButton, Info, mainToolInfo, Register, SortKind, tSel],
IO USING [Put, RopeFromROS, ROS, STREAM],
Labels USING [Set],
List USING [Sort, DReverse],
MessageWindow USING [Append, Blink],
Rope USING [AppendChars, Fetch, FromChar, ROPE, Size],
RuntimeError USING [UNCAUGHT],
TEditDocument USING [Selection],
TEditInput USING [CommandProc, CurrentEvent],
TEditInputOps USING [CheckReadonly],
TEditLocks USING [Lock],
TEditOps USING [GetSelData],
TEditSelection USING [LockSel, MakeSelection, SelectionRoot, UnlockDocAndPSel, UnlockSel],
TextEdit,
TextNode,
Tioga;
EditToolSortImpl: CEDAR PROGRAM
IMPORTS Ascii, Basics, Char, CharOps, EditSpan, EditToolBuilder, EditToolPrivate, IO, Labels, List, MessageWindow, Rope, RuntimeError, TEditInput, TEditInputOps, TEditLocks, TEditOps, TEditSelection, TextEdit, TextNode
EXPORTS EditToolPrivate
= BEGIN
ROPE: TYPE = Rope.ROPE;
Offset: TYPE = INT;
FetchChar: PROC [node: Tioga.Node, index: INT] RETURNS [set: Tioga.CharSet, char: CHAR] ~ {
xchar: TextEdit.XCHAR ~ TextEdit.FetchChar[node, index];
RETURN[Char.Set[xchar], VAL[Char.Code[xchar]]];
};
ReplaceByChar: PROC [root: Tioga.Node, dest: Tioga.Node, char: CHAR, start, len: INT ← 0,
inherit: BOOLTRUE, looks: Tioga.Looks ← Tioga.noLooks, charSet: Tioga.CharSet ← 0,
event: TextEdit.Event ← NIL] RETURNS [resultStart, resultLen: INT] ~ {
IF inherit AND start>0 THEN looks ← TextEdit.FetchLooks[dest, start-1];
RETURN TextEdit.ReplaceByRope[root: root, dest: dest, start: start, len: len,
rope: Rope.FromChar[char], looks: looks, charSet: charSet, charProps: NIL,
event: event];
};
BuildRealSortButtons: PUBLIC PROC [info: EditToolPrivate.Info] = { OPEN info;
[] ¬ EditToolBuilder.BuildButton[layout, "DoSort", DoSort, info, TRUE];
[] ¬ EditToolBuilder.BuildButton[layout, "DoReverse", DoReverse, info, TRUE];
[] ¬ EditToolBuilder.BuildButton[layout, "DoSortAndRemoveDuplicates", DoSortElim, info, TRUE];
EditToolBuilder.ToNext[layout];
sortIncreasing ¬ TRUE;
sortIncRope ¬ "SortIncreasing";
sortDecRope ¬ "SortDecreasing";
[sortOrderLabel,] ¬
EditToolBuilder.BuildPair[layout,SortOrderButton,sortIncreasing,sortIncRope,sortDecRope,info];
EditToolBuilder.ToMiddle[layout];
sortKind ¬ sortText;
sortTextRope ¬ "SortText";
sortLinesRope ¬ "SortLines";
sortBranchesRope ¬ "Branches";
[sortKindLabel,] ¬
EditToolBuilder.BuildTriple[layout, SortKindButton, ORD[sortKind],
sortTextRope, sortLinesRope, sortBranchesRope, info];
};
BuildSortButtons: PUBLIC PROC [info: EditToolPrivate.Info] = { OPEN info;
[] ¬ EditToolBuilder.BuildButton[layout, "Sort", DoSort, info, TRUE];
[] ¬ EditToolBuilder.BuildButton[layout, "Reverse", DoReverse, info, TRUE];
[] ¬ EditToolBuilder.BuildButton[layout, "Sort-and-remove-duplicates", DoSortElim, info, TRUE];
EditToolBuilder.ToNext[layout];
sortIncreasing ¬ TRUE;
sortIncRope ¬ "Sort increasing";
sortDecRope ¬ "Sort decreasing";
[sortOrderLabel,] ¬
EditToolBuilder.BuildPair[layout,SortOrderButton,sortIncreasing,sortIncRope,sortDecRope,info];
EditToolBuilder.ToMiddle[layout];
sortKind ¬ sortText;
sortTextRope ¬ "Text (blanks delimit)";
sortLinesRope ¬ "Lines (CRs delimit)";
sortBranchesRope ¬ "Branches";
[sortKindLabel,] ¬
EditToolBuilder.BuildTriple[layout, SortKindButton, ORD[sortKind],
sortTextRope, sortLinesRope, sortBranchesRope, info];
};
sortIncRope: ROPE ;
sortDecRope: ROPE ;
sortIncAtom: LIST OF REF = EditToolPrivate.Register[$SortIncreasing,SortIncOp];
sortDecAtom: LIST OF REF = EditToolPrivate.Register[$SortDecreasing,SortDecOp];
SortOrderButton: Buttons.ButtonProc = {
EditToolPrivate.ChangeState[EditToolPrivate.mainToolInfo.sortIncreasing,
sortIncAtom,sortDecAtom]
};
SortIncOp: TEditInput.CommandProc = { SortInc[EditToolPrivate.mainToolInfo] };
SortInc: PROC [info: EditToolPrivate.Info] = { OPEN info;
sortIncreasing ¬ TRUE;
Labels.Set[sortOrderLabel,sortIncRope]
};
SortDecOp: TEditInput.CommandProc = { SortDec[EditToolPrivate.mainToolInfo] };
SortDec: PROC [info: EditToolPrivate.Info] = { OPEN info;
sortIncreasing ¬ FALSE;
Labels.Set[sortOrderLabel,sortDecRope]
};
sortTextRope: ROPE ;
sortLinesRope: ROPE ;
sortBranchesRope: ROPE ;
sortTextAtom: LIST OF REF = EditToolPrivate.Register[$SortText,SortTextOp];
sortLinesAtom: LIST OF REF = EditToolPrivate.Register[$SortLines,SortLinesOp];
sortBranchesAtom: LIST OF REF = EditToolPrivate.Register[$SortBranches,SortBranchesOp];
SortKindButton: Buttons.ButtonProc = {
EditToolPrivate.CycleTriple[ORD[EditToolPrivate.mainToolInfo.sortKind], sortTextAtom, sortLinesAtom, sortBranchesAtom]
};
SortTextOp: TEditInput.CommandProc = { SortText[EditToolPrivate.mainToolInfo] };
SortText: PROC [info: EditToolPrivate.Info] = { OPEN info;
sortKind ¬ sortText;
Labels.Set[sortKindLabel,sortTextRope]
};
SortLinesOp: TEditInput.CommandProc = { SortLines[EditToolPrivate.mainToolInfo] };
SortLines: PROC [info: EditToolPrivate.Info] = { OPEN info;
sortKind ¬ sortLines;
Labels.Set[sortKindLabel,sortLinesRope]
};
SortBranchesOp: TEditInput.CommandProc = { SortBranches[EditToolPrivate.mainToolInfo] };
SortBranches: PROC [info: EditToolPrivate.Info] = { OPEN info;
sortKind ¬ sortBranches;
Labels.Set[sortKindLabel,sortBranchesRope]
};
doSortAtom: LIST OF REF = EditToolPrivate.Register[$DoSort,DoSortOp];
DoSort: Buttons.ButtonProc = {
EditToolPrivate.DoButton[doSortAtom]
};
DoSortOp: TEditInput.CommandProc = { DoSortCom[EditToolPrivate.mainToolInfo,FALSE,FALSE] };
doSortAndElimAtom: LIST OF REF = EditToolPrivate.Register[$DoSortAndRemoveDuplicates,DoSortAndElimOp];
DoSortElim: Buttons.ButtonProc = {
EditToolPrivate.DoButton[doSortAndElimAtom]
};
DoSortAndElimOp: TEditInput.CommandProc = { DoSortCom[EditToolPrivate.mainToolInfo,FALSE,TRUE] };
doReverseAtom: LIST OF REF = EditToolPrivate.Register[$DoReverse,DoReverseOp];
DoReverse: Buttons.ButtonProc = {
EditToolPrivate.DoButton[doReverseAtom]
};
DoReverseOp: TEditInput.CommandProc = { DoSortCom[EditToolPrivate.mainToolInfo,TRUE,FALSE] };
CountBlanks: PROC [rope: Rope.ROPE, from: Offset] RETURNS [count: Offset] = {
size: INT ~ Rope.Size[rope];
count ¬ from;
WHILE count < size AND CharOps.Blank[Rope.Fetch[rope, count]] DO
count ¬ count+1;
ENDLOOP;
count ¬ count-from;
};
DoSortCom: PROC [info: EditToolPrivate.Info, reversing, eliminateDuplicates: BOOL] = {
sel: TEditDocument.Selection;
broken: BOOL ¬ FALSE;
event: Tioga.Event ¬ TEditInput.CurrentEvent[];
TEditSelection.LockSel[primary, "DoSortCom"];
sel ¬ TEditOps.GetSelData[];
IF NOT (EditToolPrivate.CheckPSel[sel] AND TEditInputOps.CheckReadonly[sel]) THEN {
MessageWindow.Append["Make selection.", TRUE];
MessageWindow.Blink;
TEditSelection.UnlockSel[primary];
}
ELSE {
root: Tioga.Node ¬ TEditSelection.SelectionRoot[sel];
quit: BOOLEAN ¬ TRUE;
count: INT ¬ 0;
duplicates: INT ¬ 0;
EditToolPrivate.tSel­ ¬ sel­;
info.interrupt­ ¬ FALSE;
[ ] ¬ TEditLocks.Lock[root, "DoSortCom"];
[quit, count, duplicates] ¬ DoSortComI[info, reversing, eliminateDuplicates, root, event ! RuntimeError.UNCAUGHT => {
broken ¬ TRUE;
TEditSelection.UnlockDocAndPSel[root];
REJECT
}];
IF NOT broken THEN {
EditToolPrivate.tSel.pendingDelete ¬ FALSE;
TEditSelection.MakeSelection[new: EditToolPrivate.tSel];
TEditSelection.UnlockDocAndPSel[root];
IF NOT info.interrupt­ THEN {
h: IO.STREAM ¬ IO.ROS[];
IO.Put[h, [integer[count]],
IF ~reversing THEN [rope[" items sorted. "]]
ELSE [rope[" items reversed. "]]];
IF eliminateDuplicates THEN IO.Put[h, [integer[duplicates]],
IF duplicates=1 THEN [rope[" duplicate eliminated. "]]
ELSE [rope[" duplicates eliminated. "]]];
MessageWindow.Append[IO.RopeFromROS[h],TRUE]
}
ELSE MessageWindow.Append["interrupted",TRUE];
};
};
};
DoSortComI: PROC [info: EditToolPrivate.Info, reversing, eliminateDuplicates: BOOL, root: Tioga.Node, event: Tioga.Event] RETURNS [quit: BOOL ¬ FALSE, count: INT ¬ 0, duplicates: INT ¬ 0] = {
span: TextNode.Span;
list: LIST OF REF;
kind: EditToolPrivate.SortKind ¬ info.sortKind;
textBuf: REF TEXT ~ NEW[TEXT[textBufSize]];
GetFirstChars: PROC [rope: ROPE, start, len: INT] RETURNS [firstChars: FirstChars] ~ {
textBuf.length ¬ 0;
[] ¬ Rope.AppendChars[textBuf, rope, start, MIN[len, nFirstChars]];
FOR i: NAT IN [0..textBuf.length) DO
firstChars[i] ¬ Ascii.Lower[textBuf[i]];
ENDLOOP;
};
span ¬ [EditToolPrivate.tSel.start.pos, EditToolPrivate.tSel.end.pos];
IF kind=sortBranches THEN {
start, end, last, loc: Tioga.Node;
IsSibling: PROC [first, last: Tioga.Node] RETURNS [BOOL] = {
FOR n: Tioga.Node ¬ first, TextNode.Next[n] DO
SELECT n FROM
NIL => RETURN [FALSE];
last => EXIT;
ENDCASE;
ENDLOOP;
RETURN [TRUE]
};
start ¬ span.start.node;
FOR n: Tioga.Node ¬ span.end.node, TextNode.Parent[n] DO
IF n = NIL THEN {
MessageWindow.Append["Selection must end inside a sibling of start node.",TRUE];
MessageWindow.Blink[];
RETURN [quit: TRUE]
};
IF IsSibling[start,n] THEN { last ¬ n; EXIT };
ENDLOOP;
loc ¬ start; end ¬ TextNode.Next[last];
UNTIL loc=end DO -- make list of things to sort
node: Tioga.Node ¬ loc;
blanks: Offset ¬ CountBlanks[node.rope,0];
list ¬ CONS[NEW[ItemRep ¬ [node, 0, TextEdit.Size[node], blanks, GetFirstChars[node.rope, blanks, LAST[INT]]]], list];
loc ¬ TextNode.Next[loc];
count ¬ count+1;
ENDLOOP;
IF NOT reversing AND NOT info.interrupt­ THEN {
list ¬ List.Sort[list, Compare];
IF NOT info.sortIncreasing THEN list ¬ List.DReverse[list];
};
IF NOT info.interrupt­ THEN { -- reorder the branches
Del: PROC [text: Tioga.Node] = {
[] ¬ EditSpan.Delete[
root: root, del: TextNode.MakeNodeSpan[text,TextNode.LastWithin[text]],
event: event, saveForPaste: FALSE]
};
parent: Tioga.Node ¬ TextNode.Parent[start];
previous: Tioga.Node ¬ TextNode.Previous[start, parent];
IF eliminateDuplicates THEN [duplicates, ----] ¬ EliminateDuplicates[list, Del];
DKW: Note that EliminateDuplicates might delete start!
start ¬ NARROW[list.first, Item].text; -- new start
IF TextNode.Previous[start] # previous THEN { -- move start to correct location
IF previous=NIL THEN -- move first to child of parent
[] ¬ EditSpan.Move[
destRoot: root, sourceRoot: root, dest: TextNode.MakeNodeLoc[parent],
source: TextNode.MakeNodeSpan[start, TextNode.LastWithin[start]],
where: child, event: event]
ELSE -- move first to after node before start
[] ¬ EditSpan.Move[
destRoot: root, sourceRoot: root,
dest: TextNode.MakeNodeLoc[previous],
source: TextNode.MakeNodeSpan[start, TextNode.LastWithin[start]],
where: sibling, event: event];
};
FOR lst: LIST OF REF ¬ list, lst.rest DO
move next of list to after first of list
next, dest: Tioga.Node;
nesting: INTEGER;
lstFirst: Item ~ NARROW[lst.first];
lstNxt: Item ~ IF lst.rest=NIL THEN NIL ELSE NARROW[lst.rest.first];
IF lst.rest=NIL THEN { last ¬ lstFirst.text; EXIT };
next ¬ lstNxt.text;
IF lstFirst.text.next = next THEN LOOP; -- already in correct order
dest ¬ TextNode.LastWithin[lstFirst.text];
nesting ¬ 0;
FOR n: Tioga.Node ¬ dest, TextNode.Parent[n] UNTIL n=lstFirst.text DO
nesting ¬ nesting-1;
ENDLOOP;
[] ¬ EditSpan.Move[
destRoot: root,
sourceRoot: root,
dest: TextNode.MakeNodeLoc[dest],
source: TextNode.MakeNodeSpan[next,TextNode.LastWithin[next]],
nesting: nesting, where: sibling, event: event
];
ENDLOOP;
};
SELECT EditToolPrivate.tSel.granularity FROM
node, branch => NULL;
ENDCASE => EditToolPrivate.tSel.granularity ¬ node;
EditToolPrivate.tSel.start.pos ¬ [start, 0];
last ¬ TextNode.LastWithin[last];
EditToolPrivate.tSel.end.pos ¬ [last, MAX[TextEdit.Size[last],1]-1];
}
ELSE { -- sorting text/lines within a single node
node: Tioga.Node ~ span.start.node;
root: Tioga.Node ~ TextNode.Root[node];
rope: Rope.ROPE;
start, loc, end, newSize, elim: Offset;
lastCharSet, finalCharSet: NAT ¬ 0;
lastChar, delimChar, finalChar: CHAR ¬ 0C;
looks: Tioga.Looks;
addedChar, addedDelimiter, replacedFinalDelimiter: BOOL ¬ FALSE;
newNode: Tioga.Node ~ TextNode.NewTextNode[];
newRoot: Tioga.Node ~ TextEdit.DocFromNode[newNode];
Next: PROC [at: Offset] RETURNS [next: Offset, finalCharSet: [0..256), finalChar: CHAR] = { -- scan to break
char: CHAR ¬ '\000;
charSet: NAT ¬ 0;
rope: ROPE ~ node.rope;
size: INT ~ Rope.Size[rope];
Dlm: PROC [charSet: NAT, char: CHAR] RETURNS [BOOL]
¬ IF kind=sortText THEN Blnk ELSE Newl;
Blnk: PROC [charSet: NAT, char: CHAR] RETURNS [BOOL]
~ {RETURN [charSet = 0 AND CharOps.Blank[char]]};
Newl: PROC [charSet: NAT, char: CHAR] RETURNS [BOOL]
~ {RETURN [charSet = 0 AND (char=Ascii.CR OR char=Ascii.LF)]};
next ¬ at;
WHILE next < end DO
Quick search looking only at the rope
k: NAT ¬ 0;
textBuf.length ¬ 0;
[] ¬ Rope.AppendChars[textBuf, rope, next, end-next];
UNTIL k = textBuf.length
OR (kind=sortText AND CharOps.Blank[textBuf[k]])
OR (SELECT textBuf[k] FROM Ascii.CR, Ascii.LF => TRUE, ENDCASE => FALSE) DO
k ¬ k + 1;
ENDLOOP;
next ¬ next + k;
IF k # textBuf.length THEN EXIT;
ENDLOOP;
WHILE next < end DO
Do this anyway in case character sets are present.
[charSet, char] ¬ FetchChar[node, next];
IF Dlm[charSet, char] THEN EXIT;
next ¬ next + 1;
ENDLOOP;
finalCharSet ¬ charSet;
finalChar ¬ char;
WHILE next < end DO
[charSet, char] ¬ FetchChar[node, next];
IF NOT Dlm[charSet, char] THEN EXIT;
next ¬ next + 1;
ENDLOOP;
};
IF span.start.node # span.end.node THEN {
MessageWindow.Append["Selection must be in a single node.",TRUE];
MessageWindow.Blink[]; RETURN [quit: TRUE]
};
IF node=NIL THEN RETURN [quit: TRUE];
rope ¬ node.rope;
IF (start ¬ span.start.where) = TextNode.NodeItself THEN start ¬ 0;
IF (end ¬ span.end.where) = TextNode.NodeItself THEN end ¬ Rope.Size[rope]-1;
IF end <= start THEN RETURN [quit: TRUE];
loc ¬ start;
end ¬ MIN[end+1, Rope.Size[node.rope]]; -- location after the things to be sorted
[lastCharSet, lastChar] ¬ FetchChar[node, end-1];
IF kind=sortText THEN {
IF lastCharSet#0 OR NOT CharOps.Blank[lastChar] THEN { -- add blank
[] ¬ ReplaceByChar[root: root, dest: node, start: end, len: 0, char: ' , event: event];
addedChar ¬ TRUE
}
}
ELSE IF lastCharSet#0 OR lastChar # '\n THEN { -- add CR
[] ¬ ReplaceByChar[root: root, dest: node, start: end, len: 0, char: '\n , event: event];
addedChar ¬ TRUE
};
IF addedChar THEN { end ¬ end+1; rope ¬ node.rope };
UNTIL loc=end DO -- make list of things to sort
next, blanks: Offset;
finalPunct: BOOL;
[next, finalCharSet, finalChar] ¬ Next[loc];
IF info.interrupt­ THEN RETURN;
finalPunct ¬ finalCharSet=0 AND CharOps.Punctuation[finalChar];
IF loc=start AND finalPunct THEN delimChar ¬ finalChar
ELSE IF finalCharSet#0 OR finalChar # delimChar THEN {
IF next#end THEN delimChar ¬ 0C -- don't have uniform delimiters
ELSE IF delimChar # 0C THEN {
IF finalPunct THEN { -- replace final delimiter
finalCharLoc: Offset ¬ end;
DO
s: NAT; c: CHAR;
IF end = 0 THEN EXIT;
finalCharLoc ¬ finalCharLoc - 1;
[s,c] ¬ FetchChar[node, finalCharLoc];
IF s = finalCharSet AND c = finalChar THEN EXIT;
ENDLOOP;
looks ¬ TextEdit.FetchLooks[node, finalCharLoc];
[] ¬ ReplaceByChar[root: root, dest: node, start: finalCharLoc, len: 1,
inherit: FALSE, looks: looks, char: delimChar, charSet: finalCharSet, event: event];
replacedFinalDelimiter ¬ TRUE
}
ELSE { -- add delimiter to final item
[] ¬ ReplaceByChar[root: root, dest: node, start: end-1, len: 0, char: delimChar, event: event];
addedDelimiter ¬ TRUE; next ¬ end ¬ end+1
};
rope ¬ node.rope;
};
};
blanks ¬ IF kind=sortText THEN 0 ELSE CountBlanks[node.rope, loc];
list ¬ CONS[NEW[ItemRep¬[node, loc, next-loc, blanks, GetFirstChars[node.rope, loc+blanks, next-(loc+blanks)]]], list];
loc ¬ next;
count ¬ count+1;
ENDLOOP;
elim ¬ 0;
IF NOT reversing THEN {
IF info.interrupt­ THEN RETURN;
list ¬ List.Sort[list, Compare];
IF info.interrupt­ THEN RETURN;
IF eliminateDuplicates THEN [duplicates, elim] ¬ EliminateDuplicates[list];
IF info.interrupt­ THEN RETURN;
IF NOT info.sortIncreasing THEN list ¬ List.DReverse[list];
};
UNTIL list = NIL OR info.interrupt­ DO
t: LIST OF REF ¬ list;
tFirst: Item ~ NARROW[t.first];
list ¬ list.rest;
t.rest ¬ NIL;
[] ¬ TextEdit.ReplaceText[destRoot: newRoot, sourceRoot: root, dest: newNode, destStart: Rope.Size[newNode.rope], destLen: 0, source: node, sourceStart: tFirst.start, sourceLen: tFirst.len, event: NIL];
tFirst.text ¬ NIL;
ENDLOOP;
newSize ¬ Rope.Size[newNode.rope];
IF NOT info.interrupt­ THEN {
IF newSize # end-start-elim THEN ERROR;
[] ¬ TextEdit.ReplaceText[destRoot: root, sourceRoot: newRoot, dest: node, destStart: start, destLen: end-start, source: newNode, sourceStart: 0, sourceLen: Rope.Size[newNode.rope], event: event]
};
IF addedChar THEN { -- delete trailing blank or CR
TextEdit.DeleteText[root: root, text: node, start: start+newSize-1, len: 1, event: event];
newSize ¬ newSize-1
};
IF addedDelimiter THEN {
TextEdit.DeleteText[
root: root, text: node, start: start+newSize-1, len: 1, event: event];
newSize ¬ newSize-1
};
IF replacedFinalDelimiter THEN {
[] ¬ ReplaceByChar[root: root, dest: node, start: start+newSize-1, len: 1, inherit: FALSE, looks: looks, char: finalChar, charSet: finalCharSet, event: event];
};
EditToolPrivate.tSel.end.pos.where ¬ EditToolPrivate.tSel.start.pos.where + MAX[newSize-1, 0];
newNode.child ¬ NIL;
}; -- end of text/line case
};
textBufSize: NAT ¬ 24;
debug: BOOL ¬ FALSE;
EliminateDuplicates: PROC [lst: LIST OF REF, proc: PROC [Tioga.Node] ¬ NIL] RETURNS [number, elim: Offset] = {
number ¬ elim ¬ 0;
UNTIL lst.rest = NIL DO
IF Compare[lst.first, lst.rest.first]=equal THEN { -- eliminate lst.rest
t: LIST OF REF ~ lst.rest;
tFirst: Item ~ NARROW[t.first, Item];
elim ¬ elim + tFirst.len;
number ¬ number + 1;
IF proc # NIL THEN proc[tFirst.text];
lst.rest ¬ t.rest;
t.first ¬ NIL;
t.rest ¬ NIL;
}
ELSE lst ¬ lst.rest;
ENDLOOP;
};
Item: TYPE = REF ItemRep;
ItemRep: TYPE = RECORD [text: Tioga.Node, start, len, blanks: INT, firstChars: FirstChars];
nFirstChars: NAT ~ 6;
FirstChars: TYPE ~ ARRAY [0..nFirstChars) OF CHAR ¬ ALL['\000];
Compare: PROC [ref1: REF ANY, ref2: REF ANY] RETURNS [result: Basics.Comparison] = {
ai: Item ~ NARROW[ref1];
bi: Item ~ NARROW[ref2];
IF ai.firstChars # bi.firstChars THEN {
ac, bc: CHAR;
FOR i: NAT IN [0..nFirstChars) WHILE (ac¬ai.firstChars[i])=(bc¬bi.firstChars[i]) DO
ENDLOOP;
result ¬ Basics.CompareCard[ORD[ac], ORD[bc]];
}
ELSE {
aRope: ROPE = ai.text.rope;
bRope: ROPE = bi.text.rope;
aSize: INT = ai.len-ai.blanks;
bSize: INT = bi.len-bi.blanks;
minSize: INT = MIN[aSize, bSize];
a0: INT = ai.start+ai.blanks;
b0: INT = bi.start+bi.blanks;
match: INT ¬ 0;
ac, bc: CHAR;
firstCaseDifference: Basics.Comparison ¬ equal;
WHILE match < minSize
AND (ac¬Rope.Fetch[aRope, a0+match])=(bc¬Rope.Fetch[bRope, b0+match]) DO
match ¬ match + 1;
ENDLOOP;
IF match < minSize THEN {
result ¬ Basics.CompareCard[Ascii.Lower[ac]-'\000, Ascii.Lower[bc]-'\000];
IF result = equal THEN {
firstCaseDifference ¬ Basics.CompareCard[ORD[ac], ORD[bc]];
WHILE match < minSize
AND (ac¬Ascii.Lower[Rope.Fetch[aRope, a0+match]]) = (bc¬Ascii.Lower[Rope.Fetch[bRope, b0+match]]) DO
match ¬ match + 1;
ENDLOOP;
};
};
IF match < minSize THEN result ¬ Basics.CompareCard[Ascii.Lower[ac]-'\000, Ascii.Lower[bc]-'\000]
ELSE IF firstCaseDifference # equal THEN result ¬ firstCaseDifference
ELSE result ¬ Basics.CompareInt[aSize, bSize];
IF result = equal AND (ai.text.charSets#NIL OR bi.text.charSets#NIL) THEN {
Disambiguate 16-bit character codes. Note the character set codes are considered less significant for the purposes of sorting, and are not used at all unless the strings are otherwise identical.
FOR i: INT IN [0..match) WHILE result = equal DO
result ¬ Basics.CompareCard[
FetchChar[ai.text, a0+i].set,
FetchChar[bi.text, b0+i].set
];
ENDLOOP;
};
};
};
END.
Michael Plass, October 23, 1984 2:29:35 pm PDT — Fixed bounds fault that came up when sorting lines that came up to the end of the document. Also added kludge to unlock the selection in case of an uncaught error, to make debugging easier.
Michael Plass, March 20, 1985 3:55:03 pm PST — Cedar 6 conversion to handle 16-bit character codes. Also fixed kludge to unlock the selection AND DOCUMENT in case of an uncaught error, to make debugging easier.