KeyboardTioga:
CEDAR
PROGRAM
IMPORTS MessageWindow, Rope, TEditInputOps, TEditSelection, TiogaOps
={
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
Location: TYPE = TiogaOps.Location;
Where: TYPE = {begin, end, all};
Border: TYPE = Where[begin .. end];
Who: TYPE = {branch, node, line, word, subword, char, cursel};
Level: TYPE = Who[branch .. char];
Op: TYPE = {toPoint, selectVanilla, selectPendingDelete, delete};
SelectOp: TYPE = Op[selectVanilla .. delete];
curWhere: Where;
curWho: Who;
KbdNull:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{NULL};
KbdBegin:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWhere ← begin; quit ← TRUE};
KbdEnd:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWhere ← end; quit ← TRUE};
KbdAll:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWhere ← all; quit ← TRUE};
KbdBranch:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWho ← branch; quit ← TRUE};
KbdNode:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWho ← node; quit ← TRUE};
KbdLine:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWho ← line; quit ← TRUE};
KbdWord:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWho ← word; quit ← TRUE};
KbdSubWord:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWho ← subword; quit ← TRUE};
KbdChar:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWho ← char; quit ← TRUE};
KbdCurSel:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{curWho ← cursel; quit ← TRUE};
KbdToPoint:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{[recordAtom, quit] ← Operate[viewer, toPoint]};
KbdSelect:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{[recordAtom, quit] ← Operate[viewer, selectVanilla]};
KbdSelectPendingDelete:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{[recordAtom, quit] ← Operate[viewer, selectPendingDelete]};
KbdDelete:
PROC [viewer: Viewer ←
NIL]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE]
--TiogaOps.CommandProc-- =
{[recordAtom, quit] ← Operate[viewer, delete]};
KbdInvertPendingDelete:
PROC [viewer: Viewer]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE] = {
Doit:
PROC [root: TextNode.Ref, tSel: TEditDocument.Selection] = {
TEditSelection.Deselect[primary];
tSel.pendingDelete ← NOT tSel.pendingDelete;
TEditSelection.MakeSelection[selection: primary, new: tSel];
};
quit ← TRUE;
TEditInputOps.CallWithLocks[Doit, read];
};
Operate:
PROC [viewer: Viewer, op: Op]
RETURNS [recordAtom:
BOOL ←
TRUE, quit:
BOOL ←
FALSE] = {
root: TiogaOps.Ref;
IF viewer = NIL THEN RETURN [FALSE, FALSE];
root ← TiogaOps.ViewerDoc[viewer];
IF root = NIL THEN RETURN [FALSE, FALSE];
SelectAndOp[curWhere, curWho, op];
quit ← TRUE;
};
SelectAndOp:
PROC [where: Where, who: Who, op: Op] = {
start, end: Location ← undef;
SELECT who
FROM
branch => [start, end] ← SelectMine[where, branch];
node => [start, end] ← SelectMine[where, node];
line => [start, end] ← SelectMine[where, line];
word => [start, end] ← SelectMine[where, word];
subword => [start, end] ← SelectMine[where, subword];
char => [start, end] ← SelectMine[where, char];
cursel => {
SetPendhood[FALSE];
SELECT where
FROM
begin => TiogaOps.CaretBefore[];
end => TiogaOps.CaretAfter[];
all => NULL;
ENDCASE => ERROR;
};
ENDCASE => ERROR;
SELECT op
FROM
toPoint => TiogaOps.CaretOnly[];
selectVanilla => NULL;
selectPendingDelete => SetPendhood[TRUE];
delete => {
hackCR: BOOL ← FALSE;
IF who = line
THEN {
rIn: BOOL;
rChar: CHAR;
[rIn, rChar] ← GetNextChar[end];
hackCR ← rIn AND rChar = '\n;
};
TiogaOps.Delete[];
IF hackCR THEN TiogaOps.DeleteNextCharacter[];
};
ENDCASE => ERROR;
};
LevelProcs:
TYPE =
RECORD [
mayBeEmpty: BOOL,
Valid: PROC [c: CHAR] RETURNS [v: BOOL],
Boundary: PROC [border: Border, loc, other: Location] RETURNS [b: BOOL]
];
undef: Location = [NIL, -47];
levelProcses:
ARRAY Level
OF LevelProcs = [
branch: [TRUE, AllValid, BranchBoundary],
node: [TRUE, AllValid, NodeBoundary],
line: [TRUE, LineValid, LineBoundary],
word: [FALSE, AllValid, WordBoundary],
subword: [FALSE, AllValid, SubwordBoundary],
char: [FALSE, AllValid, CharBoundary]
];
LineValid: PROC [c: CHAR] RETURNS [v: BOOL] = {v ← c # '\n};
AllValid: PROC [c: CHAR] RETURNS [v: BOOL] = {v ← TRUE};
BranchBoundary:
PROC [border: Border, loc, other: Location]
RETURNS [b:
BOOL] = {
IF NOT NodeBoundary[border, loc, other] THEN RETURN [FALSE];
IF other = undef THEN RETURN [TRUE];
b ←
SELECT border
FROM
begin => TiogaOps.LastLocWithin[loc.node] = TiogaOps.LastLocWithin[other.node],
end => loc = TiogaOps.LastLocWithin[other.node],
ENDCASE => ERROR;
};
NodeBoundary:
PROC [border: Border, loc, other: Location]
RETURNS [b:
BOOL] = {
b ←
SELECT border
FROM
begin => loc.where <= 0,
end => loc.where >= TiogaOps.GetRope[loc.node].Length[],
ENDCASE => ERROR;
};
LineBoundary:
PROC [border: Border, loc, other: Location]
RETURNS [b:
BOOL] = {
b ←
SELECT border
FROM
begin => GetPrevChar[loc].c = '\n,
end => GetNextChar[loc].c = '\n,
ENDCASE => ERROR;
};
WordBoundary:
PROC [border: Border, loc, other: Location]
RETURNS [b:
BOOL] = {
lIn, rIn: BOOL;
lC, rC: CHAR;
[lIn, lC] ← GetPrevChar[loc];
[rIn, rC] ← GetNextChar[loc];
IF (NOT lIn) AND (NOT rIn) THEN ERROR;
IF (NOT lIn) OR (NOT rIn) THEN RETURN [TRUE];
IF NOT (AlphaNumeric[lC] AND AlphaNumeric[rC]) THEN RETURN [lC # rC];
b ← FALSE;
};
SubwordBoundary:
PROC [border: Border, loc, other: Location]
RETURNS [b:
BOOL] = {
lIn, rIn, ur: BOOL;
lC, rC, rrC: CHAR;
[lIn, lC] ← GetPrevChar[loc];
[rIn, rC] ← GetNextChar[loc];
IF (NOT lIn) AND (NOT rIn) THEN ERROR;
IF (NOT lIn) OR (NOT rIn) THEN RETURN [TRUE];
IF NOT (AlphaNumeric[lC] AND AlphaNumeric[rC]) THEN RETURN [lC # rC];
ur ← IsUpper[rC];
IF (NOT IsUpper[lC]) THEN RETURN [ur];
IF NOT ur THEN RETURN [FALSE];
rrC ← GetNextChar[NextLoc[loc]].c;
IF NOT AlphaNumeric[rrC] THEN RETURN [FALSE];
b ← NOT IsUpper[rrC];
};
CharBoundary:
PROC [border: Border, loc, other: Location]
RETURNS [b:
BOOL] = {
lIn, rIn: BOOL;
lC, rC: CHAR;
[lIn, lC] ← GetPrevChar[loc];
[rIn, rC] ← GetNextChar[loc];
IF (NOT lIn) AND (NOT rIn) THEN ERROR;
b ← TRUE;
};
AlphaNumeric:
PROC [c:
CHAR]
RETURNS [an:
BOOL] =
{an ←
SELECT c
FROM
IN ['a .. 'z], IN ['A .. 'Z], IN ['0 .. '9] => TRUE,
ENDCASE => FALSE};
IsUpper: PROC [c: CHAR] RETURNS [u: BOOL] = {u ← c IN ['A .. 'Z]};
StandardSelection:
TYPE =
RECORD [
viewer: Viewer,
start, end, caret: --point, not char--Location,
caretBefore, pointOnly, pendingDelete: BOOL];
GetStandardSelection:
PROC
RETURNS [ss: StandardSelection] = {
level: TiogaOps.SelectionGrain;
EndAdjust:
PROC = {
--convert end from char pointer to point pointer
IF ss.start = ss.end
AND TiogaOps.GetRope[ss.start.node].Length[] = 0
THEN {IF ss.end.where # 0 THEN ERROR}
ELSE ss.end ← NextLoc[ss.end];
};
startLen, endLen: INT;
[ss.viewer, ss.start, ss.end, level, ss.caretBefore, ss.pendingDelete] ← TiogaOps.GetSelection[];
startLen ← TiogaOps.GetRope[ss.start.node].Length[];
endLen ← TiogaOps.GetRope[ss.end.node].Length[];
IF ss.start.where > startLen
OR ss.end.where > endLen
THEN {
MessageWindow.Append["Tioga screwed up again", TRUE];
ss.start.where ← MIN[ss.start.where, startLen];
ss.end.where ← MIN[ss.end.where, endLen]};
SELECT level
FROM
point => {ss.caret ← ss.start; ss.pointOnly ← TRUE};
char, word => {
EndAdjust[];
ss.caret ← IF ss.caretBefore THEN ss.start ELSE ss.end;
ss.pointOnly ← ss.start = ss.end;
};
node, branch => {
EndAdjust[];
ss.caret ← IF ss.caretBefore THEN ss.start ELSE ss.end;
ss.pointOnly ← ss.start = ss.end;
};
ENDCASE => ERROR;
ss ← ss;
};
SelectMine:
PROC [where: Where, l: Level]
RETURNS [start, end: Location] = {
ss: StandardSelection ← GetStandardSelection[];
docStart, docEnd: Location;
caretBefore, empty: BOOL ← FALSE;
start ← end ← ss.caret;
[docStart, docEnd, empty] ← GetDocLimits[ss.caret];
IF empty THEN {Bitch["EmptyDocument"]; RETURN};
SELECT where
FROM
begin => {
WHILE NOT (end = docStart OR InLevel[l, end, -1]) DO end ← PrevLoc[end]; IF levelProcses[l].mayBeEmpty THEN EXIT; ENDLOOP;
start ← IF (NOT levelProcses[l].mayBeEmpty) AND end # docStart THEN PrevLoc[end] ELSE end;
WHILE NOT (start = docStart OR levelProcses[l].Boundary[begin, start, end]) DO start ← PrevLoc[start] ENDLOOP;
caretBefore ← TRUE;
};
end => {
WHILE NOT (start = docEnd OR InLevel[l, start, 1]) DO start ← NextLoc[start]; IF levelProcses[l].mayBeEmpty THEN EXIT; ENDLOOP;
end ← IF (NOT levelProcses[l].mayBeEmpty) AND start # docEnd THEN NextLoc[start] ELSE start;
WHILE NOT (end = docEnd OR levelProcses[l].Boundary[end, end, start]) DO end ← NextLoc[end] ENDLOOP;
};
all =>
SELECT ss.caretBefore
FROM
FALSE => {
caret: Location ← ss.caret;
WHILE NOT (caret = docEnd OR InLevel[l, caret, -1] OR levelProcses[l].mayBeEmpty) DO caret ← NextLoc[caret] ENDLOOP;
start ← IF (NOT levelProcses[l].mayBeEmpty) AND caret # docStart THEN PrevLoc[caret] ELSE caret;
WHILE NOT (start = docStart OR levelProcses[l].Boundary[begin, start, undef]) DO start ← PrevLoc[start] ENDLOOP;
end ← caret;
WHILE NOT (end = docEnd OR levelProcses[l].Boundary[end, end, start]) DO end ← NextLoc[end] ENDLOOP;
};
TRUE => {
caret: Location ← ss.caret;
WHILE NOT (caret = docStart OR InLevel[l, caret, 1] OR levelProcses[l].mayBeEmpty) DO caret ← PrevLoc[caret] ENDLOOP;
start ← caret;
WHILE NOT (start = docStart OR levelProcses[l].Boundary[begin, start, undef]) DO start ← PrevLoc[start] ENDLOOP;
end ← IF (NOT levelProcses[l].mayBeEmpty) AND caret # docEnd THEN NextLoc[caret] ELSE caret;
WHILE NOT (end = docEnd OR levelProcses[l].Boundary[end, end, start]) DO end ← NextLoc[end] ENDLOOP;
};
ENDCASE => ERROR;
ENDCASE => ERROR;
SELECT
TRUE
FROM
start = end => TiogaOps.SelectPoint[
viewer: ss.viewer,
caret: start];
start # end => TiogaOps.SetSelection[
viewer: ss.viewer,
start: start,
end: PrevLoc[end],
level: char,
caretBefore: caretBefore];
ENDCASE => ERROR;
};
Bitch:
PROC [msg:
ROPE] = {
MessageWindow.Append[message: msg, clearFirst: TRUE];
MessageWindow.Blink[]};
InLevel:
PROC [l: Level, loc: Location, side: [-1 .. 1]]
RETURNS [in:
BOOL] = {
inBounds: BOOL;
char: CHAR;
SELECT side
FROM
-1 => [inBounds, char] ← GetPrevChar[loc];
1 => [inBounds, char] ← GetNextChar[loc];
ENDCASE => ERROR;
IF NOT inBounds THEN RETURN [FALSE];
in ← levelProcses[l].Valid[char];
};
GetNextChar:
PROC [loc: Location]
RETURNS [inNode:
BOOL, c:
CHAR] = {
rope: ROPE ← TiogaOps.GetRope[loc.node];
len: INT ← rope.Length[];
IF loc = [NIL, 0] THEN RETURN [FALSE, '\n];
IF loc.node = TiogaOps.Root[loc.node] THEN ERROR;
IF loc.where IN [0 .. len) THEN RETURN [TRUE, rope.Fetch[loc.where]];
inNode ← FALSE;
c ← '\n;
};
GetPrevChar:
PROC [loc: Location]
RETURNS [inNode:
BOOL, c:
CHAR] = {
rope: ROPE ← TiogaOps.GetRope[loc.node];
len: INT ← rope.Length[];
IF loc = [NIL, 0] THEN RETURN [FALSE, '\n];
IF loc.node = TiogaOps.Root[loc.node] THEN ERROR;
IF loc.where IN (0 .. len] THEN RETURN [TRUE, rope.Fetch[loc.where-1]];
inNode ← FALSE;
c ← '\n;
};
NextLoc:
PROC [loc: Location]
RETURNS [next: Location] = {
rope: ROPE ← TiogaOps.GetRope[loc.node];
len: INT ← rope.Length[];
IF len > loc.where THEN RETURN [[loc.node, loc.where+1]];
next ← [TiogaOps.StepForward[loc.node], 0]
};
PrevLoc:
PROC [loc: Location]
RETURNS [prev: Location] = {
IF loc.where > 0 THEN RETURN [[loc.node, loc.where-1]];
prev ← [TiogaOps.StepBackward[loc.node], 0];
prev.where ← TiogaOps.GetRope[prev.node].Length[];
};
GetDocLimits:
PROC [loc: Location]
RETURNS [start, end: Location, empty:
BOOL] = {
root: TiogaOps.Ref ← TiogaOps.Root[loc.node];
firstNode: TiogaOps.Ref ← TiogaOps.FirstChild[root];
lastNode: TiogaOps.Ref ← TiogaOps.LastWithin[root];
start ← [firstNode, 0];
end ← [lastNode, TiogaOps.GetRope[lastNode].Length[]];
empty ← TiogaOps.LocOffset[loc1: start, loc2: end, break: 0] = 0;
};
SetPendhood:
PROC [pend:
BOOL] = {
viewer: Viewer;
start, end: Location;
level: TiogaOps.SelectionGrain;
caretBefore, pendingDelete: BOOL;
[viewer, start, end, level, caretBefore, pendingDelete] ← TiogaOps.GetSelection[];
IF pendingDelete # pend THEN TiogaOps.SetSelection[viewer, start, end, level, caretBefore, pend];
};
Start:
PROC = {
TiogaOps.RegisterCommand[$KbdNull, KbdNull];
TiogaOps.RegisterCommand[$KbdBranch, KbdBranch];
TiogaOps.RegisterCommand[$KbdNode, KbdNode];
TiogaOps.RegisterCommand[$KbdLine, KbdLine];
TiogaOps.RegisterCommand[$KbdWord, KbdWord];
TiogaOps.RegisterCommand[$KbdSubWord, KbdSubWord];
TiogaOps.RegisterCommand[$KbdChar, KbdChar];
TiogaOps.RegisterCommand[$KbdCurSel, KbdCurSel];
TiogaOps.RegisterCommand[$KbdBegin, KbdBegin];
TiogaOps.RegisterCommand[$KbdEnd, KbdEnd];
TiogaOps.RegisterCommand[$KbdAll, KbdAll];
TiogaOps.RegisterCommand[$KbdToPoint, KbdToPoint];
TiogaOps.RegisterCommand[$KbdSelect, KbdSelect];
TiogaOps.RegisterCommand[$KbdSelectPendingDelete, KbdSelectPendingDelete];
TiogaOps.RegisterCommand[$KbdDelete, KbdDelete];
TiogaOps.RegisterCommand[$KbdInvertPendingDelete, KbdInvertPendingDelete];
};
Start[];
}.