SchemeSelectImpl.Mesa
Copyright Ó 1990 by Xerox Corporation. All rights reserved.
Last tweaked by Mike Spreitzer on July 3, 1992 2:00 pm PDT
DIRECTORY Char, CharOps, Rope, SimpleFeedback, TEditDocument, TEditInput, TEditInputBackdoor, TEditInputExtras, TEditProfile, TEditSelection, TEditSelectionPrivate, TEditSelectionPrivateExtras, TextEdit, TextEditExtras, TextNode, TIPUser, ViewerClasses;
SchemeSelectImpl:
CEDAR
PROGRAM
IMPORTS CharOps, Rope, SimpleFeedback, TEditInput, TEditInputBackdoor, TEditInputExtras, TEditProfile, TEditSelection, TEditSelectionPrivate, TEditSelectionPrivateExtras, TextEdit, TextEditExtras, TextNode
=
BEGIN
ROPE: TYPE ~ Rope.ROPE;
Viewer: TYPE ~ ViewerClasses.Viewer;
SetNot0: ERROR [node: TextNode.Ref] ~ CODE;
Loc: TYPE ~ RECORD [node, parent: TextNode.Ref, rope: ROPE, size, where, idx: INT];
Span: TYPE ~ RECORD [start, end: Loc];
Cmd: TYPE ~ REF CmdPrivate;
CmdPrivate: TYPE ~ RECORD [extend, track: BOOL, upLevels: INT];
nullLoc: Loc ~ [NIL, NIL, NIL, 0, 0, 0];
theSS: Span ← [nullLoc, nullLoc];
theTDD: TEditDocument.TEditDocumentData ← NIL;
lockless: BOOL ← FALSE;
testIdx: BOOL ← FALSE;
SelectCmd:
PROC [data:
REF
ANY, viewer: Viewer, param:
REF
ANY ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TEditInputExtras.CommandClosureProc-- ~ {
--cloned from TEditInputImpl's handling of SelWord on May 22, 1990
tdd: TEditDocument.TEditDocumentData ~ NARROW[viewer.data];
z: REF TIPUser.TIPScreenCoordsRec ~ IF param#NIL THEN WITH param SELECT FROM x: REF TIPUser.TIPScreenCoordsRec => x, ENDCASE => NIL ELSE NIL;
cmd: Cmd ~ NARROW[data];
IF tdd = NIL THEN RETURN;
IF z=
NIL
THEN {
SimpleFeedback.Append[$SchemeSelect, oneLiner, $Bug, "SchemeSelectImpl: my PARAM isn't a Coords - are typescripts bogus?"];
SimpleFeedback.Blink[$SchemeSelect, $Bug];
RETURN [FALSE, TRUE]};
TEditInput.interpreterNesting ← 0;
IF TEditInput.editState=abort THEN RETURN;
IF TEditInputBackdoor.sel=secondary AND TEditSelection.pSel.viewer = NIL THEN { AbortSecondary[]; RETURN };
SelectForm[viewer, tdd, z.mouseX, viewer.ch-z.mouseY, TEditInputBackdoor.sel, TEditInputBackdoor.pDel, cmd];
IF TEditInputBackdoor.sel=primary THEN TEditInput.CloseEvent[];
RETURN [FALSE, TRUE]};
SelectForm:
PROC [viewer: Viewer, tdd: TEditDocument.TEditDocumentData, x, y:
INTEGER, sel: TEditDocument.SelectionId, pDel:
BOOL, cmd: Cmd] ~ {
Finish:
PROC ~ {
IF testIdx
THEN SimpleFeedback.PutFL[$SchemeSelect, oneLiner, $Debug,
"%g..%g vs. %g..%g", LIST[
[integer[theSS.start.idx]], [integer[theSS.end.idx]],
[integer[TextNode.LocOffset[[tdd.text, 0], Export[theSS.start]] ]],
[integer[TextNode.LocOffset[[tdd.text, 0], Export[theSS.end]] ]] ]]};
DoSelectForm:
PROC [tSel, refSel: TEditDocument.Selection, rightOfLine:
BOOL] = {
--cloned from TEditMouseImpl.SelectWord on May 22, 1990
punc: TEditDocument.PunctuationPosition ← none;
newInsertion: TEditDocument.BeforeAfter;
newGrain: TEditDocument.SelectionGrain ~ word;
startValid, endValid: BOOLEAN ← TRUE;
hitLine: INTEGER ← tSel.start.line;
given: Loc ~ Import[tSel.start.pos, tdd.text];
cont: BOOL ~ (cmd.track OR cmd.extend) AND tdd=theTDD AND refSel.start.pos=Export[theSS.start] AND refSel.end.pos=Export[theSS.end];
IF cmd.track AND cont AND given.idx IN [theSS.start.idx .. theSS.end.idx] THEN NULL
ELSE
IF cmd.extend
AND cont
THEN {
idx: INT ~ given.idx;
railed, tamed: BOOL ← FALSE;
type: TokeType;
SELECT idx
FROM
<theSS.start.idx => {
WHILE idx<theSS.start.idx
AND
NOT railed
DO
oldSS: Span ~ theSS;
[railed, tamed, theSS.start] ← BwdLoc[theSS.start];
IF
NOT railed
THEN {
[theSS.start, type] ← ToTokenStart[theSS.start, tamed];
SELECT type
FROM
blank, leaf, quote => NULL;
openList, openVector => theSS.end ← FindGroupEnd[theSS.end].end;
closeList => [theSS.start, railed] ← FindGroupBegin[theSS.start];
ENDCASE => NULL};
ENDLOOP;
Finish[];
IF railed AND idx<theSS.start.idx THEN ERROR};
>theSS.end.idx => {
WHILE idx>theSS.end.idx
AND
NOT railed
DO
oldSS: Span ~ theSS;
[railed, theSS.end] ← FwdLoc[theSS.end];
IF
NOT railed
THEN {
[theSS.end, type] ← ParseWholeToken[theSS.end];
SELECT type
FROM
blank, leaf => NULL;
quote => theSS.end ← FindQuoteEnd[theSS.end];
openList, openVector => [theSS.end, railed] ← FindGroupEnd[theSS.end];
closeList => theSS.start ← FindGroupBegin[theSS.start].start;
ENDCASE => ERROR};
ENDLOOP;
Finish[];
IF railed AND idx>theSS.end.idx THEN ERROR};
ENDCASE => NULL;
}
ELSE {railed:
BOOL ←
FALSE;
[theSS.start, theSS.end] ← ExpandToForm[given];
FOR i:
INT
IN [1 .. cmd.upLevels]
WHILE
NOT railed
DO
[theSS.start, theSS.end, railed] ← ExpandForm[theSS.start, theSS.end];
ENDLOOP;
theTDD ← tdd;
Finish[]};
tSel.viewer ← viewer;
tSel.data ← tdd;
tSel.start.pos ← Export[theSS.start];
tSel.end.pos ← Export[theSS.end];
TEditSelection.FixupSelection[tSel, viewer];
newInsertion ← SetInsertion[tSel, x, hitLine, rightOfLine, tdd];
IF refSel.viewer#tSel.viewer
OR refSel.granularity#newGrain
OR tSel.start.pos#refSel.start.pos
OR tSel.end.pos#refSel.end.pos
OR newInsertion#refSel.insertion
OR refSel.pendingDelete#pDel
THEN {
tSel.granularity ← newGrain;
tSel.punctuation ← punc;
tSel.insertion ← newInsertion;
tSel.pendingDelete ← pDel;
TEditSelection.SetSelLooks[tSel];
TEditSelection.MakeSelection[tSel, sel, startValid, endValid, FALSE];
};
};
(IF lockless THEN LocklessDoSelect ELSE TEditSelectionPrivateExtras.DoSelect)[DoSelectForm, viewer, tdd, x, y, sel];
RETURN};
ExpandForm:
PROC [oStart, oEnd: Loc]
RETURNS [nStart, nEnd: Loc, railed:
BOOL ←
FALSE] ~ {
type: TokeType;
[nStart, type, railed] ← PrevNonBlank[oStart];
SELECT type
FROM
quote => nEnd ← oEnd;
blank => [nEnd, railed] ← FindGroupEnd[oEnd];
openList, openVector => nEnd ← FindGroupEnd[oEnd].end;
closeList => {r1:
BOOL;
[nStart, r1] ← FindGroupBegin[nStart];
IF NOT r1 THEN [nStart, r1] ← FindGroupBegin[nStart];
[nEnd, railed] ← FindGroupEnd[oEnd];
railed ← r1 AND railed};
ENDCASE => {r1:
BOOL;
[nStart, r1] ← FindGroupBegin[nStart];
[nEnd, railed] ← FindGroupEnd[oEnd];
railed ← r1 AND railed}};
ExpandToForm:
PROC [pos: Loc]
RETURNS [start, end: Loc] ~ {
type: TokeType;
[start, type] ← ToTokenStart[pos, FALSE];
SELECT type
FROM
closeList => {end ← start; start ← FindGroupBegin[end].start};
openList => end ← FindGroupEnd[start].end;
openVector => end ← FindGroupEnd[DLoc[start, 1]].end;
leaf, blank, quote => {
[end, type] ← ParseWholeToken[start];
IF type=quote THEN end ← FindQuoteEnd[end]};
ENDCASE => ERROR;
RETURN};
TokeType: TYPE ~ {leaf, blank, quote, openList, openVector, closeList};
ParseWholeToken:
PROC [start: Loc]
RETURNS [end: Loc, type: TokeType ← blank] ~ {
rope: ROPE ~ start.rope;
size: INT ~ start.size;
GetOrSpace:
PROC [i:
INT]
RETURNS [
CHAR]
~ INLINE {RETURN [IF i<0 OR i>=size THEN ' ELSE rope.Fetch[i]]};
FwdOverId:
PROC [start: Loc]
RETURNS [end: Loc] ~ {
end ← start;
DO next:
INT ~ end.where.
SUCC;
IF next>=size THEN RETURN [SetWhere[end, size-1]];
SELECT rope.Fetch[next]
FROM
<=' , ';, '(, '), '", '\', '`, ',, '\\, '# => RETURN [end];
ENDCASE => end ← DLoc[end, 1];
ENDLOOP};
FwdOverString:
PROC [start: Loc]
RETURNS [end: Loc] ~ {
end ← start;
DO
end ← DLoc[end, 1];
IF end.where >= size THEN RETURN [SetWhere[end, size-1]];
SELECT rope.Fetch[end.where]
FROM
'" => RETURN [end];
'\l, '\r => RETURN [DLoc[end, -1]];
'\\ =>
SELECT GetOrSpace[end.where.
SUCC]
FROM
'\l, '\r => RETURN [end];
ENDCASE => end ← DLoc[end, 1];
ENDCASE => NULL;
ENDLOOP};
end ← start;
IF end.node.comment THEN RETURN [SetWhere[end, MAX[0, size-1]], blank];
IF end.where=size THEN RETURN [end, blank];
SELECT rope.Fetch[end.where]
FROM
'\l, '\r => RETURN [end, blank];
<=' => {
DO
next: INT ~ end.where.SUCC;
nc: CHAR ~ IF next=size THEN 'x ELSE rope.Fetch[next];
SELECT nc
FROM
'\l, '\r, >' => RETURN [end, blank];
ENDCASE => end ← DLoc[end, 1];
ENDLOOP};
'; => RETURN [SetWhere[end, rope.SkipTo[end.where.SUCC, "\l\r"].PRED], blank];
'( => RETURN [end, openList];
') => RETURN [end, closeList];
'\', '` => RETURN [end, quote];
', => RETURN [DLoc[end, IF GetOrSpace[end.where.SUCC]='@ THEN 1 ELSE 0], quote];
'" => RETURN [FwdOverString[end], leaf];
'# =>
SELECT GetOrSpace[end.where.
SUCC]
FROM
'" => RETURN [FwdOverString[DLoc[end, 1]], leaf];
'( => RETURN [DLoc[end, 1], openVector];
'\\ => RETURN [FwdOverId[DLoc[end, 2]], leaf];
ENDCASE => RETURN [FwdOverId[end], leaf];
'\\ => RETURN [end, leaf];
ENDCASE => RETURN [FwdOverId[end], leaf];
};
ToTokenStart:
PROC [loc: Loc, tamed:
BOOL]
RETURNS [start: Loc, type: TokeType] ~ {
rope: ROPE ~ loc.rope;
size: INT ~ loc.size;
GetOrSpace:
PROC [i:
INT]
RETURNS [
CHAR]
~ INLINE {RETURN [IF i<0 OR i>=size THEN ' ELSE rope.Fetch[i]]};
start ← loc;
IF start.node.comment THEN RETURN [SetWhere[start, 0], blank];
IF start.where >= size THEN RETURN [start, blank];
IF
NOT tamed
THEN {
Assume no token crosses lines; find beginning of line.
WHILE start.where>0
DO
prev: INT ~ start.where.PRED;
SELECT rope.Fetch[prev]
FROM
'\r, '\l => EXIT;
ENDCASE => start ← DLoc[start, -1];
ENDLOOP;
Parse forward, returning the token that contains loc.
DO
end: Loc;
[end, type] ← ParseWholeToken[start];
IF end.where >= loc.where THEN RETURN [start, type];
start ← DLoc[end, 1];
ENDLOOP;
};
{c: CHAR ← rope.Fetch[loc.where];
IF loc.where>0
AND c<='
AND c#'\l
AND c#'\r
THEN
WHILE loc.where>0
DO
prev: INT ~ loc.where.PRED;
pc: CHAR ~ rope.Fetch[prev];
IF pc>' OR pc='\l OR pc='\r THEN EXIT;
loc ← DLoc[loc, -1]; ENDLOOP;
IF CcAt[rope, size, loc.where] THEN RETURN [DLoc[loc, -2], leaf];
{pc: CHAR ~ GetOrSpace[loc.where.PRED];
SELECT c
FROM
<=' => RETURN [loc, blank];
'\\ => RETURN [IF CcAt[rope, size, loc.where.SUCC] THEN DLoc[loc, -1] ELSE loc, leaf];
') => RETURN [loc, closeList];
'( =>
SELECT
TRUE
FROM
pc#'# => RETURN [loc, openList];
CcAt[rope, size, loc.where.PRED] => RETURN [loc, openList];
ENDCASE => RETURN [DLoc[loc, -1], openVector];
'# => RETURN [loc, IF GetOrSpace[loc.where.SUCC]='( THEN openVector ELSE leaf];
'" => {ss: Loc ~ BackOverString[loc];
SELECT
TRUE
FROM
GetOrSpace[ss.where.PRED]#'# => RETURN [ss, leaf];
CcAt[rope, size, ss.where.PRED] => RETURN [ss, leaf];
ENDCASE => RETURN [DLoc[ss, -1], leaf]};
'\', '`, ', => RETURN [loc, quote];
'@ =>
IF pc=',
AND
NOT CcAt[rope, size, loc.where.
PRED]
THEN RETURN [DLoc[loc, -1], quote]
ELSE RETURN BackOverId[loc];
'; => ERROR;
ENDCASE => RETURN BackOverId[loc]}}};
CcAt:
PROC [rope:
ROPE, size, ccl:
INT]
RETURNS [
BOOL] ~ {
ifMism: BOOL ← FALSE;
IF ccl >= size THEN RETURN [FALSE];
DO
IF ccl < 2
THEN
RETURN [ifMism];
IF rope.Fetch[ccl-1]#'\\ OR rope.Fetch[ccl-2]#'# THEN RETURN [ifMism];
ifMism ← NOT ifMism; ccl ← ccl - 2;
ENDLOOP};
BackOverId:
PROC [end: Loc]
RETURNS [start: Loc, type: TokeType] ~ {
rope: ROPE ~ end.rope; size: INT ~ end.size;
start ← end;
DO prev:
INT ~ start.where.
PRED;
IF prev<0 THEN RETURN [SetWhere[start, 0], leaf];
IF CcAt[rope, size, prev] THEN RETURN [SetWhere[start, prev-2], leaf];
SELECT rope.Fetch[prev]
FROM
<=' , '(, '), '\', '`, ',, '\\ => RETURN [start, leaf];
'# => RETURN [SetWhere[start, prev], leaf];
'@ =>
IF prev=0
OR rope.Fetch[prev-1]#',
THEN start ←
DLoc[start, -1]
ELSE IF CcAt[rope, size, prev-1] THEN RETURN [SetWhere[start, prev], leaf]
ELSE RETURN [SetWhere[start, prev-1], quote];
'; => ERROR;
ENDCASE => start ← DLoc[start, -1];
ENDLOOP};
BackOverString:
PROC [end: Loc]
RETURNS [start: Loc] ~ {
rope: ROPE ~ end.rope; size: INT ~ end.size;
start ← DLoc[end, -1];
WHILE start.where > 0
DO
c: CHAR ~ rope.Fetch[start.where];
SELECT c
FROM
'\\, '" => {next: Loc; odd:
BOOL;
[next, odd] ← BackOverSlashes[start];
IF odd OR c#'" THEN start ← next ELSE RETURN};
ENDCASE => start ← DLoc[start, -1];
ENDLOOP;
RETURN [SetWhere[end, 0]]};
BackOverSlashes:
PROC [end: Loc]
RETURNS [start: Loc, odd:
BOOL ←
FALSE] ~ {
DO
end ← DLoc[end, -1];
IF end.where<0 OR end.rope.Fetch[end.where] # '\\ THEN RETURN [end, odd];
odd ← NOT odd;
ENDLOOP};
FindGroupBegin:
PROC [end: Loc]
RETURNS [start: Loc, railed:
BOOL] ~ {
depth: INT ← 1;
start ← end;
DO
tamed: BOOL;
type: TokeType;
[railed, tamed, start] ← BwdLoc[start];
IF railed THEN RETURN;
[start, type] ← ToTokenStart[start, tamed];
SELECT type
FROM
openList, openVector => IF (depth ← depth.PRED) = 0 THEN RETURN;
closeList => depth ← depth.SUCC;
leaf, blank, quote => NULL;
ENDCASE => ERROR;
ENDLOOP};
PrevNonBlank:
PROC [end: Loc]
RETURNS [start: Loc, type: TokeType ← blank, railed:
BOOL] ~ {
start ← end;
DO
tamed: BOOL;
[railed, tamed, start] ← BwdLoc[start];
IF railed THEN RETURN;
[start, type] ← ToTokenStart[start, tamed];
SELECT type
FROM
blank => NULL;
ENDCASE => RETURN;
ENDLOOP};
FindGroupEnd:
PROC [start: Loc]
RETURNS [end: Loc, railed:
BOOL] ~ {
depth: INT ← 1;
end ← start;
DO
type: TokeType;
[railed, end] ← FwdLoc[end];
IF railed THEN RETURN;
[end, type] ← ParseWholeToken[end];
SELECT type
FROM
closeList => IF (depth ← depth.PRED) = 0 THEN RETURN;
openList, openVector => depth ← depth.SUCC;
leaf, blank => NULL;
quote => end ← FindQuoteEnd[end];
ENDCASE => ERROR;
ENDLOOP};
FindQuoteEnd:
PROC [start: Loc]
RETURNS [end: Loc] ~ {
railed: BOOL;
type: TokeType;
[railed, end] ← FwdLoc[start];
IF railed THEN RETURN [end];
[end, type] ← ParseWholeToken[end];
SELECT type
FROM
leaf => RETURN [end];
blank, quote => RETURN FindQuoteEnd[end];
openList, openVector => RETURN [FindGroupEnd[end].end];
closeList => RETURN [start];
ENDCASE => ERROR};
FwdLoc:
PROC [loc: Loc]
RETURNS [railed:
BOOL, nl: Loc] ~ {
nw: INT ~ loc.where.SUCC;
IF nw < loc.size
THEN {
loc.where ← nw;
loc.idx ← loc.idx.SUCC;
RETURN [FALSE, loc]};
IF nw # (IF loc.size#0 THEN loc.size ELSE 1) THEN ERROR;
nl.node ← TextNode.StepForward[loc.node];
IF nl.node=NIL THEN RETURN [TRUE, loc];
IF TextEditExtras.HasCharSets[nl.node] THEN SetNot0[nl.node];
nl.rope ← TextEditExtras.GetString[nl.node];
nl ← [nl.node, NIL, nl.rope, nl.rope.Length, 0, loc.idx+2];
IF loc.size=0 THEN nl.idx ← nl.idx.PRED;
railed ← FALSE};
BwdLoc:
PROC [loc: Loc]
RETURNS [railed, tamed:
BOOL, nl: Loc] ~ {
IF loc.where > 0
THEN {
c: CHAR ~ loc.rope.Fetch[loc.where];
loc.where ← loc.where.PRED;
loc.idx ← loc.idx.PRED;
RETURN [FALSE, c#'\l AND c#'\r, loc]};
IF loc.where < 0 THEN ERROR;
[nl.node, nl.parent] ← TextNode.Backward[loc.node, loc.parent];
IF nl.node=NIL THEN RETURN [TRUE, TRUE, loc];
IF TextEditExtras.HasCharSets[nl.node] THEN SetNot0[nl.node];
nl.rope ← TextEditExtras.GetString[nl.node];
nl.size ← nl.rope.Length[];
nl.where ← nl.size-1;
nl.idx ← loc.idx-2;
IF nl.where=-1 THEN {nl.where ← 0; nl.idx ← nl.idx.SUCC};
railed ← tamed ← FALSE};
NImport:
PROC [tnl: TextNode.Location, root: TextNode.Ref]
RETURNS [Loc]
~ {RETURN Import[tnl, root]};
Import:
PROC [tnl: TextNode.Location, root: TextNode.Ref]
RETURNS [Loc] ~
INLINE {
r: ROPE ~ TextEditExtras.GetString[tnl.node];
s: INT ~ r.Length[];
IF TextEditExtras.HasCharSets[tnl.node] THEN SetNot0[tnl.node];
tnl.where ← MAX[0, MIN[tnl.where, s-1]];
RETURN [[tnl.node, NIL, r, s, tnl.where, TextNode.LocOffset[[root, 0], tnl] ]]};
Export:
PROC [loc: Loc]
RETURNS [TextNode.Location]
~ INLINE {RETURN [[loc.node, loc.where]]};
LocOffset:
PROC [loc1, loc2: Loc]
RETURNS [
INT]
~ {RETURN [TextNode.LocOffset[Export[loc1], Export[loc2]]]};
DLoc:
PROC [loc: Loc, d:
INT]
RETURNS [Loc]
~ INLINE {RETURN [[loc.node, loc.parent, loc.rope, loc.size, loc.where+d, loc.idx+d]]};
SetWhere:
PROC [loc: Loc, w:
INT]
RETURNS [Loc]
~ INLINE {RETURN [[loc.node, loc.parent, loc.rope, loc.size, w, loc.idx+w-loc.where]]};
SetInsertion:
PROC [sel: TEditDocument.Selection, x, line:
INTEGER, rightOfLine:
BOOLEAN, tdd: TEditDocument.TEditDocumentData]
RETURNS [TEditDocument.BeforeAfter] = {
--copied from TEditMouseImpl, 'cause not exported
node: TextNode.RefTextNode ← sel.start.pos.node;
size: TextNode.Offset ← TextEdit.Size[node];
IF sel.start.line=sel.end.line AND sel.start.pos.where>=size THEN RETURN [before];
This ensures caret before in empty nodes.
SELECT TEditProfile.selectionCaret
FROM
before =>
RETURN[
caret goes before unless making single character selection to right of last character in node
IF sel.start.pos=sel.end.pos AND sel.granularity=char AND rightOfLine AND tdd.lineTable.lines[line].end=eon THEN after ELSE before];
after =>
RETURN[
caret goes after unless making single character selection to left of middle of first character in node
IF sel.start.pos.where=0 AND sel.start.pos=sel.end.pos AND sel.granularity=char AND x-sel.start.x <= sel.end.x+sel.end.w-x THEN before ELSE after];
ENDCASE;
IF sel.start.line=line
THEN {
IF sel.end.line#line THEN RETURN [before];
IF sel.start.pos.where>=size THEN RETURN [before];
IF rightOfLine
THEN {
BlankAt:
PROC [offset:
INT]
RETURNS [
BOOL] ~
INLINE
--gfi saver-- {
char: Char.XCHAR;
char ← TextEdit.FetchChar[node, offset];
RETURN CharOps.XBlank[char]};
RETURN [
IF sel.start.pos=sel.end.pos
-- single char selection
AND sel.start.pos.where+1 < size -- not last char in node
AND BlankAt[sel.start.pos.where]
THEN before ELSE after];
};
RETURN[IF x-sel.start.x <= sel.end.x+sel.end.w-x THEN before ELSE after];
}
ELSE IF sel.end.line=line THEN RETURN[after];
RETURN[IF line-sel.start.line <= sel.end.line-line THEN before ELSE after];
};
AbortSecondary:
PROC = {
--copied from TEditInputImpl, 'cause not exported
SimpleFeedback.Append[$SchemeSelect, oneLiner, $Error, "Make a primary selection first."];
SimpleFeedback.Blink[$SchemeSelect, $Error];
TEditInput.editState ← abort; TEditInputBackdoor.mouseColor ← dead
};
LocklessDoSelect:
PROC [proc:
PROC [tSel, refSel: TEditDocument.Selection, rightOfLine:
BOOL], viewer: Viewer, tdd: TEditDocument.TEditDocumentData, x, y:
INTEGER, sel: TEditDocument.SelectionId] = {
--cloned from TEditMouseImpl.DoSelect on May 25, 1990
refSel: TEditDocument.Selection =
SELECT sel
FROM
primary => TEditSelection.pSel,
secondary => TEditSelection.sSel,
feedback => TEditSelection.fSel,
ENDCASE => ERROR;
tSel: TEditDocument.Selection;
rightOfLine: BOOL ← FALSE;
tSel ← TEditSelection.Alloc[];
rightOfLine ← TEditSelectionPrivate.ResolveToChar[tSel, viewer, tdd, x, y];
proc[tSel, refSel, rightOfLine];
TEditSelection.Free[tSel]
};
Register:
PROC [name:
ATOM, cmd: CmdPrivate] ~ {
TEditInputExtras.RegisterClosure[[name, SelectCmd, NEW [CmdPrivate ← cmd] ]];
RETURN};
Register[$SchemeSelect0, [FALSE, FALSE, 0]];
Register[$SchemeSelect1, [FALSE, FALSE, 1]];
Register[$SchemeSelect2, [FALSE, FALSE, 2]];
Register[$SchemeSelect3, [FALSE, FALSE, 3]];
Register[$TrackSchemeSelect0, [FALSE, TRUE, 0]];
Register[$TrackSchemeSelect1, [FALSE, TRUE, 1]];
Register[$ExtendSchemeSelect, [TRUE, FALSE, 0]];
END.