-- TEditTypeScriptImpl.mesa
Last Edited by: Paxton, January 10, 1983 11:39 am
Last Edited by: Plass, October 12, 1983 9:21 am
DIRECTORY
FileIO USING [Open, OpenFailed],
IO USING [STREAM, Close],
ImplErrors USING [UserErrorQuery],
InputFocus USING [GetInputFocus, SetInputFocus],
Menus USING [Menu, ParseDescription, AlreadyRegistered, RegisterMenu, ReRegisterMenu],
MessageWindow USING [Append, Blink],
Process USING [Detach, EnableAborts, MsecToTicks, SecondsToTicks, SetTimeout, Ticks],
Rope USING [Concat, Fetch, FromProc, Length, ROPE, Size, Substr],
RopeEdit USING [Concat, InsertChar],
RopeFrom USING [Stream],
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],
TEditCompile USING [minAvgLineLeading],
TEditDocument USING [LineTable, LineTableRec, RecordViewerForRoot, Selection, SelectionRec, SpinAndLock, TEditDocumentData, TEditDocumentDataRec, TSInfoRec, ttyChars, Unlock],
TEditImpl, -- exports
TEditInput USING [currentEvent, BadMouse, CommandProc, DontDoIt, FreeTree, InterpretAtom, Register, ResetInputStuff, SaveCoords],
TEditInputOps, -- USING Lots
TEditLocks USING [Lock, LockRef, Unlock],
TEditProfile USING [editTypeScripts],
TEditRefresh USING [ScrollToEndOfDoc],
TEditSelection, -- USING Lots
TEditTouchup USING [LockAfterScroll, UnlockAfterRefresh],
TIPUser USING [RegisterTIPPredicate, TIPPredicate, TIPScreenCoords, TIPTable],
TypeScript,
ViewerClasses USING [InitProc, NotifyProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerOps USING [AddProp, CreateViewer, EnumerateChildren, EnumerateViewers, FetchProp, IsClass, RegisterViewerClass];
TEditTypeScriptImpl: CEDAR MONITOR
IMPORTS IO, FileIO, ImplErrors, InputFocus, Menus, MessageWindow, Process, Rope, RopeEdit, RopeFrom, TextEdit, TextLooks, TextNode, TEditDocument, TEditImpl, TEditInput, TEditInputOps, TEditLocks, TEditProfile, TEditRefresh, TEditSelection, TEditTouchup, TIPUser, ViewerOps
EXPORTS TypeScript, TEditImpl
SHARES Rope, ViewerClasses =
BEGIN OPEN TEditDocument, TypeScript, TEditImpl;
ROPE: TYPE ~ Rope.ROPE;
Create:
PUBLIC
PROC [info: ViewerClasses.ViewerRec, paint:
BOOL ←
TRUE]
RETURNS [ts:
TS] =
BEGIN
tdd: TEditDocument.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;
TEditDocument.RecordViewerForRoot[self,tdd.text];
TEditDocument.Unlock[tdd];
END;
------------------ TTY PUT ROUTINES ------------------
aLittleWhile: Process.Ticks = Process.MsecToTicks[50];
untilTimesOutInALittleWhile: CONDITION;
PutChar:
PUBLIC
PROC [ts:
TS, char:
CHARACTER] = {
IF char=1C THEN BackSpace[ts] ELSE 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 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.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
WHILE editRepaintProcess#NIL DO WAIT repaintDone; ENDLOOP;
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] =
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
WHILE editRepaintProcess#NIL DO WAIT repaintDone; ENDLOOP;
SELECT look
FROM
IN ['a..'z] => tdd.tsInfo.looks[look] ← TRUE;
IN ['A..'Z] => tdd.tsInfo.looks[look] ← 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 };
WHILE editRepaintProcess#NIL DO WAIT repaintDone; ENDLOOP;
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;
WHILE editRepaintProcess#NIL DO WAIT repaintDone; ENDLOOP;
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;
WHILE editRepaintProcess#NIL DO WAIT repaintDone; ENDLOOP;
IF tdd.tsInfo=NIL THEN RETURN; -- not a typescript
tdd.tsInfo.looks ← TextLooks.noLooks };
GetLooks:
PUBLIC
ENTRY
PROC [ts:
TS]
RETURNS [looks:
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;
WHILE editRepaintProcess#NIL DO WAIT repaintDone; ENDLOOP };
------------------ BACKGROUND UPDATES ------------------
editRepaintProcess: PROCESS ← NIL;
repaintDone: CONDITION;
bufferClear: CONDITION;
bufferMaxlen: CARDINAL = 64;
inputBuffer: REF TEXT ← NEW[TEXT[bufferMaxlen]];
overflowRope: 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
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;
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
WITH params.first
SELECT
FROM
z: REF CHARACTER => {ForceInsertSel[self]; InputChar[self, z^]};
z:
ATOM => {
Flush[self];
InterpretAtom[self, z ! TEditInput.DontDoIt, TEditInput.BadMouse => EXIT] };
z: 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 => {
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] =
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.FromProc[num, Char];
inputRope ← Rope.Concat[inputRope, rope];
iQp ← oQp ← 0 };
InputRope:
ENTRY
PROC [ts:
TS, 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:
CHARACTER] =
BEGIN
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocumentData = NARROW[ts.data];
size: INT;
IF tdd #
NIL
THEN {
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
ABORTED;
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];
};
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
ABORTED;
raise error if viewer destroyed. Timeout for condition is set above
ENDLOOP;
};
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;
};
------------------ Tip Table ------------------
typeScriptTIP: PUBLIC TIPUser.TIPTable; -- init below
ReloadTypeScriptTipTable:
PUBLIC
PROC =
BEGIN
newTIP: TIPUser.TIPTable ←
ReloadTable[typeScriptTIP, "TypeScriptTIP",
IF TEditProfile.editTypeScripts
THEN
"EditTypeScript.tip Tioga.tip"
ELSE "TypeScript.tip"];
IF newTIP #
NIL
THEN {
changeTip:
PROC [v: ViewerClasses.Viewer]
RETURNS [
BOOL ←
TRUE] = {
IF v.class.flavor = $Typescript
THEN {
tdd: TEditDocumentData ← NARROW[v.data];
v.tipTable ← typeScriptTIP
}
ELSE
IF ViewerOps.IsClass[v, $Container]
THEN {
ViewerOps.EnumerateChildren[v, changeTip];
};
RETURN [TRUE]
};
tsClass.tipTable ← typeScriptTIP ← newTIP;
ViewerOps.EnumerateViewers[changeTip] }
END;
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 ------------------
UserAbort:
PUBLIC
PROC [ts:
TS]
RETURNS [abort:
BOOL] =
BEGIN
tdd: TEditDocumentData ← NARROW[ts.data];
IF tdd = NIL THEN RETURN;
RETURN[tdd.tsInfo.abort];
END;
ResetUserAbort:
PUBLIC
PROC [ts:
TS] =
BEGIN
tdd: TEditDocumentData ← NARROW[ts.data];
IF tdd = NIL THEN RETURN;
tdd.tsInfo.abort ← FALSE;
END;
SetUserAbort:
PUBLIC
PROC [ts:
TS] =
BEGIN
tdd: TEditDocumentData ← NARROW[ts.data];
IF tdd = NIL THEN RETURN;
tdd.tsInfo.abort ← TRUE;
END;
------------------ TTY CLASS DEFN ------------------
RegisterTypescriptMenu:
PROC ~ {
stream: IO.STREAM ← FileIO.Open["typescript.menu" ! FileIO.OpenFailed => GOTO Quit];
rope: ROPE ← RopeFrom.Stream[stream];
menus: LIST OF Menus.Menu ← Menus.ParseDescription[rope];
FOR m:
LIST
OF Menus.Menu ← menus, m.rest
UNTIL m =
NIL
DO
IF NOT Menus.AlreadyRegistered[m.first.name] THEN Menus.RegisterMenu[m.first]
ELSE Menus.ReRegisterMenu[m.first];
ENDLOOP;
IO.Close[stream];
EXITS Quit => NULL;
};
tsClass: ViewerClasses.ViewerClass ←
NEW[ViewerClasses.ViewerClassRec];
tsClass.init ← InitTypeScriptDocument;
tsClass.notify ← TypeScriptNotifyProc;
tsClass.icon ← typescript;
tsClass.menus ← LIST[$typescriptMenu];
ReloadTypeScriptTipTable[];
ViewerOps.RegisterViewerClass[$Typescript, tsClass, $Text];
TIPUser.RegisterTIPPredicate[$CaretAtEndOfTypescript, CaretAtEndOfTypescript];
TEditInput.Register[$ApplyTypeScriptLook, ApplyTypeScriptLook];
TEditInput.Register[$RemoveTypeScriptLook, RemoveTypeScriptLook];
TRUSTED {Process.SetTimeout[@untilTimesOutInALittleWhile, aLittleWhile]};
TRUSTED {Process.SetTimeout[@bufferClear, aLittleWhile]};
END.