SpellingToolSharedImpl.mesa
Copyright Ó 1985, 1987, 1990, 1992 by Xerox Corporation. All rights reserved.
Last Edited by: Nix, December 9, 1983 2:52 pm
Jack Kent August 17, 1987 5:01:44 pm PDT
Last tweaked by Mike Spreitzer on February 17, 1989 7:28:28 pm PST
Tim Diebert: January 26, 1987 5:02:45 pm PST
Michael Plass, January 23, 1986 2:50:21 pm PST
Rick Beach, May 2, 1985 3:10:55 pm PDT
Spreitzer, February 26, 1985 2:37:59 pm PST
JKF, May 29, 1990 7:51:48 am PDT
Willie-s, May 22, 1992 5:03 pm PDT
DIRECTORY
NodeProps USING [DeclarePropertyAttribute, NullWrite, Register],
NodeReader,
Rope,
SpellingLooks USING [Wordlich],
SpellingToolShared,
SpellingWordMap USING [CharSet, CharSetPrivate, MapWordsInRope, MapWordsInRopeBackward],
TextEdit,
TextLooks USING [Looks, noLooks],
TextNode USING [NodeItself],
TiogaOps USING [FirstSibling, GetProp, GetRope, GetSelection, GetStyle, LastWithin, PutProp, Root, SelectionGrain, StepBackward, StepForward],
TiogaOpsDefs USING [Location, Ref],
ViewerClasses USING [ Viewer ];
SpellingToolSharedImpl: CEDAR MONITOR
IMPORTS NodeProps, NodeReader, Rope, SpellingLooks, SpellingWordMap, TextEdit, TiogaOps
EXPORTS SpellingToolShared
= BEGIN OPEN SpellingToolShared;
ROPE: TYPE = Rope.ROPE;
defaultAlphabet: CharSet ~ AdjustCharSet[NIL, "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz", NIL];
the property of document's root node that gives the additional alphabetic characters
addAlphaProperty: ATOM = $AlphabeticChars;
the property of document's root node that gives the locally non-alphabetic characters
remAlphaProperty: ATOM = $NonAlphabeticChars;
the property of document's root node that gives the local alphabet
alphabetProperty: ATOM = $SpellingToolAlphabet;
properties of document's root node that tell how the alphabet was derived
addedAlphaProperty: ATOM = $SpellingToolAddedAlphabeticChars;
remedAlphaProperty: ATOM = $SpellingToolRemedAlphabeticChars;
wordBuffer: REF TEXT ¬ NEW[TEXT[256]];
MapWordsInSelection: PUBLIC ENTRY PROC [start, end: TiogaOpsDefs.Location, alphabetic: CharSet, f: PROC [REF TEXT, REF ANY, INT] RETURNS [BOOL], forwards: BOOL] RETURNS [premature: BOOL ¬ FALSE, wordStart, wordEnd: TiogaOpsDefs.Location] = {
Maps the given procedure f over the words in the selection, returning as soon as f returns TRUE.
ENABLE UNWIND => NULL;
loc: TiogaOpsDefs.Location ¬ IF forwards THEN start ELSE end;
nodeLooksReader: NodeReader.Ref ¬ NodeReader.New[];
MapNode:
PROC [start: TiogaOpsDefs.Location,
endPlusOne: INT,
word: REF TEXT,
forwards: BOOL]
RETURNS [premature: BOOL ¬ FALSE,
wordStart, wordEnd: TiogaOpsDefs.Location] = {
Maps the given procedure f over the words in a single Tioga node, returning as soon as f returns TRUE.
nodeStyle: ROPE ¬ TiogaOps.GetStyle[start.node];
nodeRope: ROPE ¬ TiogaOps.GetRope[start.node];
nodeLooks: TextLooks.Looks ¬ TextEdit.FetchLooks[start.node, 0];
index, size, lowest: INT;
IF endPlusOne = -1 THEN endPlusOne ¬ LAST[INT];
endPlusOne ¬ MIN[endPlusOne, nodeRope.Size[]];
IF endPlusOne <= start.where THEN RETURN;
size ¬ endPlusOne - start.where;
IF ~(start.where = 0 AND endPlusOne = nodeRope.Size[]) THEN {
nodeRope ¬ nodeRope.Substr[start.where, size];
nodeLooks ¬ TextEdit.FetchLooks[start.node, start.where];
};
IF forwards THEN index ¬ 0 ELSE index ¬ size;
SELECT forwards FROM
TRUE => DO
length, next: INT;
rope: ROPE;
looks: TextLooks.Looks ¬ TextLooks.noLooks;
IF index >= size THEN EXIT;
IF nodeLooks # TextEdit.noLooks
THEN looks ¬ nodeLooksReader.looks
ELSE { length ¬ size };
next ¬ index + length;
rope ¬ nodeRope.Substr[lowest ¬ index, length];
IF SpellingLooks.Wordlich[nodeStyle, looks] THEN {
[premature, wordStart.where, wordEnd.where, word] ¬ SpellingWordMap.MapWordsInRope[rope, alphabetic, word, f, start.node, lowest + start.where];
IF premature THEN EXIT};
index ¬ next;
ENDLOOP;
FALSE => DO
length, next: INT;
rope: ROPE;
looks: TextLooks.Looks ¬ TextLooks.noLooks;
IF index <= 0 THEN EXIT;
IF nodeLooks # TextEdit.noLooks
THEN {
looks ¬ NodeReader.FetchLooks[nodeLooksReader, index];
length ¬ nodeLooksReader.size;
}
ELSE length ¬ size;
next ¬ index - length;
rope ¬ nodeRope.Substr[lowest ¬ next, length];
IF SpellingLooks.Wordlich[nodeStyle, looks] THEN {
[premature, wordStart.where, wordEnd.where, word] ¬ SpellingWordMap.MapWordsInRopeBackward[rope, alphabetic, word, f, start.node, lowest + start.where];
IF premature THEN EXIT};
index ¬ next;
ENDLOOP;
ENDCASE => ERROR;
wordStart.node ¬ start.node;
wordStart.where ¬ wordStart.where + lowest + start.where;
wordEnd.node ¬ start.node;
wordEnd.where ¬ wordEnd.where + lowest + start.where - 1;
};
IF forwards THEN
DO
[premature, wordStart, wordEnd] ¬
MapNode[loc, IF loc.node = end.node THEN end.where+1 ELSE -1, wordBuffer, TRUE];
IF premature THEN RETURN;
IF loc.node = end.node OR loc.node = NIL THEN RETURN;
loc.node ¬ TiogaOps.StepForward[loc.node];
loc.where ¬ 0;
ENDLOOP
ELSE
DO
IF loc.node = start.node THEN
loc.where ¬ start.where
ELSE
loc.where ¬ 0;
[premature, wordStart, wordEnd] ¬
MapNode[loc, IF loc.node = end.node THEN end.where+1 ELSE -1, wordBuffer, FALSE];
IF premature THEN RETURN;
IF loc.node = start.node OR loc.node = NIL THEN RETURN;
loc.node ¬ TiogaOps.StepBackward[loc.node];
loc.where ¬ 0;
ENDLOOP
};
ToRope: PUBLIC ENTRY PROC [s: Selection] RETURNS [ROPE] ~ {
ENABLE UNWIND => NULL;
loc: TiogaOpsDefs.Location ¬ s.start;
ans: ROPE ¬ NIL;
WHILE loc.node # NIL DO
nodeRope: ROPE ~ TiogaOps.GetRope[loc.node];
start: INT ~ IF loc.where=TextNode.NodeItself THEN 0 ELSE loc.where;
protoEnd: INT ~ IF loc.node = s.end.node THEN s.end.where ELSE TextNode.NodeItself;
endPlusOne: INT ~ MIN[IF protoEnd#TextNode.NodeItself THEN protoEnd+1 ELSE LAST[INT], nodeRope.Size[]];
this: ROPE ~ nodeRope.Substr[start: start, len: endPlusOne - start];
IF ans#NIL THEN ans ¬ ans.Cat["\n", this] ELSE ans ¬ this;
IF loc.node = s.end.node THEN EXIT;
loc.node ¬ TiogaOps.StepForward[loc.node];
loc.where ¬ 0;
ENDLOOP;
RETURN [ans];
};
ProcessSelection: PUBLIC ENTRY PROC [forceEOD: BOOL ¬ FALSE, defEOD: BOOL ¬ TRUE, forwards: BOOL] RETURNS [processed: Processed ¬ [NIL, NIL, FALSE]] = {
ENABLE UNWIND => NULL;
selViewer: ViewerClasses.Viewer;
selStart, selEnd: TiogaOpsDefs.Location;
selLevel: TiogaOps.SelectionGrain;
selCaretBefore, selPendingDelete: BOOL;
root: TiogaOpsDefs.Ref;
[selViewer, selStart, selEnd, selLevel, selCaretBefore, selPendingDelete] ¬ TiogaOps.GetSelection[];
processed.s ¬ NEW[SelectionRec ¬ [selViewer, selStart, selEnd, selLevel, selCaretBefore, selPendingDelete]];
root ¬ TiogaOps.Root[selStart.node];
{addAlpha: ROPE ~ NARROW[TiogaOps.GetProp[root, addAlphaProperty]];
remAlpha: ROPE ~ NARROW[TiogaOps.GetProp[root, remAlphaProperty]];
addedAlpha: ROPE ~ NARROW[TiogaOps.GetProp[root, addedAlphaProperty]];
remedAlpha: ROPE ~ NARROW[TiogaOps.GetProp[root, remedAlphaProperty]];
processed.alphabetic ¬ NARROW[TiogaOps.GetProp[root, alphabetProperty]];
IF NOT (addAlpha.Equal[addedAlpha] AND remAlpha.Equal[remedAlpha]) THEN {
processed.alphabetic ¬ AdjustCharSet[defaultAlphabet, addAlpha, remAlpha];
TiogaOps.PutProp[root, addedAlphaProperty, addAlpha];
TiogaOps.PutProp[root, remedAlphaProperty, remAlpha];
TiogaOps.PutProp[root, alphabetProperty, processed.alphabetic]}
ELSE IF processed.alphabetic=NIL THEN processed.alphabetic ¬ defaultAlphabet;
IF forceEOD OR (defEOD AND (selLevel = point OR ((selLevel = char) AND (selStart.node = selEnd.node) AND (selStart.where = selEnd.where)))) THEN {
IF forwards THEN {
processed.s.end.node ¬ TiogaOps.LastWithin[root];
processed.s.end.where ¬ (TiogaOps.GetRope[processed.s.end.node]).Size[]-1;
}
ELSE {
processed.s.start.node ¬ FirstWithin[root];
processed.s.start.where ¬ 0;
};
CheckMiddleOfWord[processed.s, processed.alphabetic];
processed.wasExtended ¬ TRUE;
};
RETURN}};
FirstWithin: PUBLIC PROC [r: TiogaOpsDefs.Ref] RETURNS [first: TiogaOpsDefs.Ref] = {
child: TiogaOpsDefs.Ref;
first ¬ r;
DO
child ¬ TiogaOps.FirstSibling[first];
IF child = NIL THEN RETURN;
first ¬ child;
ENDLOOP;
};
CheckMiddleOfWord: PUBLIC PROC[s: Selection, alphabetic: CharSet] = {
IF s.start.where > 0 THEN {
r: ROPE ¬ TiogaOps.GetRope[s.start.node];
IF alphabetic[r.Fetch[s.start.where-1]] THEN
WHILE s.start.where < r.Size[] AND alphabetic[r.Fetch[s.start.where]] DO
s.start.where ¬ s.start.where + 1;
ENDLOOP;
};
};
AdjustCharSet: PUBLIC PROC [org: CharSet, add, rem: ROPE] RETURNS [CharSet] ~ {
copied: BOOL ¬ FALSE;
Set: PROC [chars: ROPE, sense: BOOL] ~ {
FOR i: INT IN [0 .. chars.Length) DO
c: CHAR ~ chars.Fetch[i];
IF org[c]#sense THEN {
IF NOT copied THEN {
new: CharSet ~ NEW [SpellingWordMap.CharSetPrivate ¬ org­];
org ¬ new; copied ¬ TRUE};
org[c] ¬ sense};
ENDLOOP;
RETURN};
IF org=NIL THEN {
org ¬ NEW [SpellingWordMap.CharSetPrivate ¬ ALL[FALSE]];
copied ¬ TRUE};
Set[add, TRUE];
Set[rem, FALSE];
RETURN [org]};
NodeProps.Register[alphabetProperty, NIL, NodeProps.NullWrite, NIL];
NodeProps.Register[addedAlphaProperty, NIL, NodeProps.NullWrite, NIL];
NodeProps.Register[remedAlphaProperty, NIL, NodeProps.NullWrite, NIL];
NodeProps.DeclarePropertyAttribute[alphabetProperty, $ClintOnly];
NodeProps.DeclarePropertyAttribute[addedAlphaProperty, $ClintOnly];
NodeProps.DeclarePropertyAttribute[remedAlphaProperty, $ClintOnly];
END.
CHANGE LOG
Spreitzer, February 26, 1985 1:09:03 pm PST
Added looks rule to definition of `word'.
changes to: DIRECTORY, SpellingToolSharedImpl, GetLooks, MapWordsInSelection
Michael Plass, January 23, 1986 2:50:02 pm PST
Fixed off-by-one bug.
changes to: MapWordsInSelection
Last tweaked by Mike Spreitzer on February 17, 1989 6:02:22 pm PST
Made alphabetic char set variable
changes to: DIRECTORY, MapWordsInSelection, CheckMiddleOfWord, AdjustCharSet, Set (local of AdjustCharSet), ProcessSelection