DIRECTORY
FS USING [Error, StreamOpen],
InputFocus USING [GetInputFocus, SetInputFocus],
IO USING [Flush, PutRope, STREAM],
Menus USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
MessageWindow USING [Append, Blink],
NodeProps USING [GetProp, PutProp],
Process USING [CheckForAbort, Detach, EnableAborts, GetCurrent, MsecToTicks, SecondsToTicks, SetTimeout, Ticks],
Rope USING [Concat, Fetch, FromProc, FromRefText, Length, ROPE, Size, Substr],
RopeEdit USING [Concat, InsertChar],
RopeFile USING [FromStream],
RuntimeError USING [UNCAUGHT],
SafeStorage USING [ReclaimCollectibleObjects],
TEditCompile USING [minAvgLineLeading],
TEditDocument USING [LineTable, LineTableRec, RecordViewerForRoot, Selection, SelectionRec, SpinAndLock, TEditDocumentData, TEditDocumentDataRec, TSInfoRec, ttyChars, Unlock],
TEditInput USING [BadMouse, CommandProc, currentEvent, DontDoIt, FreeTree, InterpretAtom, Register, ResetInputStuff, SaveCoords],
TEditInputOps USING [EditFailed],
TEditLocks USING [Lock, LockRef, Unlock],
TEditPrivate USING [ReloadTable, TEditNotifyProc],
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, MaxLen, Size],
TextLooks USING [Looks, LooksToRope, noLooks],
TextNode USING [FirstChild, LastLocWithin, Location, Node, StepForward],
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, IO, FS, Menus, MessageWindow, NodeProps, Process, Rope, RopeEdit, RopeFile, RuntimeError, SafeStorage, TextEdit, TextLooks, TextNode, TEditDocument, TEditPrivate, TEditInput, TEditInputOps, TEditLocks, TEditProfile, TEditRefresh, TEditSelection, TEditSplit, TEditTouchup, TIPUser, ViewerGroupLocks, ViewerOps
EXPORTS
TEditPrivate
CaretAtEnd, typeScriptTIP, ReloadTypeScriptTipTable
= BEGIN
ROPE: TYPE = Rope.ROPE;
TS: TYPE = ViewerClasses.Viewer;
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"];
tdd.lineTable ←
NEW[TEditDocument.LineTableRec[
MAX[2,
(IF self=NIL THEN 0 ELSE (self.ch/TEditCompile.minAvgLineLeading))+1]] ←
[lastLine: 0, lastY: 0, lines: NULL]];
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];
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]
ELSE {
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.Node;
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.Node;
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;
};
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: TEditDocument.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: TEditDocument.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: TEditDocument.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: TEditDocument.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: TEditDocument.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]
};
KEYBOARD INPUT
Exported to TEditPrivate
CaretAtEnd:
PUBLIC
PROC [sel: TEditDocument.Selection]
RETURNS [yes:
BOOL] = {
root: TextNode.Node = 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.Node = 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: 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 ~CaretAtEnd[TEditSelection.pSel]
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, 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];
};
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 ← RopeEdit.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 ← RopeEdit.InsertChar[Rope.Substr[inputRope, inputLoc], char];
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 ← RopeEdit.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]};
END.