TEditTypeScriptImpl.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Paxton, January 10, 1983 11:39 am
Plass, April 20, 1983 8:31 am
Russ Atkinson, June 12, 1984 5:44:23 pm PDT
Paul Rovner, September 30, 1983 11:52 am
Doug Wyatt, November 16, 1984 11:22:56 am PST
DIRECTORY
DefaultRemoteNames USING [Get],
ImplErrors USING [UserErrorQuery],
InputFocus USING [GetInputFocus, SetInputFocus],
Menus USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
MessageWindow USING [Append, Blink],
Process USING [Detach, EnableAborts, MsecToTicks, SecondsToTicks, SetTimeout, Ticks],
ProcessExtras USING [CheckForAbort],
Rope USING [Cat, Concat, Fetch, FromProc, Length, ROPE, Size, Substr],
RopeEdit USING [Concat, InsertChar],
TEditCompile USING [minAvgLineLeading],
TEditDocument USING [LineTable, LineTableRec, RecordViewerForRoot, Selection, SelectionRec, SpinAndLock, TEditDocumentData, TEditDocumentDataRec, TSInfoRec, ttyChars, Unlock],
TEditImpl USING [ReloadTable, TEditNotifyProc],
TEditInput USING [BadMouse, CommandProc, currentEvent, DontDoIt, FreeTree, InterpretAtom, Register, ResetInputStuff, SaveCoords],
TEditInputOps USING [EditFailed],
TEditLocks USING [Lock, LockRef, Unlock],
TEditProfile USING [editTypeScripts],
TEditRefresh USING [ScrollToEndOfDoc],
TEditSelection USING [Alloc, Copy, Free, InsertionPoint, LockSel, MakePointSelection, MakeSelection, pSel, SelectionRoot, SetSelLooks, UnlockSel],
TEditSplit USING [Split],
TEditTouchup USING [LockAfterScroll, UnlockAfterRefresh],
TextEdit USING [DeleteText, DocFromNode, FromRope, InsertRope, InsertString, MaxOffset, Size],
TextLooks USING [Looks, LooksToRope, noLooks],
TextNode USING [FirstChild, LastLocWithin, Location, NarrowToTextNode, Offset, pZone, Ref, RefTextNode, StepForward],
TIPUser USING [RegisterTIPPredicate, TIPPredicate, TIPScreenCoords, TIPTable],
TypeScript USING [TS],
ViewerClasses USING [InitProc, Lock, NotifyProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerOps USING [AddProp, CreateViewer, EnumerateChildren, FetchProp, FetchViewerClass, RegisterViewerClass, SetMenu],
VirtualDesktops USING [EnumerateViewers];
TEditTypeScriptImpl: CEDAR MONITOR
IMPORTS DefaultRemoteNames, ImplErrors, InputFocus, Menus, MessageWindow, Process, ProcessExtras, Rope, RopeEdit, TextEdit, TextLooks, TextNode, TEditDocument, TEditImpl, TEditInput, TEditInputOps, TEditLocks, TEditProfile, TEditRefresh, TEditSelection, TEditSplit, TEditTouchup, TIPUser, ViewerOps, VirtualDesktops
EXPORTS TypeScript, TEditImpl
SHARES Rope, ViewerClasses =
BEGIN OPEN TEditDocument;
TS: TYPE = TypeScript.TS; -- = ViewerClasses.Viewer
Destroyed: PUBLIC ERROR [ts: TS] = CODE;
Create: PUBLIC PROC [info: ViewerClasses.ViewerRec, paint: BOOL ← TRUE] RETURNS [ts: TS] =
BEGIN OPEN TEditDocument;
tdd: TEditDocumentData ← NewData[];
info.data ← tdd;
ts ← ViewerOps.CreateViewer[$Typescript, info, paint];
END;
NewData: PROC [self: ViewerClasses.Viewer ← NIL] RETURNS [tdd: TEditDocumentData] = BEGIN
tdd ← NEW[TEditDocumentDataRec];
[] ← SpinAndLock[tdd, "TEditTypeScriptImplNewData"];
tdd.lineTable ← NEW[LineTableRec[MAX[2,
(IF self=NIL THEN 0 ELSE (self.ch/TEditCompile.minAvgLineLeading))+1]] ←
[lastLine: 0, lastY: 0, lines: NULL]];
tdd.tsInfo ← NEW[TSInfoRec];
tdd.text ← TextNode.NarrowToTextNode[TextEdit.DocFromNode[TextEdit.FromRope[""]]];
Unlock[tdd];
TRUSTED {Process.EnableAborts[@tdd.tsInfo.iIncr]};
TRUSTED {Process.SetTimeout[@tdd.tsInfo.iIncr, Process.SecondsToTicks[10]]}; -- so can test if destroyed
END;
InitTypeScriptDocument: ViewerClasses.InitProc = BEGIN OPEN TEditDocument;
tdd: TEditDocumentData;
InitTddText: PROC = {
IF tdd.text # NIL THEN TEditInput.FreeTree[tdd.text];
tdd.text ← TextNode.NarrowToTextNode[
TextEdit.DocFromNode[TextEdit.FromRope[""]]] };
InitLineTable: PROC = {
tdd.lineTable.lastLine ← 0;
tdd.lineTable[0].pos ← [TextNode.NarrowToTextNode[TextNode.FirstChild[tdd.text]], 0] };
IF InputFocus.GetInputFocus[].owner=self THEN InputFocus.SetInputFocus[];
IF self.link#NIL THEN BEGIN
-- make sure another link didn't already init
-- and if so, copy that data
otherInit: ViewerClasses.Viewer ← NIL;
otherTdd: TEditDocumentData;
tdd ← NARROW[self.data];
IF tdd = NIL THEN RETURN;
[] ← SpinAndLock[tdd, "InitTypeScriptDocument"];
FOR v: ViewerClasses.Viewer ← self.link, v.link UNTIL v=self DO
IF ~v.newVersion THEN {otherInit ← v; EXIT};
ENDLOOP;
IF otherInit=NIL OR (otherTdd ← NARROW[otherInit.data]) = NIL THEN InitTddText[] -- we're first
ELSE BEGIN -- somebody else already did the init
tdd.text ← otherTdd.text;
END;
InitLineTable[];
END
ELSE IF self.data=NIL THEN { -- first time we've seen this viewer
self.data ← tdd ← (IF self.parent=NIL THEN NewData[] ELSE NewData[self]);
IF tdd = NIL THEN RETURN;
[] ← SpinAndLock[tdd, "InitTypeScriptDocument"] }
ELSE BEGIN -- old viewer getting re-initialised
tdd ← NARROW[self.data];
IF tdd = NIL THEN RETURN;
[] ← SpinAndLock[tdd, "InitTypeScriptDocument"];
InitTddText[];
InitLineTable[];
END;
IF self.column#static AND self.parent=NIL THEN
ViewerOps.SetMenu[self, typescriptMenu, FALSE];
TEditDocument.RecordViewerForRoot[self,tdd.text];
Unlock[tdd];
END;
------------------ TTY PUT ROUTINES ------------------
aLittleWhile: Process.Ticks = Process.MsecToTicks[50];
untilTimesOutInALittleWhile: CONDITION;
dontWait: BOOL ← FALSE;
WaitForEditRepaintProcess: INTERNAL PROC[ts: TS] = INLINE {
WHILE editRepaintProcess#NIL DO
IF currentTS # ts THEN RETURN; -- no need to wait for editRepaintProcess
dontWait ← TRUE;
NOTIFY untilTimesOutInALittleWhile; -- no need to wait for a little while
WAIT repaintDone;
dontWait ← FALSE;
ENDLOOP;
};
PutChar: PUBLIC PROC [ts: TS, char: CHARACTER] = {
IF char=1C THEN BackSpace[ts] ELSE {ProcessExtras.CheckForAbort[]; PutCharEntry[ts, char]}};
PutCharEntry: ENTRY PROC [ts: TS, char: CHARACTER] = BEGIN
ENABLE UNWIND => NULL; -- release lock
count: INTEGER ← 0;
IF (editRepaintProcess#NIL AND currentTS#ts) THEN -- wait to flush buffer
WHILE editRepaintProcess#NIL DO ProcessExtras.CheckForAbort[]; WAIT repaintDone ENDLOOP;
currentTS ← ts;
WHILE inputBuffer.length>=bufferMaxlen DO
IF (count ← count+1) > 10 THEN { -- waited long enough
i: CARDINAL ← 0;
Char: PROC RETURNS [c: CHAR] = { c ← inputBuffer[i]; i ← i+1 };
rope: Rope.ROPE ← Rope.FromProc[inputBuffer.length, Char];
overflowRope ← Rope.Concat[overflowRope, rope];
inputBuffer.length ← 0;
EXIT };
BROADCAST untilTimesOutInALittleWhile; -- wake up the repaint process
WAIT bufferClear;
ENDLOOP;
inputBuffer[inputBuffer.length] ← char;
inputBuffer.length ← inputBuffer.length + 1;
IF editRepaintProcess = NIL
THEN TRUSTED {Process.Detach[editRepaintProcess ← FORK Repaint[ts]]};
END;
BackSpace: PUBLIC ENTRY PROC [ts: TS, count: INT ← 1] = BEGIN OPEN TEditSelection;
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
root: TextNode.Ref;
selLock: BOOL;
lockRef: TEditLocks.LockRef;
Cleanup: PROC = {
IF lockRef # NIL THEN { TEditLocks.Unlock[root]; lockRef ← NIL };
IF selLock THEN TEditSelection.UnlockSel[primary] };
IF tdd = NIL THEN RETURN;
root ← tdd.text;
BEGIN
ENABLE UNWIND => Cleanup;
flush: TextNode.Location;
node: TextNode.RefTextNode;
IF count <= 0 THEN RETURN;
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
WaitForEditRepaintProcess[ts];
TEditSelection.LockSel[primary, "TEditTypeScriptImplBackSpace"];
see if pSel is in this typescript
IF NOT (selLock ← TEditSelection.SelectionRoot[pSel]=root) THEN
TEditSelection.UnlockSel[primary];
lockRef ← TEditLocks.Lock[root, "TEditTypeScriptImplBackSpace"];
flush ← TextNode.LastLocWithin[root];
IF (node ← TextNode.NarrowToTextNode[flush.node])=NIL THEN GOTO Bad;
IF (count ← MIN[count,flush.where]) <= 0 THEN GOTO Bad;
flush.where ← flush.where-count;
TextEdit.DeleteText[root, node, flush.where, count, TEditInput.currentEvent];
IF selLock THEN FixPSel[ts, [flush.node, flush.where+count], flush];
Cleanup[];
EXITS Bad => { Cleanup[]; TEditInputOps.EditFailed[] };
END END;
PutRope: PUBLIC PROC [ts: TS, rope: Rope.ROPE] = BEGIN
IF rope#NIL THEN FOR n: LONG INTEGER IN [0..Rope.Length[rope]) DO
PutChar[ts, Rope.Fetch[rope, n]];
ENDLOOP;
END;
PutText: PUBLIC PROC [ts: TS, text: REF READONLY TEXT, start: INTEGER ← 0,
stopPlusOne: INTEGER ← LAST[INTEGER]] = BEGIN
IF text#NIL THEN FOR n: INTEGER IN [start..MIN[text.length, stopPlusOne]) DO
PutChar[ts, text[n]];
ENDLOOP;
END;
ChangeLooks: PUBLIC ENTRY PROC [ts: TS, look: CHAR] = {
look char in 'a..'z means add that look; in 'A..'Z means remove; = blank means remove all looks
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd = NIL THEN RETURN;
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
WaitForEditRepaintProcess[ts];
SELECT look FROM
IN ['a..'z] => tdd.tsInfo.looks[look] ← TRUE;
IN ['A..'Z] => tdd.tsInfo.looks[look+('a-'A)] ← FALSE;
= ' => tdd.tsInfo.looks ← TextLooks.noLooks; -- blank means reset
ENDCASE;
};
AddLooks: PUBLIC ENTRY PROC [ts: TS, look: CHAR] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd = NIL THEN RETURN;
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
IF look NOT IN ['a..'z] THEN {
IF look = ' THEN tdd.tsInfo.looks ← TextLooks.noLooks; -- blank means reset
RETURN };
WaitForEditRepaintProcess[ts];
tdd.tsInfo.looks[look] ← TRUE };
RemoveLooks: PUBLIC ENTRY PROC [ts: TS, look: CHAR] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd = NIL THEN RETURN;
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
IF look NOT IN ['a..'z] THEN RETURN;
WaitForEditRepaintProcess[ts];
tdd.tsInfo.looks[look] ← FALSE };
ClearLooks: PUBLIC ENTRY PROC [ts: TS] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd = NIL THEN RETURN;
WaitForEditRepaintProcess[ts];
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
tdd.tsInfo.looks ← TextLooks.noLooks };
GetLooks: PUBLIC ENTRY PROC [ts: TS] RETURNS [looks: Rope.ROPE] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd = NIL THEN RETURN;
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
RETURN [TextLooks.LooksToRope[tdd.tsInfo.looks]] };
Flush: PUBLIC ENTRY PROC [ts: TS] = {
ENABLE UNWIND => NULL; -- release lock
IF ts # currentTS THEN RETURN;
WaitForEditRepaintProcess[ts] };
------------------ BACKGROUND UPDATES ------------------
editRepaintProcess: PROCESS ← NIL;
repaintDone: CONDITION;
bufferClear: CONDITION;
bufferMaxlen: CARDINAL = 64;
inputBuffer: REF TEXT ← NEW[TEXT[bufferMaxlen]];
overflowRope: Rope.ROPE;
currentTS: TS ← NIL;
RepaintDone: ENTRY PROC = { BROADCAST repaintDone };
Repaint: PROC [ts: TS] = BEGIN
Cannot make this an ENTRY procedure since must lock selection and document before enter the monitor. Else have deadlock with Copy to typescript which gets locks before calling InputRope.
tdd: TEditDocumentData;
root: TextNode.Ref;
pos: TextNode.Location;
lockRef: TEditLocks.LockRef;
selLock, continue: BOOL ← FALSE;
CheckForAutoScroll: PROC [ts: TS] = {
prop: REF BOOL;
tdd: TEditDocumentData ← NARROW[ts.data];
PosIsVisible: PROC [] RETURNS [BOOL] = {
lines: LineTable = tdd.lineTable;
IF lines[lines.lastLine].pos.where+lines[lines.lastLine].nChars >= pos.where
THEN RETURN [TRUE];
RETURN [FALSE] };
IF tdd = NIL THEN RETURN;
IF ~TEditTouchup.LockAfterScroll[tdd, "TEditTypeScriptImplRepaint"] THEN RETURN;
{ ENABLE UNWIND => TEditTouchup.UnlockAfterRefresh[tdd];
IF (prop ← NARROW[ViewerOps.FetchProp[ts, $AutoScrollTypescript]]) = NIL THEN
ViewerOps.AddProp[ts, $AutoScrollTypescript, prop ← TextNode.pZone.NEW[BOOL]];
prop^ ← PosIsVisible[] };
TEditTouchup.UnlockAfterRefresh[tdd] };
Cleanup: PROC = {
IF lockRef # NIL THEN TEditLocks.Unlock[root]; lockRef ← NIL;
IF selLock THEN TEditSelection.UnlockSel[primary]; selLock ← FALSE };
DoAutoScroll: PROC [ts: TS] = {
prop: REF BOOL = NARROW[ViewerOps.FetchProp[ts, $AutoScrollTypescript]];
IF prop#NIL AND prop^ THEN TEditRefresh.ScrollToEndOfDoc[ts, TRUE] };
WaitForMoreInput: ENTRY PROC RETURNS [BOOL] = {
ENABLE UNWIND => NULL;
IF overflowRope=NIL AND inputBuffer.length<bufferMaxlen THEN
IF dontWait THEN NULL ELSE WAIT untilTimesOutInALittleWhile;
IF overflowRope=NIL AND inputBuffer.length=0 THEN {
editRepaintProcess ← NIL; RETURN [FALSE]}; -- no new input
RETURN [TRUE] };
BEGIN
ENABLE BEGIN
UNWIND => Cleanup;
ABORTED => GOTO Quit;
ANY => IF ImplErrors.UserErrorQuery[] THEN CONTINUE;
END;
tdd ← NARROW[ts.data];
IF tdd = NIL THEN RETURN;
IF (root ← tdd.text)=NIL THEN { RepaintDone; RETURN };
lockRef ← TEditLocks.Lock[root, "TEditTypeScriptImplRepaint", read];
pos ← TextNode.LastLocWithin[root];
CheckForAutoScroll[ts];
IF ts.link # NIL THEN FOR v: ViewerClasses.Viewer ← ts.link, v.link UNTIL v=ts DO
CheckForAutoScroll[v]; ENDLOOP;
TEditLocks.Unlock[root]; lockRef ← NIL;
DO
TEditSelection.LockSel[primary, "TEditTypeScriptImplRepaint"];
see if pSel is in this typescript
IF NOT (selLock ← TEditSelection.SelectionRoot[TEditSelection.pSel]=root) THEN
TEditSelection.UnlockSel[primary];
lockRef ← TEditLocks.Lock[root, "TEditTypeScriptImplRepaint"];
continue ← MakeEdits[ts, selLock];
Cleanup;
DoAutoScroll[ts];
IF ts.link # NIL THEN FOR v: ViewerClasses.Viewer ← ts.link, v.link UNTIL v=ts DO
DoAutoScroll[v]; ENDLOOP;
IF ~continue OR ~WaitForMoreInput[] THEN EXIT;
ENDLOOP;
RepaintDone;
EXITS Quit => { Cleanup; RepaintDone };
END END;
updateSel: Selection ← NEW[SelectionRec];
tsMaxSize: INT ← 200000;
MakeEdits: ENTRY PROC [ts: TS, selLock: BOOL]
RETURNS [continue: BOOL] =
BEGIN OPEN TEditSelection;
ENABLE UNWIND => NULL;
tdd: TEditDocumentData = NARROW[ts.data];
node: TextNode.RefTextNode;
pos: TextNode.Location;
IF tdd=NIL THEN {overflowRope ← NIL; inputBuffer.length ← 0; editRepaintProcess ← NIL; RETURN [FALSE]};
IF overflowRope=NIL AND inputBuffer.length=0 THEN {editRepaintProcess ← NIL; RETURN [FALSE]};
pos ← TextNode.LastLocWithin[tdd.text];
node ← TextNode.NarrowToTextNode[pos.node];
IF overflowRope#NIL THEN
[] ← TextEdit.InsertRope[
root: tdd.text, dest: node,
rope: overflowRope, destLoc: TextEdit.MaxOffset,
inherit: FALSE, looks: tdd.tsInfo.looks,
event: TEditInput.currentEvent];
[] ← TextEdit.InsertString[
root: tdd.text, dest: node, inherit: FALSE, looks: tdd.tsInfo.looks,
string: inputBuffer, destLoc: TextEdit.MaxOffset];
IF Rope.Size[node.rope] > tsMaxSize THEN { -- truncate the typescript
half: TextNode.Offset ← tsMaxSize;
head, prefix: Rope.ROPE;
Reset: PROC [ts: TS] = {
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd = NIL THEN RETURN;
tdd.lineTable[0].pos ← [node,0];
tdd.lineTable[0].valid ← FALSE };
FOR i: TextNode.Offset ← half, i-1 DO -- back up to line break
IF i < tsMaxSize-100 OR Rope.Fetch[node.rope,i-1] = 15C THEN { half ← i; EXIT };
ENDLOOP;
head ← Rope.Substr[node.rope,0,half];
prefix ← "*** Typescript Truncated ***\n\n";
TextEdit.DeleteText[root: tdd.text, text: node, start: 0, len: half];
[] ← TextEdit.InsertRope[root: tdd.text, dest: node, destLoc: 0, rope: prefix, inherit: FALSE];
Reset[ts];
IF ts.link # NIL THEN
FOR linked: TS ← ts.link, linked.link UNTIL linked=ts DO Reset[linked]; ENDLOOP;
};
IF selLock THEN FixPSel[ts, pos, TextNode.LastLocWithin[tdd.text]];
inputBuffer.length ← 0; overflowRope ← NIL;
BROADCAST bufferClear;
RETURN [TRUE];
END;
FixPSel: PROC [ts: TS, pos, newPos: TextNode.Location] = { OPEN TEditSelection;
FixSel: PROC = {
tSel: Selection ← Alloc[];
Copy[source: pSel, dest: tSel];
TEditSelection.MakePointSelection[tSel, newPos];
TEditSelection.SetSelLooks[pSel];
Free[tSel] };
IF pSel.granularity=point AND pSel.end.pos.where >= pos.where THEN
IF ts=pSel.viewer THEN FixSel[]
ELSE IF ts.link#NIL THEN FOR v: TS ← ts.link, v.link UNTIL v=ts DO
IF v=pSel.viewer THEN { FixSel[]; EXIT };
ENDLOOP };
------------------ KEYBOARD INPUT ------------------
CaretAtEnd: PUBLIC PROC [sel: Selection] RETURNS [yes: BOOL] = {
root: TextNode.Ref = TEditSelection.SelectionRoot[sel];
IF root=NIL THEN RETURN [FALSE]; -- not a valid selection
IF sel.granularity # point THEN RETURN [FALSE]; -- not a point selection
[] ← TEditLocks.Lock[root, "TEditTypeScriptImplCaretAtEnd", read];
need lock to synch with edits to typescript
{ caret: TextNode.Location = TEditSelection.InsertionPoint[sel];
node: TextNode.Ref = caret.node;
IF node=NIL OR TextNode.StepForward[node] # NIL THEN yes ← FALSE
ELSE IF caret.where # TextEdit.Size[TextNode.NarrowToTextNode[node]] THEN yes ← FALSE
ELSE yes ← TRUE;
TEditLocks.Unlock[root] }};
TypeScriptNotifyProc: ViewerClasses.NotifyProc = BEGIN
IF TEditProfile.editTypeScripts THEN {
tdd: TEditDocumentData = NARROW[self.data];
IF tdd = NIL THEN RETURN;
IF TEditSelection.SelectionRoot[TEditSelection.pSel]=tdd.text
AND ~CaretAtEnd[TEditSelection.pSel] THEN {
Caret in this typescript, but not at end. So treat like edit of normal Tioga doc.
TEditImpl.TEditNotifyProc[self, input]; RETURN }};
TEditInput.ResetInputStuff;
FOR params: LIST OF REF ANY ← input, params.rest UNTIL params=NIL DO
z: REF ANY ~ params.first;
WITH z SELECT FROM
z: REF CHARACTER => {ForceInsertSel[self]; InputChar[self, z^]};
z: ATOM => {
Flush[self];
InterpretAtom[self, z ! TEditInput.DontDoIt, TEditInput.BadMouse => EXIT] };
z: Rope.ROPE => {ForceInsertSel[self]; InputRope[self, z] };
z: REF INT => {
tdd: TEditDocumentData = NARROW[self.data];
IF tdd # NIL THEN tdd.tsInfo.intParam ← z^ };
z: REF TEXT => {ForceInsertSel[self];
FOR n: CARDINAL IN [0..z.length) DO InputChar[self, z[n]]; ENDLOOP};
z: TIPUser.TIPScreenCoords => TEditInput.SaveCoords[z.mouseX, self.ch-z.mouseY];
ENDCASE => IF z#NIL THEN { -- DKW: assume NIL was a ROPE
MessageWindow.Append["Unknown input given to Tioga typescript interpreter.", TRUE];
MessageWindow.Blink[] };
ENDLOOP;
END;
ForceInsertSel: PROC [ts: TS] = BEGIN OPEN TEditSelection;
IF pSel.viewer#ts OR (pSel.granularity=point AND pSel.insertion=before) THEN RETURN;
LockSel[primary, "TEditTypeScriptForceInsertSel"];
BEGIN ENABLE UNWIND => UnlockSel[primary];
IF pSel.viewer=ts AND (pSel.granularity#point OR pSel.insertion#before) THEN BEGIN
tSel: Selection ← Alloc[];
Copy[source: pSel, dest: tSel];
tSel.insertion ← before;
tSel.granularity ← point;
tSel.start.pos ← tSel.end.pos ← TextNode.LastLocWithin[tSel.data.text];
MakeSelection[new: tSel];
Free[tSel];
END;
UnlockSel[primary];
END END;
InterpretAtom: PROCEDURE [viewer: ViewerClasses.Viewer, atom: ATOM] =
BEGIN OPEN TEditInputOps, TEditSelection;
SELECT atom FROM
$Abort => SetUserAbort[viewer];
$ApplyCaretLook, $ApplyLook, $RemoveCaretLook, $RemoveLook => {
tdd: TEditDocumentData = NARROW[viewer.data];
IF tdd = NIL THEN RETURN;
TEditImpl.TEditNotifyProc[viewer,
TextNode.pZone.LIST[TextNode.pZone.NEW[INT ← tdd.tsInfo.intParam]]];
TEditInput.InterpretAtom[viewer,atom] };
$BackSpace => {ForceInsertSel[viewer]; InputChar[viewer, 1C]}; -- control A
$BackWord => {ForceInsertSel[viewer]; InputChar[viewer, 27C]}; -- control W
$ClearTypeScriptLooks => ClearLooks[viewer];
$Delete => {ForceInsertSel[viewer]; InputChar[viewer, 177C]}; -- DEL
$Paste => {ForceInsertSel[viewer]; TEditInput.InterpretAtom[viewer,atom]};
ENDCASE => TEditInput.InterpretAtom[viewer,atom];
END;
NumberToLook: PROC [viewer: ViewerClasses.Viewer] RETURNS [l: CHAR] = {
tdd: TEditDocumentData = NARROW[viewer.data];
IF tdd = NIL THEN RETURN['z];
RETURN['a+tdd.tsInfo.intParam] };
ApplyTypeScriptLook: TEditInput.CommandProc = {
WaitUntilIdle[viewer]; AddLooks[viewer, NumberToLook[viewer]] };
RemoveTypeScriptLook: TEditInput.CommandProc = {
WaitUntilIdle[viewer]; RemoveLooks[viewer, NumberToLook[viewer]] };
InsertRopeAtFrontOfBuffer: PUBLIC ENTRY PROC [ts: TS, rope: Rope.ROPE] = BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd # NIL THEN {OPEN tdd.tsInfo;
inputRope ← RopeEdit.Concat[rope, Rope.Substr[inputRope, inputLoc]];
inputLoc ← 0;
BROADCAST iIncr;
};
END;
InsertCharAtFrontOfBuffer: PUBLIC ENTRY PROC [ts: TS, char: CHARACTER] = BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd # NIL THEN {OPEN tdd.tsInfo;
inputRope ← RopeEdit.InsertChar[Rope.Substr[inputRope, inputLoc], char];
inputLoc ← 0;
BROADCAST iIncr;
};
END;
FlushInputChars: INTERNAL PROC [tdd: TEditDocumentData] = { OPEN tdd.tsInfo;
num: INT = IF iQp > oQp THEN iQp-oQp ELSE ttyChars-iQp+oQp;
Char: PROC RETURNS [c: CHAR] = {
c ← input[oQp]; oQp ← (oQp+1) MOD ttyChars };
rope: Rope.ROPE;
rope ← Rope.FromProc[num, Char];
inputRope ← Rope.Concat[inputRope, rope];
iQp ← oQp ← 0 };
InputRope: ENTRY PROC [ts: TS, rope: Rope.ROPE] = BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd # NIL THEN {OPEN tdd.tsInfo;
IF iQp # oQp THEN FlushInputChars[tdd];
inputRope ← RopeEdit.Concat[inputRope, rope];
BROADCAST iIncr;
};
END;
InputChar: ENTRY PROC [ts: TS, char: CHARACTER] = BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd # NIL THEN {OPEN tdd.tsInfo;
newiQp: INTEGER = (iQp+1) MOD ttyChars;
IF newiQp = oQp THEN FlushInputChars[tdd];
input[iQp] ← char; iQp ← newiQp;
BROADCAST iIncr;
};
END;
------------------ TTY GET ROUTINES ------------------
GetChar: PUBLIC ENTRY PROC [ts: TS] RETURNS [char: CHAR] = BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
size: INT;
IF tdd = NIL THEN RETURN['a] -- Hmm. used to return garbage. PDR
ELSE {OPEN tdd.tsInfo;
WHILE inputLoc >= (size ← Rope.Size[inputRope]) AND iQp = oQp DO
waitingInGetChar ← TRUE;
WAIT iIncr;
waitingInGetChar ← FALSE;
IF ts.destroyed THEN RETURN WITH ERROR Destroyed[ts];
raise error if viewer destroyed. Timeout for condition is set above
ENDLOOP;
IF inputLoc < size THEN { -- get char from rope
char ← Rope.Fetch[inputRope, inputLoc];
IF (inputLoc ← inputLoc+1)=size THEN { -- have finished this rope
inputLoc ← 0; inputRope ← NIL }}
ELSE { -- get from buffer
char ← input[oQp]; oQp ← (oQp+1) MOD ttyChars };
};
END;
CharsAvailable: PUBLIC ENTRY PROC [ts: TS] RETURNS [BOOL] = BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd = NIL THEN RETURN [FALSE]
ELSE {OPEN tdd.tsInfo;
IF tdd.tsInfo=NIL THEN RETURN [FALSE]; -- not a typescript
RETURN[inputLoc < Rope.Size[inputRope] OR iQp#oQp];
};
END;
WaitUntilCharsAvail: PUBLIC ENTRY PROC [ts: TS] = BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd # NIL THEN {OPEN tdd.tsInfo;
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
WHILE inputLoc >= Rope.Size[inputRope] AND iQp = oQp DO
waitingInGetChar ← TRUE;
WAIT iIncr;
waitingInGetChar ← FALSE;
IF ts.destroyed THEN RETURN WITH ERROR Destroyed[ts];
raise error if viewer destroyed. Timeout for condition is set above
ENDLOOP;
};
END;
WaitUntilIdle: PUBLIC ENTRY PROC [ts: TS] = BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
IF tdd # NIL THEN {OPEN tdd.tsInfo;
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
WHILE inputLoc < Rope.Size[inputRope] OR iQp#oQp OR ~waitingInGetChar DO
WAIT untilTimesOutInALittleWhile;
ENDLOOP;
};
END;
------------------ Tip Table ------------------
typeScriptTIP: PUBLIC TIPUser.TIPTable; -- init below
ReloadTypeScriptTipTable: PUBLIC PROC = {
RRA sez: This routine lets us try for the typescript TIP file on different hosts, depending on how the DefaultRemoteNames are set. We try both system and user hosts before giving up.
TryTable: PROC [host: Rope.ROPE] RETURNS [TIPUser.TIPTable] = {
tableNames: Rope.ROPE =
IF TEditProfile.editTypeScripts
THEN Rope.Cat[host, "<Tioga>TEdit>EditTypeScript.tip ", host, "<Tioga>TEdit>Tioga.tip"]
ELSE Rope.Concat[host, "<Tioga>TEdit>TypeScript.tip"];
RETURN [TEditImpl.ReloadTable[typeScriptTIP, "TypeScriptTIP", tableNames]];
};
newTIP: TIPUser.TIPTable ← TryTable[DefaultRemoteNames.Get[].systemHost];
IF newTIP = NIL THEN newTIP ← TryTable[DefaultRemoteNames.Get[].userHost];
IF newTIP # NIL THEN {
changeTip: PROC [v: ViewerClasses.Viewer] RETURNS [BOOL ← TRUE] = {
SELECT v.class.flavor FROM
$Typescript => {
tdd: TEditDocumentData ← NARROW[v.data];
v.tipTable ← typeScriptTIP };
$Container => ViewerOps.EnumerateChildren[v, changeTip];
ENDCASE;
RETURN [TRUE] };
tsClass.tipTable ← typeScriptTIP ← newTIP;
VirtualDesktops.EnumerateViewers[changeTip];
}
};
CaretAtEndOfTypescript: TIPUser.TIPPredicate --PROC RETURNS [BOOLEAN]-- = {
tdd: TEditDocumentData;
ts: TS ← TEditSelection.pSel.viewer;
IF ts=NIL THEN RETURN [FALSE]; -- no primary selection
tdd ← NARROW[ts.data];
IF tdd = NIL THEN RETURN [FALSE];
IF tdd.tsInfo=NIL THEN RETURN [FALSE]; -- not a typescript
RETURN [CaretAtEnd[TEditSelection.pSel]] };
------------------ USER ABORT ------------------
SetUserAbort: PROC [ts: TS] = BEGIN
tdd: TEditDocumentData ← NARROW[ts.data, TEditDocumentData];
IF tdd # NIL THEN tdd.tsInfo.abort ← TRUE;
END;
------------------ TTY CLASS DEFN ------------------
typescriptMenu: Menus.Menu ← Menus.CreateMenu[];
Split: Menus.MenuProc = {TEditSplit.Split[NARROW[parent]]};
findNext: LIST OF REF ANY = LIST[$FindNext];
findPrev: LIST OF REF ANY = LIST[$FindPrev];
Find: Menus.MenuProc = {viewer: ViewerClasses.Viewer ~ NARROW[parent];
viewer.class.notify[viewer, IF mouseButton=red THEN findNext ELSE findPrev]};
tsClass: ViewerClasses.ViewerClass ← -- just like Tioga's
NEW[ViewerClasses.ViewerClassRec ← ViewerOps.FetchViewerClass[$Text]^];
-- except for a couple of differences
tsClass.init ← InitTypeScriptDocument;
tsClass.notify ← TypeScriptNotifyProc;
tsClass.icon ← typescript;
ReloadTypeScriptTipTable[];
ViewerOps.RegisterViewerClass [$Typescript, tsClass];
TIPUser.RegisterTIPPredicate[$CaretAtEndOfTypescript, CaretAtEndOfTypescript];
TEditInput.Register[$ApplyTypeScriptLook, ApplyTypeScriptLook];
TEditInput.Register[$RemoveTypeScriptLook, RemoveTypeScriptLook];
Menus.AppendMenuEntry[typescriptMenu, Menus.CreateEntry["Find", Find]];
Menus.AppendMenuEntry[typescriptMenu, Menus.CreateEntry["Split", Split]];
TRUSTED {Process.SetTimeout[@untilTimesOutInALittleWhile, aLittleWhile]};
TRUSTED {Process.SetTimeout[@bufferClear, aLittleWhile]; Process.EnableAborts[@bufferClear]};
END.
DefaultCharProc: CharProc = BEGIN
SELECT char FROM
15C, 177C => RETURN [TRUE, TRUE];
ENDCASE  => RETURN [TRUE, FALSE];
END;
GetLine: PUBLIC PROC [ts: TS, actChar: BOOL ← FALSE, charProc: CharProc ← NIL]
RETURNS [line: Rope.ROPE] = BEGIN
process, activate: BOOL ← FALSE;
l: Rope.Text ← NEW[Rope.TextRep[1000]];
char: CHARACTER;
GetBiggerRope: PROC = BEGIN
new: Rope.Text ← NEW[Rope.TextRep[2*Rope.Size[l]]];
FOR i:INT IN [0..l.length) DO new[i] ← l[i]; ENDLOOP;
new.length ← l.length;
l ← new;
END;
AppendChar: PROC = INLINE BEGIN
IF l.length >= l.max THEN GetBiggerRope[];
TRUSTED {RopeInline.QStore[char, l, l.length]};
l.length ← l.length+1;
END;
l.length ← 0;
IF charProc = NIL THEN charProc ← DefaultCharProc;
UNTIL activate DO
char ← GetChar[ts];
[process, activate] ← charProc[ts, char];
IF process THEN SELECT char FROM
177C => {l.length ← 0; PutRope[ts, " XXX\n"]};
1C => IF l.length > 0 THEN BEGIN
BackSpace[ts];
l.length ← l.length - 1;
END;
27C => BEGIN
nChars: INT ← 0;
WHILE l.length>0 AND l[l.length-1]=' DO
nChars ← nChars + 1;
l.length ← l.length - 1;
ENDLOOP;
WHILE l.length>0 AND l[l.length-1]#' DO
nChars ← nChars + 1;
l.length ← l.length - 1;
ENDLOOP;
IF nChars > 0 THEN BackSpace[ts,nChars];
END;
ENDCASE => {PutChar[ts, char]; IF ~activate OR actChar THEN AppendChar[]}
ELSE IF ~activate OR actChar THEN AppendChar[];
ENDLOOP;
RETURN [l];
END;