KeyboardTioga:
CEDAR
PROGRAM
IMPORTS MessageWindow, Rope, TEditInputOps, TEditSelection, TiogaOps, TIPUser, UserProfile
={
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, compound, word, subword, char, cursel};
Level: TYPE = Who[branch .. char];
Op: TYPE = {toPoint, selectVanilla, selectPendingDelete, delete};
SelectOp: TYPE = Op[selectVanilla .. delete];
emptyNext: BOOL ¬ TRUE;
curWhere: Where;
curWho: Who;
nullKbd: BOOL ¬ FALSE;
NullKbd:
PROC
RETURNS [
BOOL]
--TIPUser.TIPPredicate-- ~ {
RETURN [nullKbd]};
EmptyKbdNext:
PROC
RETURNS [
BOOL]
--TIPUser.TIPPredicate-- ~ {
RETURN [emptyNext]};
KbdIgnore:
PROC [viewer: Viewer ¬
NIL]
RETURNS [recordAtom:
BOOL ¬
TRUE, quit:
BOOL ¬
FALSE]
--TiogaOps.CommandProc-- =
{NULL};
KbdNull:
PROC [viewer: Viewer ¬
NIL]
RETURNS [recordAtom:
BOOL ¬
TRUE, quit:
BOOL ¬
FALSE]
--TiogaOps.CommandProc-- =
{nullKbd ¬ TRUE};
KbdNotNull:
PROC [viewer: Viewer ¬
NIL]
RETURNS [recordAtom:
BOOL ¬
TRUE, quit:
BOOL ¬
FALSE]
--TiogaOps.CommandProc-- =
{nullKbd ¬ FALSE};
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};
KbdCompound:
PROC [viewer: Viewer ¬
NIL]
RETURNS [recordAtom:
BOOL ¬
TRUE, quit:
BOOL ¬
FALSE]
--TiogaOps.CommandProc-- =
{curWho ¬ compound; 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-- =
{nullKbd ¬ FALSE;
[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];
RETURN};
quit ¬ TRUE;
TEditInputOps.CallWithLocks[Doit, read];
RETURN};
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, node, line, compound, word, subword, char => [start, end] ¬ SelectMine[where, who];
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;
RETURN};
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],
compound: [FALSE, CompoundChar, CompoundBoundary],
word: [FALSE, AllValid, WordBoundary],
subword: [FALSE, AllValid, SubwordBoundary],
char: [FALSE, AllValid, CharBoundary]
];
AllValid: PROC [c: CHAR] RETURNS [v: BOOL] = {v ¬ TRUE};
LineValid: PROC [c: CHAR] RETURNS [v: BOOL] = {v ¬ c # '\n};
CompoundChar:
PROC [c:
CHAR]
RETURNS [v:
BOOL] =
{v ¬
SELECT c
FROM
IN ['a .. 'z], IN ['A .. 'Z], IN ['0 .. '9], '. => TRUE,
ENDCASE => FALSE};
AlphaNumeric:
PROC [c:
CHAR]
RETURNS [v:
BOOL] =
{v ¬
SELECT c
FROM
IN ['a .. 'z], IN ['A .. 'Z], IN ['0 .. '9] => TRUE,
ENDCASE => FALSE};
IsUpper: PROC [c: CHAR] RETURNS [v: BOOL] = {v ¬ c IN ['A .. 'Z]};
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;
RETURN};
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;
RETURN};
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;
RETURN};
CompoundBoundary:
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];
b ¬ CompoundChar[lC] # CompoundChar[rC];
RETURN};
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;
RETURN};
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];
RETURN};
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;
RETURN};
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;
RETURN};
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;
RETURN};
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];
RETURN};
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];
RETURN};
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[];
RETURN};
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;
RETURN};
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];
RETURN};
TrackProfile:
PROC [reason: UserProfile.ProfileChangeReason]
--UserProfile.ProfileChangedProc-- ~ {
emptyNext ¬ UserProfile.Boolean["KeyboardTioga.EmptyNext", TRUE];
RETURN};
Start:
PROC = {
UserProfile.CallWhenProfileChanges[TrackProfile];
TIPUser.RegisterTIPPredicate[$NullKbd, NullKbd];
TIPUser.RegisterTIPPredicate[$EmptyKbdNext, EmptyKbdNext];
TiogaOps.RegisterCommand[$KbdIgnore, KbdIgnore];
TiogaOps.RegisterCommand[$KbdNull, KbdNull];
TiogaOps.RegisterCommand[$KbdNotNull, KbdNotNull];
TiogaOps.RegisterCommand[$KbdBranch, KbdBranch];
TiogaOps.RegisterCommand[$KbdNode, KbdNode];
TiogaOps.RegisterCommand[$KbdLine, KbdLine];
TiogaOps.RegisterCommand[$KbdCompound, KbdCompound];
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];
RETURN};
Start[];
}.