DIRECTORY
Ascii USING [BS, ControlW, DEL],
InputFocus USING [GetInputFocus, SetInputFocus],
List USING [Memb],
Menus USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
MessageWindow USING [Append, Blink],
NodeProps USING [GetProp],
PFS USING [GetWDir, RopeFromPath],
Process USING [CheckForAbort, Detach, EnableAborts, GetCurrent, MsecToTicks, SecondsToTicks, SetTimeout, Ticks],
Rope USING [Cat, Concat, Fetch, FromChar, FromProc, FromRefText, Length, ROPE, Size, Substr],
RuntimeError USING [UNCAUGHT],
TEditCompile USING [minAvgLineLeading],
TEditDocument USING [LineTable, LineTableRec, RecordViewerForRoot, Selection, SelectionRec, SpinAndLock, TEditDocumentData, TEditDocumentDataRec, TSInfo, TSInfoRec, ttyChars, Unlock],
TEditPrivate 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, ReplaceByRope, Size],
TextLooks USING [allLooks, noLooks, ModifyLooks],
TextNode USING [FirstChild, LastLocWithin, Location, Ref, RefTextNode, StepForward],
Tioga USING [CharSet, Looks, PropList],
TIPUser USING [RegisterTIPPredicate, TIPPredicate, TIPScreenCoords, TIPTable],
TypeScript USING [],
ViewerClasses USING [InitProc, Lock, NotifyProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerGroupLocks USING [CallRootAndLinksUnderWriteLock],
ViewerOps USING [AddProp, CreateViewer, DestroyViewer, FetchProp, FetchViewerClass, RegisterViewerClass, SetMenu];
TEditTypeScriptImpl:
CEDAR
MONITOR
IMPORTS InputFocus, List, Menus, MessageWindow, NodeProps, PFS, Process, Rope, RuntimeError, TEditDocument, TEditPrivate, TEditInput, TEditInputOps, TEditLocks, TEditProfile, TEditRefresh, TEditSelection, TEditSplit, TEditTouchup, TextEdit, TextLooks, TextNode, TIPUser, ViewerGroupLocks, ViewerOps
EXPORTS
TEditPrivate
TypeScriptNotifyProc, CaretAtEnd, typeScriptTIP, ReloadTypeScriptTipTable
= BEGIN
ROPE: TYPE = Rope.ROPE;
TS: TYPE = ViewerClasses.Viewer;
CharSet: TYPE ~ Tioga.CharSet;
Looks: TYPE ~ Tioga.Looks;
PropList: TYPE ~ Tioga.PropList;
TSInfo: TYPE ~ TEditDocument.TSInfo;
Destroyed:
PUBLIC
ERROR [ts:
TS] =
CODE;
Create:
PUBLIC
PROC [info: ViewerClasses.ViewerRec, paint:
BOOL ¬
TRUE]
RETURNS [ts:
TS] = {
tdd: TEditDocument.TEditDocumentData ¬ NewData[];
info.data ¬ tdd;
ts ¬ ViewerOps.CreateViewer[$Typescript, info, paint];
};
IsATypeScript:
PUBLIC
PROC [ts:
TS]
RETURNS [yes:
BOOL] = {
RETURN [ts # NIL AND ts.class.flavor = $Typescript];
};
Destroy:
PUBLIC
PROC [ts:
TS] = {
ViewerOps.DestroyViewer[ts];
};
Reset:
PUBLIC
PROC [ts:
TS] = {
ts.class.init[ts];
};
NewData:
PROC [self: ViewerClasses.Viewer ¬
NIL]
RETURNS [tdd: TEditDocument.TEditDocumentData] = {
tdd ¬ NEW[TEditDocument.TEditDocumentDataRec];
[] ¬ TEditDocument.SpinAndLock[tdd, "TEditTypeScriptImplNewData"];
{ nLines:
NAT ~
MAX[2, (
IF self=
NIL
THEN 0
ELSE (self.ch/TEditCompile.minAvgLineLeading))+1];
lineTable: TEditDocument.LineTable ~ NEW[TEditDocument.LineTableRec[nLines]];
lineTable.lastLine ¬ 0; lineTable.lastY ¬ 0;
tdd.lineTable ¬ lineTable;
};
tdd.tsInfo ¬ NEW[TEditDocument.TSInfoRec];
tdd.text ¬ TextEdit.DocFromNode[TextEdit.FromRope[""]];
TEditDocument.Unlock[tdd];
TRUSTED {
Process.EnableAborts[@tdd.tsInfo.iIncr];
so can test if destroyed
Process.SetTimeout[@tdd.tsInfo.iIncr, Process.SecondsToTicks[10]];
};
};
InitTypeScriptDocument: ViewerClasses.InitProc = {
tdd: TEditDocument.TEditDocumentData;
InitTddText:
PROC = {
IF tdd.text # NIL THEN TEditInput.FreeTree[tdd.text];
tdd.text ¬ TextEdit.DocFromNode[TextEdit.FromRope[""]]
};
InitLineTable:
PROC = {
tdd.lineTable.lastLine ¬ 0;
tdd.lineTable[0].pos ¬ [TextNode.FirstChild[tdd.text], 0]
};
IF InputFocus.GetInputFocus[].owner=self THEN InputFocus.SetInputFocus[];
IF self.link#
NIL
THEN {
make sure another link didn't already init
and if so, copy that data
otherInit: ViewerClasses.Viewer ¬ NIL;
otherTdd: TEditDocument.TEditDocumentData;
tdd ¬ NARROW[self.data];
IF tdd = NIL THEN RETURN;
[] ¬ TEditDocument.SpinAndLock[tdd, "InitTypeScriptDocument"];
FOR v: ViewerClasses.Viewer ¬ self.link, v.link
UNTIL v=
NIL
OR 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 tdd.text ¬ otherTdd.text;
somebody else already did the init
InitLineTable[];
}
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;
[] ¬ TEditDocument.SpinAndLock[tdd, "InitTypeScriptDocument"]
}
ELSE {
old viewer getting re-initialised
tdd ¬ NARROW[self.data];
IF tdd = NIL THEN RETURN;
[] ¬ TEditDocument.SpinAndLock[tdd, "InitTypeScriptDocument"];
InitTddText[];
InitLineTable[];
};
IF self.column#static
AND self.parent=
NIL
THEN
ViewerOps.SetMenu[self, typescriptMenu, FALSE];
TEditDocument.RecordViewerForRoot[self, tdd.text];
TEditDocument.Unlock[tdd];
};
TTY PUT ROUTINES
aLittleWhile: Process.Ticks = Process.MsecToTicks[50];
aLongerWhile: Process.Ticks = Process.MsecToTicks[5000];
untilTimesOutInALittleWhile: CONDITION;
dontWait: BOOL ¬ FALSE;
WaitForEditRepaintProcess:
INTERNAL
PROC[ts:
TS] = {
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:
CHAR] = {
IF char=1C THEN { BackSpace[ts]; RETURN }; -- This should not be necessary; clients should call BackSpace
Process.CheckForAbort[];
PutCharEntry[ts, char ! ABORTED => GO TO abort];
EXITS abort => ERROR ABORTED;
};
PutCharEntry:
ENTRY
PROC [ts:
TS, char:
CHAR] = {
ENABLE UNWIND => NULL; -- release lock
count: INTEGER ¬ 0;
IF (editRepaintProcess#
NIL
AND currentTS#ts)
THEN {
wait to flush buffer
WHILE editRepaintProcess#
NIL
DO
Process.CheckForAbort[];
WAIT repaintDone;
ENDLOOP;
};
currentTS ¬ ts;
WHILE inputBuffer.length>=bufferMaxlen
DO
IF (count ¬ count+1) > 10
THEN {
waited long enough
overflowRope ¬ Rope.Concat[overflowRope, Rope.FromRefText[inputBuffer]];
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]];
};
};
BackSpace:
PUBLIC
ENTRY
PROC [ts:
TS, count:
INT ¬ 1] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocument.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
AND count > 0
AND tdd.tsInfo#
NIL
THEN {
ENABLE UNWIND => Cleanup;
flush: TextNode.Location;
node: TextNode.RefTextNode;
root ¬ tdd.text;
WaitForEditRepaintProcess[ts];
TEditSelection.LockSel[primary, "TEditTypeScriptImplBackSpace"];
see if pSel is in this typescript
IF NOT (selLock ¬ TEditSelection.SelectionRoot[TEditSelection.pSel]=root) THEN
TEditSelection.UnlockSel[primary];
lockRef ¬ TEditLocks.Lock[root, "TEditTypeScriptImplBackSpace"];
flush ¬ TextNode.LastLocWithin[root];
IF (node ¬ 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[] };
}
};
PutRope:
PUBLIC
PROC [ts:
TS, rope: Rope.
ROPE] = {
FOR n:
INT
IN [0..Rope.Length[rope])
DO
PutChar[ts, Rope.Fetch[rope, n]];
ENDLOOP;
};
PutText:
PUBLIC
PROC [ts:
TS, text:
REF
READONLY
TEXT, start:
INTEGER ¬ 0, stopPlusOne:
INTEGER ¬
LAST[
INTEGER]] = {
IF text#
NIL
THEN
FOR n:
INTEGER
IN [start..
MIN[text.length, stopPlusOne])
DO
PutChar[ts, text[n]];
ENDLOOP;
};
AddLooks:
PROC [ts:
TS, look:
CHAR] = {
remove, add: Looks ¬ TextLooks.noLooks;
SELECT look
FROM
IN['a..'z] => add[look] ¬ TRUE;
' => remove ¬ TextLooks.allLooks; -- blank means reset
ENDCASE;
ModifyLooks[ts: ts, remove: remove, add: add];
};
RemoveLooks:
PROC [ts:
TS, look:
CHAR] = {
IF look
IN ['a..'z]
THEN {
remove: Looks ¬ TextLooks.noLooks;
remove[look] ¬ TRUE;
ModifyLooks[ts: ts, remove: remove, add: TextLooks.noLooks];
};
};
Do:
ENTRY
PROC [ts:
TS, action:
PROC[info: TSInfo]] ~ {
ENABLE UNWIND => NULL; -- release lock
WITH ts.data
SELECT
FROM
tdd: TEditDocument.TEditDocumentData => {
WaitForEditRepaintProcess[ts];
action[tdd.tsInfo];
};
ENDCASE;
};
ChangeLooks:
PUBLIC
PROC [ts:
TS, look:
CHAR] = {
look in 'a..'z means add; in 'A..'Z means remove; blank means remove all looks
remove, add: Looks ¬ TextLooks.noLooks;
SELECT look
FROM
IN ['a..'z] => add[look] ¬ TRUE;
IN ['A..'Z] => remove[look+('a-'A)] ¬ TRUE;
= ' => remove ¬ TextLooks.allLooks; -- blank means reset
ENDCASE;
ModifyLooks[ts: ts, remove: remove, add: add];
};
ModifyLooks:
PUBLIC
PROC [ts:
TS, remove, add: Looks] ~ {
InnerModifyLooks:
PROC[info: TSInfo] ~ {
info.looks ¬ TextLooks.ModifyLooks[old: info.looks, remove: remove, add: add];
};
Do[ts, InnerModifyLooks];
};
SetLooks:
PUBLIC
PROC [ts:
TS, looks: Looks] ~ {
ModifyLooks[ts: ts, remove: TextLooks.allLooks, add: looks];
};
GetLooks:
PUBLIC
PROC [ts:
TS]
RETURNS [looks: Looks ¬ TextLooks.noLooks] ~ {
InnerGetLooks: PROC[info: TSInfo] ~ { looks ¬ info.looks };
Do[ts, InnerGetLooks];
};
SetCharSet:
PUBLIC
PROC [ts:
TS, charSet: CharSet] ~ {
InnerSetCharSet: PROC[info: TSInfo] ~ { info.charSet ¬ charSet };
Do[ts, InnerSetCharSet];
};
GetCharSet:
PUBLIC
PROC [ts:
TS]
RETURNS [charSet: CharSet ¬ 0] ~ {
InnerGetCharSet: PROC[info: TSInfo] ~ { charSet ¬ info.charSet };
Do[ts, InnerGetCharSet];
};
SetCharProps:
PUBLIC
PROC [ts:
TS, charProps: PropList] ~ {
InnerSetCharProps: PROC[info: TSInfo] ~ { info.charProps ¬ charProps };
Do[ts, InnerSetCharProps];
};
GetCharProps:
PUBLIC
PROC [ts:
TS]
RETURNS [charProps: PropList ¬
NIL] ~ {
InnerGetCharProps: PROC[info: TSInfo] ~ { charProps ¬ info.charProps };
Do[ts, InnerGetCharProps];
};
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 = {
IF editRepaintProcess = Process.GetCurrent[] THEN editRepaintProcess ¬ NIL;
BROADCAST repaintDone;
};
RacyRepaintDone:
PROC = {
Called only when an uncaught error occurs - not an entry proc because that can deadlock
IF editRepaintProcess = Process.GetCurrent[] THEN editRepaintProcess ¬ NIL;
Rely on repaintDone to time out
};
InternalClearRepaint:
INTERNAL
PROC = {
IF editRepaintProcess = Process.GetCurrent[] THEN editRepaintProcess ¬ NIL;
BROADCAST repaintDone;
};
Repaint:
PROC [ts:
TS] = {
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.
root: TextNode.Ref;
pos: TextNode.Location;
lockRef: TEditLocks.LockRef ¬ NIL;
selLock, continue: BOOL ¬ FALSE;
CheckForAutoScroll:
PROC [ts:
TS] = {
prop: REF BOOL;
tdd: TEditDocument.TEditDocumentData ¬ NARROW[ts.data];
PosIsVisible:
PROC []
RETURNS [
BOOL] = {
lines: TEditDocument.LineTable = tdd.lineTable;
IF lines[lines.lastLine].pos.where+lines[lines.lastLine].nChars >= pos.where
THEN
RETURN [TRUE];
RETURN [FALSE]
};
WITH ts.data
SELECT
FROM
tdd: TEditDocument.TEditDocumentData => {
IF TEditTouchup.LockAfterScroll[tdd, "TEditTypeScriptImplRepaint"]
THEN {{
ENABLE UNWIND => TEditTouchup.UnlockAfterRefresh[tdd];
IF (prop ¬
NARROW[ViewerOps.FetchProp[ts, $AutoScrollTypescript]]) =
NIL
THEN
ViewerOps.AddProp[ts, $AutoScrollTypescript, prop ¬ NEW[BOOL]];
prop ¬ PosIsVisible[]};
TEditTouchup.UnlockAfterRefresh[tdd]
};
};
ENDCASE;
};
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 {
InternalClearRepaint[];
RETURN [FALSE]
}; -- no new input
RETURN [TRUE]
};
WITH ts.data
SELECT
FROM
tdd: TEditDocument.TEditDocumentData => {
ENABLE {
UNWIND => Cleanup[];
ABORTED => GOTO Quit;
RuntimeError.
UNCAUGHT => {Cleanup[]; RacyRepaintDone[];
REJECT};
Make some attempt to give back the locks and restart things (also REJECT)
};
CheckAll:
PROC = {
lockRef ¬ TEditLocks.Lock[root, "TEditTypeScriptImplRepaint", read];
pos ¬ TextNode.LastLocWithin[root];
CheckForAutoScroll[ts];
FOR v: ViewerClasses.Viewer ¬ ts.link, v.link
UNTIL v =
NIL
OR v=ts
DO
CheckForAutoScroll[v];
ENDLOOP;
TEditLocks.Unlock[root];
lockRef ¬ NIL;
};
ScrollAll:
PROC = {
DoAutoScroll[ts];
FOR v: ViewerClasses.Viewer ¬ ts.link, v.link
UNTIL v =
NIL
OR v=ts
DO
DoAutoScroll[v];
ENDLOOP;
};
IF (root ¬ tdd.text) = NIL THEN GO TO Quit;
ViewerGroupLocks.CallRootAndLinksUnderWriteLock[CheckAll, ts];
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[];
ViewerGroupLocks.CallRootAndLinksUnderWriteLock[ScrollAll, ts];
IF ~continue OR ~WaitForMoreInput[] THEN EXIT;
ENDLOOP;
EXITS Quit => Cleanup[];
};
ENDCASE;
RepaintDone[];
};
updateSel: TEditDocument.Selection ¬ NEW[TEditDocument.SelectionRec];
tsMaxSize:
INT ¬
INT.
LAST;
-- ***** temporary (?) for PCedar *****
MakeEdits:
ENTRY
PROC [ts:
TS, selLock:
BOOL]
RETURNS [continue:
BOOL] = {
ENABLE UNWIND => NULL;
tdd: TEditDocument.TEditDocumentData = NARROW[ts.data];
info: TSInfo;
node: TextNode.RefTextNode;
pos: TextNode.Location;
rope: ROPE ¬ NIL;
ropeFiledSizeRef: REF INT ¬ NIL;
ropeFiledSize: INT ¬ 0;
IF tdd=
NIL
THEN {
overflowRope ¬ NIL;
inputBuffer.length ¬ 0;
InternalClearRepaint[];
RETURN [FALSE];
};
IF overflowRope=
NIL
AND inputBuffer.length=0
THEN {
InternalClearRepaint[];
RETURN [FALSE];
};
info ¬ tdd.tsInfo;
pos ¬ TextNode.LastLocWithin[tdd.text];
node ¬ pos.node;
rope ¬ overflowRope;
IF inputBuffer.length>0
THEN {
rope2: ROPE ~ Rope.FromRefText[inputBuffer];
rope ¬ IF rope=NIL THEN rope2 ELSE Rope.Concat[rope, rope2];
};
[] ¬ TextEdit.ReplaceByRope[root: tdd.text, dest: node, rope: rope,
start: pos.where, len: 0, looks: info.looks, charSet: info.charSet, charProps: info.charProps, event: TEditInput.currentEvent];
overflowRope ¬ NIL;
inputBuffer.length ¬ 0;
ropeFiledSizeRef ¬ NARROW[NodeProps.GetProp[n: tdd.text, name: $RopeFiledSize]];
ropeFiledSize ¬ (IF ropeFiledSizeRef # NIL THEN ropeFiledSizeRef ELSE 0);
<<IF Rope.Size[node.rope]-ropeFiledSize > tsMaxSize
THEN {
To avoid consuming a lot of VM, make the rope into a ropefile.
ENABLE PFS.Error => GOTO ForgetIt;
ropeSize: INT ~ Rope.Size[node.rope];
stream: IO.STREAM ~ PFS.StreamOpen[fileName: "[]<>Temp>TypescriptOverflow.txt", accessOptions: $create, createByteCount: ropeSize-ropeFiledSize, streamBufferParms: [1, 2]];
IF ropeFiledSizeRef =
NIL
THEN {
ropeFiledSizeRef ¬ NEW[INT ¬ 0];
NodeProps.PutProp[n: tdd.text, name: $RopeFiledSize, value: ropeFiledSizeRef];
};
IF ropeFiledSize
NOT
IN [0..ropeSize]
THEN ropeFiledSizeRef ¬ ropeFiledSize ¬ 0;
Must have happened because somebody edited the typescript
IO.PutRope[stream,
Rope.Substr[base: node.rope, start: ropeFiledSize, len: ropeSize-ropeFiledSize]
];
IO.Flush[stream];
node.rope ¬ Rope.Concat[
Rope.Substr[base: node.rope, start: 0, len: ropeFiledSize],
RopeFile.FromStream[stream: stream, start: 0, len: ropeSize-ropeFiledSize, bufSize: 512, buffers: 3]
];
ropeFiledSizeRef ¬ ropeSize;
SafeStorage.ReclaimCollectibleObjects[suspendMe: FALSE];
EXITS ForgetIt => NULL;
};>>
IF selLock THEN FixPSel[ts, pos, TextNode.LastLocWithin[tdd.text]];
BROADCAST bufferClear;
RETURN [TRUE];
};
FixPSel:
PROC [ts:
TS, pos, newPos: TextNode.Location] = {
FixSel:
PROC = {
tSel: TEditDocument.Selection ¬ TEditSelection.Alloc[];
TEditSelection.Copy[source: TEditSelection.pSel, dest: tSel];
TEditSelection.MakePointSelection[tSel, newPos];
TEditSelection.SetSelLooks[TEditSelection.pSel];
TEditSelection.Free[tSel]
};
IF TEditSelection.pSel.granularity=point AND TEditSelection.pSel.end.pos.where >= pos.where THEN
IF ts=TEditSelection.pSel.viewer
THEN FixSel[]
ELSE
FOR v:
TS ¬ ts.link, v.link
UNTIL v =
NIL
OR v=ts
DO
IF v=TEditSelection.pSel.viewer THEN { FixSel[]; EXIT };
ENDLOOP
};
KEYBOARD INPUT
Exported to TEditPrivate
CaretAtEnd:
PUBLIC
PROC [sel: TEditDocument.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[node] THEN yes ¬ FALSE
ELSE yes ¬ TRUE;
TEditLocks.Unlock[root]
}
};
TypeScriptNotifyProc:
PUBLIC ViewerClasses.NotifyProc = {
IF TEditProfile.editTypeScripts
THEN {
tdd: TEditDocument.TEditDocumentData = NARROW[self.data];
IF tdd = NIL THEN RETURN;
IF TEditSelection.SelectionRoot[TEditSelection.pSel]=tdd.text
AND (
NOT CaretAtEnd[TEditSelection.pSel]
OR List.Memb[$PARAM, input])
THEN {
Caret in this typescript, but not at end. So treat like edit of normal Tioga doc.
TEditPrivate.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 CHAR => {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: TEditDocument.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;
};
ForceInsertSel:
PROC [ts:
TS] = {
IF TEditSelection.pSel.viewer#ts OR (TEditSelection.pSel.granularity=point AND TEditSelection.pSel.insertion=before) THEN RETURN;
TEditSelection.LockSel[primary, "TEditTypeScriptForceInsertSel"]; {
ENABLE
UNWIND => TEditSelection.UnlockSel[primary];
IF TEditSelection.pSel.viewer=ts
AND (TEditSelection.pSel.granularity#point
OR TEditSelection.pSel.insertion#before)
THEN {
tSel: TEditDocument.Selection ¬ TEditSelection.Alloc[];
TEditSelection.Copy[source: TEditSelection.pSel, dest: tSel];
tSel.insertion ¬ before;
tSel.granularity ¬ point;
tSel.start.pos ¬ tSel.end.pos ¬ TextNode.LastLocWithin[tSel.data.text];
TEditSelection.MakeSelection[new: tSel];
TEditSelection.Free[tSel];
};
TEditSelection.UnlockSel[primary];
}
};
InterpretAtom:
PROC [viewer: ViewerClasses.Viewer, atom:
ATOM] = {
SELECT atom
FROM
$Abort => SetUserAbort[viewer];
$ApplyCaretLook, $ApplyLook, $RemoveCaretLook, $RemoveLook => {
tdd: TEditDocument.TEditDocumentData = NARROW[viewer.data];
IF tdd = NIL THEN RETURN;
TEditPrivate.TEditNotifyProc[viewer, LIST[NEW[INT ¬ tdd.tsInfo.intParam]]];
TEditInput.InterpretAtom[viewer,atom]
};
$BackSpace => {ForceInsertSel[viewer]; InputChar[viewer, Ascii.BS]};
$BackWord => {ForceInsertSel[viewer]; InputChar[viewer, Ascii.ControlW]};
$ClearTypeScriptLooks => SetLooks[viewer, TextLooks.noLooks];
$Delete => {ForceInsertSel[viewer]; InputChar[viewer, Ascii.DEL]};
$Paste => {ForceInsertSel[viewer]; TEditInput.InterpretAtom[viewer, atom]};
ENDCASE => TEditInput.InterpretAtom[viewer,atom];
};
NumberToLook:
PROC [viewer: ViewerClasses.Viewer]
RETURNS [l:
CHAR] = {
tdd: TEditDocument.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] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocument.TEditDocumentData = NARROW[ts.data];
IF tdd #
NIL
THEN {
OPEN tdd.tsInfo;
inputRope ¬ Rope.Concat[rope, Rope.Substr[inputRope, inputLoc]];
inputLoc ¬ 0;
BROADCAST iIncr;
};
};
InsertCharAtFrontOfBuffer:
PUBLIC
ENTRY
PROC [ts:
TS, char:
CHAR] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocument.TEditDocumentData = NARROW[ts.data];
IF tdd #
NIL
THEN {
OPEN tdd.tsInfo;
inputRope ¬ Rope.Concat[Rope.FromChar[char], Rope.Substr[inputRope, inputLoc]];
inputLoc ¬ 0;
BROADCAST iIncr;
};
};
FlushInputChars:
INTERNAL
PROC [tdd: TEditDocument.TEditDocumentData] = {
OPEN tdd.tsInfo;
num: INT = IF iQp > oQp THEN iQp-oQp ELSE TEditDocument.ttyChars-iQp+oQp;
Char:
PROC
RETURNS [c:
CHAR] = {
c ¬ input[oQp]; oQp ¬ (oQp+1) MOD TEditDocument.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] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocument.TEditDocumentData = NARROW[ts.data];
IF tdd #
NIL
THEN {
OPEN tdd.tsInfo;
IF iQp # oQp THEN FlushInputChars[tdd];
inputRope ¬ Rope.Concat[inputRope, rope];
BROADCAST iIncr;
};
};
InputChar:
ENTRY
PROC [ts:
TS, char:
CHAR] = {
ENABLE UNWIND => NULL; -- release lock
tdd: TEditDocument.TEditDocumentData = NARROW[ts.data];
IF tdd #
NIL
THEN {
OPEN tdd.tsInfo;
newiQp: INTEGER = (iQp+1) MOD TEditDocument.ttyChars;
IF newiQp = oQp THEN FlushInputChars[tdd];
input[iQp] ¬ char; iQp ¬ newiQp;
BROADCAST iIncr;
};
};
TTY Class Defn
typescriptMenu: Menus.Menu ¬ Menus.CreateMenu[];
splitDoc: ROPE ~ " Warning: Split typescript are known to misbehave. Keep your bags packed.";
Split: Menus.MenuProc = {TEditSplit.Split[NARROW[parent]]};
Find: Menus.MenuProc = {viewer: ViewerClasses.Viewer ~
NARROW[parent];
viewer.class.notify[viewer,
LIST[
SELECT mouseButton
FROM
red => IF shift THEN $FindNextCaseless ELSE $FindNext,
yellow => IF shift THEN $FindAnyCaseless ELSE $FindAny,
blue => IF shift THEN $FindPrevCaseless ELSE $FindPrev,
ENDCASE => ERROR]]
};
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[name: "Split", proc: Split, documentation: splitDoc, guarded: TRUE]];
TRUSTED {Process.SetTimeout[@untilTimesOutInALittleWhile, aLittleWhile]};
TRUSTED {Process.SetTimeout[@bufferClear, aLittleWhile]; Process.EnableAborts[@bufferClear]};
TRUSTED {Process.SetTimeout[@repaintDone, aLongerWhile]};
END.