DIRECTORY
EditSpan USING [ChangeLooks, Delete, Insert, Split],
InputFocus USING [CaptureButtons, ReleaseButtons],
Interminal USING [],
Menus USING [MouseButton],
MessageWindow USING [Append, Blink],
NodeProps USING [DoSpecs],
Process USING [Detach],
Rope USING [Cat, Fetch, IsEmpty, Length, MaxLen, ROPE, Substr],
TEditDisplay USING [InvalidateBranch],
TEditDocument USING [Selection, TEditDocumentData],
TEditDocumentPrivate USING [DoLoadFile],
TEditSelectionPrivate USING [ResolveToChar],
TEditSelection USING [Alloc, Free],
TextEdit USING [InsertRope, PutProp],
TextLooks USING [Looks, RopeToLooks],
TextNode USING [LastChild, Location, MaxLen, Ref, Span],
TiogaButtons USING [TiogaButton, TiogaButtonList, TiogaButtonProc, TiogaButtonRec],
TiogaButtonsExtra,
TiogaExtraOps USING [RemProp],
TiogaFileOps USING [AddLooks, Ref, SetFormat],
TiogaOps USING [CancelSelection, FirstChild, GetProp, GetRope, LastWithin, Location, Lock, Next, PutProp, Ref, Root, SetSelection, StepForward, Unlock, ViewerDoc],
TIPUser USING [TIPScreenCoords, TIPTable],
ViewerClasses USING [InitProc, Lock, NotifyProc, Viewer, ViewerClass, ViewerClassRec, ViewerRec],
ViewerOps USING [AddProp, CreateViewer, FetchProp, FetchViewerClass, MouseInViewer, PaintViewer, RegisterViewerClass];
Create TiogaButtons
CreateViewer:
PUBLIC PROC [info: ViewerClasses.ViewerRec]
RETURNS [v: ViewerClasses.Viewer] ~ {
v ← ViewerOps.CreateViewer[flavor: $TiogaButtons, info: info];
};
LoadViewer:
PUBLIC PROC [viewer: ViewerClasses.Viewer, fileName:
ROPE] ~ {
name: ROPE;
IF viewer = NIL OR viewer.class.flavor # $TiogaButtons THEN ERROR WrongViewerClass;
name ← viewer.name; -- DoLoadFile will change this on us, so save it first
[] ← TEditDocumentPrivate.DoLoadFile[parent: viewer, fileName: fileName];
viewer.tipTable ← viewer.class.tipTable; -- DoLoadFile does violence to this too!
viewer.name ← name;
ViewerOps.PaintViewer[viewer: viewer, hint: caption];
};
CreateButtonForEachNode:
PUBLIC
PROC [viewer: ViewerClasses.Viewer,
firstLevelOnly:
BOOL ←
FALSE, subtreeAsButton:
BOOL ←
TRUE,
proc: TiogaButtonProc ←
NIL, clientData:
REF
ANY ←
NIL, fork:
BOOLEAN ←
TRUE] ~ {
root: TiogaOps.Ref ← TiogaOps.ViewerDoc[viewer];
LockedCreateButtonForEachNode:
PROC [root: TiogaOps.Ref] ~ {
node: TiogaOps.Ref ← TiogaOps.FirstChild[root];
WHILE node #
NIL
DO
button: TiogaButton ~
NEW[TiogaButtonRec ← [
startLoc: [node, NodeItself],
endLoc: [IF subtreeAsButton THEN TiogaOps.LastWithin[node] ELSE node, NodeItself],
proc: proc, clientData: clientData, fork: fork]
];
IF proc #
NIL THEN AddButtonProp[node, button]
ELSE RemButtonProp[node];
IF firstLevelOnly
THEN node ← TiogaOps.Next[node]
ELSE node ← TiogaOps.StepForward[node];
ENDLOOP;
};
CallWithLock[LockedCreateButtonForEachNode, root]
};
CreateButton:
PUBLIC PROC [viewer: ViewerClasses.Viewer,
rope:
ROPE ←
NIL, format:
ROPE ←
NIL, looks:
ROPE ←
NIL,
proc: TiogaButtonProc ←
NIL, clientData:
REF
ANY ←
NIL, fork:
BOOLEAN ←
TRUE]
RETURNS [button: TiogaButton] ~ {
Verify that viewer is a $TiogaButtons class viewer.
IF viewer = NIL OR viewer.class.flavor # $TiogaButtons THEN ERROR WrongViewerClass;
Creates a button as the last child of the document in viewer.
{
root: TiogaOps.Ref ← TiogaOps.ViewerDoc[viewer];
LockedCreateButton:
PROC [root: TiogaOps.Ref] ~ {
node: TiogaOps.Ref ~ LockedCreateNode[root, rope, viewer];
IF NOT format.IsEmpty THEN SetFormat[node, format];
IF
NOT looks.IsEmpty
THEN
FOR i:
INT
IN [0..looks.Length)
DO
AddLooks[node, 0, TextNode.MaxLen, looks.Fetch[i], root];
ENDLOOP;
button ← NEW[TiogaButtonRec ← [startLoc: [node, NodeItself], endLoc: [node, NodeItself], proc: proc, clientData: clientData, fork: fork]];
IF proc #
NIL
THEN
AddButtonProp[node, button]
ELSE
RemButtonProp[node];
};
CallWithLock[LockedCreateButton, root]
};
};
WrongViewerClass:
PUBLIC
ERROR =
CODE;
CreateButtonFromNode:
PUBLIC
PROC [node: TiogaOps.Ref,
start:
INT ← 0, end:
INT ←
INT.LAST,
proc: TiogaButtonProc ←
NIL, clientData:
REF
ANY ←
NIL, fork:
BOOLEAN ←
TRUE]
RETURNS [button: TiogaButton] ~ {
root: TiogaOps.Ref ~ TiogaOps.Root[node];
ref: REF ANY ← TiogaOps.GetProp[root, $Viewer];
viewer: ViewerClasses.Viewer ← IF ref # NIL AND ISTYPE[ref, ViewerClasses.Viewer] THEN NARROW[ref] ELSE NIL;
IF viewer = NIL OR viewer.class.flavor # $TiogaButtons THEN ERROR WrongViewerClass;
Creates a button from the node.
{
LockedCreateButtonFromNode:
PROC [root: TiogaOps.Ref] ~ {
button ← NEW[TiogaButtonRec ← [startLoc: [node, start], endLoc: [node, end], proc: proc, clientData: clientData, fork: fork]];
IF proc #
NIL
THEN
AddButtonProp[node, button]
ELSE
RemButtonProp[node];
};
IF start = 0
AND end =
INT.
LAST
THEN
start ← end ← NodeItself;
IF node # NIL THEN CallWithLock[LockedCreateButtonFromNode, root]
};
};
AppendToButton:
PUBLIC PROC [button: TiogaButton, rope:
ROPE ←
NIL, looks:
ROPE ←
NIL,
proc: TiogaButtonProc ←
NIL, clientData:
REF
ANY ←
NIL, fork:
BOOLEAN ←
TRUE]
RETURNS [TiogaButton] ~ {
node: TiogaOps.Ref ~ button.startLoc.node;
root: TiogaOps.Ref ~ TiogaOps.Root[node];
LockedAppendToButton:
PROC [root: TiogaOps.Ref] ~ {
lookVector: TextLooks.Looks ~ TextLooks.RopeToLooks[looks];
start, length: INT;
[start, length] ← AppendRopeToNode[root, node, rope, lookVector];
button ← NEW[TiogaButtonRec ← [startLoc: [node, start], endLoc: [node, start+length-1], proc: proc, clientData: clientData, fork: fork]];
IF proc #
NIL
THEN
AddButtonProp[node, button];
};
CallWithLock[LockedAppendToButton, root];
RETURN [button];
};
DeleteButton:
PUBLIC PROC [button: TiogaButton] ~ {
IF button #
NIL
THEN {
root: TiogaOps.Ref ~ TiogaOps.Root[button.startLoc.node];
LockedDeleteButton:
PROC [root: TiogaOps.Ref] ~ {
EditSpan.Delete[
root: TextNodeRef[root],
del: TextNodeSpan[button.startLoc, button.endLoc]];
IF button.startLoc.where # NodeItself
THEN
AdjustButtonProps[button];
};
CallWithLock[LockedDeleteButton, root];
};
};
FindTiogaButton:
PUBLIC
PROC [this: ViewerClasses.Viewer, loc: TiogaOps.Location]
RETURNS [button: TiogaButton] ~ {
list: TiogaButtonList;
ref: REF ANY ← TiogaOps.GetProp[loc.node, $TiogaButtonList];
IF ref = NIL OR ~ISTYPE[ref, TiogaButtonList] THEN RETURN [NIL];
list ← NARROW[ref];
WHILE list #
NIL
DO
t: TiogaButton ~ list.first;
IF t.startLoc.node # loc.node THEN RETURN [NIL];
IF t.startLoc.where = NodeItself THEN RETURN [t];
IF loc.where >= t.startLoc.where AND t.endLoc.where >= loc.where THEN RETURN [t];
list ← list.rest;
ENDLOOP;
RETURN [NIL];
};
GetRope:
PUBLIC PROC [button: TiogaButton]
RETURNS [rope:
ROPE] ~ {
Provides the text of the button. Can be used in place of clientData for many purposes.
IF button #
NIL
THEN {
rope ← TiogaOps.GetRope[button.startLoc.node];
IF button.startLoc.where # NodeItself
THEN
rope ← rope.Substr[button.startLoc.where, button.endLoc.where-button.startLoc.where+1];
};
};
SetStyleFromRope:
PUBLIC PROC [v: ViewerClasses.Viewer, styleRope:
ROPE] ~ {
This crock is necessary because TiogaOps.PutProp uses too low an abstraction for adding properties to a node.
root: TextNode.Ref ~ TextNodeRef[TiogaOps.ViewerDoc[v]];
TextEdit.PutProp[node: root, name: $StyleDef, value: NodeProps.DoSpecs[$StyleDef, styleRope], root: root];
};
ChangeButtonLooks:
PUBLIC
PROC [button: TiogaButton,
addLooks, removeLooks:
ROPE ←
NIL] ~ {
IF button #
NIL
THEN {
root: TiogaOps.Ref ← TiogaOps.Root[button.startLoc.node];
InnerSetLooks:
PROC [root: TiogaOps.Ref] ~ {
add: TextLooks.Looks ← TextLooks.RopeToLooks[addLooks];
remove: TextLooks.Looks ← TextLooks.RopeToLooks[removeLooks];
EditSpan.ChangeLooks[TextNodeRef[root], TextNodeSpan[button.startLoc, button.endLoc], remove, add];
};
CallWithLock[InnerSetLooks, root];
};
};
CallWithLock:
PROC [proc:
PROC [root: TiogaOps.Ref], root: TiogaOps.Ref] ~ {
IF root #
NIL
THEN {
TiogaOps.Lock[root];
proc[root ! UNWIND => TiogaOps.Unlock[root]];
TiogaOps.Unlock[root];
MarkViewerNotEdited[root];
};
};
MarkViewerNotEdited:
PUBLIC
PROC [root: TiogaOps.Ref] ~ {
DoOne:
PROC [v: ViewerClasses.Viewer] ~ {
IF v.newVersion
THEN {
v.newVersion ← FALSE;
ViewerOps.PaintViewer[viewer: v, hint: caption];
};
};
WITH TiogaOps.GetProp[root, $Viewer]
SELECT
FROM
v: ViewerClasses.Viewer => {
IF v.newVersion
THEN {
DoOne[v];
Aren't we nice, we get all the split viewers too!
FOR x: ViewerClasses.Viewer ← v.link, x.link
WHILE x # v
AND x #
NIL
DO
DoOne[x];
ENDLOOP;
};
};
ENDCASE;
};
LockedCreateNode:
PROC [root: TiogaOps.Ref, rope:
ROPE, viewer: ViewerClasses.Viewer]
RETURNS [node: TiogaOps.Ref] ~ {
create a node as last child of root, document is already locked
IF TiogaOps.GetProp[root, $InitialTiogaButtons] #
NIL
THEN {
TiogaExtraOps.RemProp[root, $InitialTiogaButtons];
node ← TiogaOpsRef[TextNodeRef[root].child];
}
ELSE {
Create node as sibling of last child of root
IF TiogaOps.FirstChild[root] =
NIL
THEN {
node ← TiogaOpsRef[EditSpan.Insert[root: TextNodeRef[root], old: TextNodeRef[root], where: child]];
TEditDisplay.InvalidateBranch[viewer: viewer, node: TextNodeRef[root]];
}
ELSE
node ← TiogaOpsRef[EditSpan.Split[TextNodeRef[root], [TextNode.LastChild[TextNodeRef[root]], NodeItself]]];
SetFormat[node, ""];
};
[] ← TextEdit.InsertRope[root: TextNodeRef[root], dest: TextNodeRef[node], rope: rope, destLoc: TextNode.MaxLen];
};
SetFormat:
PROC [node: TiogaOps.Ref, format:
ROPE] ~
TRUSTED {
TiogaFileOps.SetFormat[TiogaFileOpsRef[node], format];
};
AddLooks:
PROC [node: TiogaOps.Ref, start, len:
INT, look:
CHAR ['a..'z],
root: TiogaOps.Ref ←
NIL] ~ {
TiogaFileOps.AddLooks[TiogaFileOpsRef[node], start, len, look, TiogaFileOpsRef[root]];
};
AddButtonProp:
PROC [node: TiogaOps.Ref, button: TiogaButton] ~ {
list: TiogaButtonList ← NIL;
ref: REF ANY ← TiogaOps.GetProp[node, $TiogaButtonList];
IF ref # NIL AND ISTYPE[ref, TiogaButtonList] THEN list ← NARROW[ref];
IF list =
NIL
THEN list ← LIST[button]
ELSE list ← CONS[button, list];
TiogaOps.PutProp[node, $TiogaButtonList, list];
};
RemButtonProp:
PROC [node: TiogaOps.Ref] ~ {
TiogaExtraOps.RemProp[node, $TiogaButtonList];
};
AdjustButtonProps:
PROC [button: TiogaButton] ~ {
buttonDelta: INTEGER ~ button.endLoc.where - button.startLoc.where + 1;
propListModified: BOOLEAN ← FALSE;
propList, list, last: TiogaButtonList;
ref: REF ANY ~ TiogaOps.GetProp[button.startLoc.node, $TiogaButtonList];
IF ref = NIL OR ~ISTYPE[ref, TiogaButtonList] THEN RETURN;
propList ← list ← NARROW[ref];
WHILE list #
NIL
DO
t: TiogaButton ~ list.first;
IF t.startLoc.node = button.startLoc.node
AND t.startLoc.where # NodeItself
THEN {
t.endLoc.where ← t.endLoc.where+1;
IF t.startLoc.where
IN [button.startLoc.where .. button.endLoc.where]
THEN
t.startLoc.where ← button.startLoc.where
ELSE
IF t.startLoc.where > button.endLoc.where
THEN
t.startLoc.where ← t.startLoc.where - buttonDelta;
IF t.endLoc.where
IN [button.startLoc.where .. button.endLoc.where]
THEN
t.endLoc.where ← button.startLoc.where
ELSE
IF t.endLoc.where > button.endLoc.where
THEN
t.endLoc.where ← t.endLoc.where - buttonDelta;
IF t.startLoc.where # t.endLoc.where
THEN
t.endLoc.where ← t.endLoc.where-1
ELSE {
t is either the deleted button or a proper subset of it, so delete t from the list
IF last =
NIL
THEN propList ← propList.rest
ELSE last.rest ← list.rest;
propListModified ← TRUE;
};
};
last ← list;
list ← list.rest;
ENDLOOP;
IF propListModified
THEN
Put back the modified list
TiogaOps.PutProp[button.startLoc.node, $TiogaButtonList, propList];
};
AppendRopeToNode:
PROC [root: TiogaOps.Ref, node: TiogaOps.Ref, rope:
ROPE,
lookVector: TextLooks.Looks]
RETURNS [start, length:
INT] ~ {
[start, length] ← TextEdit.InsertRope[root: TextNodeRef[root],
dest: TextNodeRef[node], destLoc: TextNode.MaxLen,
rope: rope, inherit: FALSE, looks: lookVector];
};
The $TiogaButtons viewer class
InitViewer: ViewerClasses.InitProc ~ {
root: TiogaOps.Ref;
textViewerInitProc[self];
self.tipTable ← buttonTIPTable;
root ← TiogaOps.ViewerDoc[self];
TiogaOps.PutProp[root, $InitialTiogaButtons, NEW[BOOLEAN ← TRUE]];
};
Notifier: ViewerClasses.NotifyProc ~ {
mouseButton: Menus.MouseButton ← red;
shift, control: BOOL ← FALSE;
mouse: TIPUser.TIPScreenCoords;
mouseX, mouseY: INT; -- for archival purposes
feedbackSel: TEditDocument.Selection ← TEditSelection.Alloc[];
FOR list:
LIST
OF
REF
ANY ← input, list.rest
UNTIL list =
NIL
DO
WITH list.first
SELECT
FROM
x:
ATOM =>
SELECT x
FROM
$Red => mouseButton ← red;
$Yellow => mouseButton ← yellow;
$Blue => mouseButton ← blue;
$Shift => shift ← TRUE;
$Control => control ← TRUE;
$Mark => {
button: TiogaButton;
selectedButton: TiogaButton ← SelectedButton[self];
IF selectedButton =
NIL
THEN
InputFocus.CaptureButtons[Notifier, self.class.tipTable, self] -- to track feedback out of buttons
ELSE
IF
NOT MouseInViewer[self, mouse]
THEN {
InputFocus.ReleaseButtons[];
CancelFeedback[self];
LOOP;
};
Mouse coordinates are guaranteed to be in viewer space and
we have captured the buttons for future $Marks and $Hits
[] ← TEditSelectionPrivate.ResolveToChar[
selection: feedbackSel,
viewer: self,
tdd: NARROW[self.data, TEditDocument.TEditDocumentData],
x: mouse.mouseX,
y: self.ch - mouse.mouseY];
Selection info returned in feedbackSel.start.pos as TextNode.Location
Find button within this selection
button ← FindTiogaButton[self, TiogaOpsLoc[feedbackSel.start.pos]];
IF button #
NIL
THEN
IF button = selectedButton THEN LOOP -- optimizing check
ELSE EstablishFeedback[self, button]
ELSE {
InputFocus.ReleaseButtons[];
CancelFeedback[self];
};
};
$Hit => {
Turn off reverse video
selectedButton: TiogaButton ← SelectedButton[self];
IF selectedButton #
NIL
THEN {
InputFocus.ReleaseButtons[];
CancelFeedback[self];
IF selectedButton.fork
THEN
TRUSTED {
[] ← Process.Detach[FORK selectedButton.proc[selectedButton, selectedButton.clientData, mouseButton, shift, control]]
}
ELSE selectedButton.proc[selectedButton, selectedButton.clientData, mouseButton, shift, control];
};
};
ENDCASE => NULL;
z: TIPUser.TIPScreenCoords => {
mouse ← z;
mouseX ← mouse.mouseX;
mouseY ← mouse.mouseY;
};
ENDCASE => ERROR;
ENDLOOP;
TEditSelection.Free[feedbackSel];
};
MouseInViewer:
PROC [this: ViewerClasses.Viewer, mouse: TIPUser.TIPScreenCoords]
RETURNS [
BOOLEAN] ~ {
viewer: ViewerClasses.Viewer;
client: BOOLEAN;
[viewer, client] ← ViewerOps.MouseInViewer[mouse];
RETURN [viewer = this AND client];
};
TiogaOpsLoc:
PROC [loc: TextNode.Location]
RETURNS [TiogaOps.Location] ~
TRUSTED INLINE {
RETURN [LOOPHOLE[loc]]
};
TextNodeSpan:
PROC [start, end: TiogaOps.Location]
RETURNS [TextNode.Span] ~
TRUSTED INLINE {
RETURN [[LOOPHOLE[start], LOOPHOLE[end]]];
};
SelectedButton:
PROC [this: ViewerClasses.Viewer]
RETURNS [button: TiogaButton] ~ {
val: REF ANY ~ ViewerOps.FetchProp[viewer: this, prop: $TiogaButtonSelected];
IF val #
NIL
AND
ISTYPE[val, TiogaButton]
THEN
button ← NARROW[val];
};
EstablishFeedback:
PROC [this: ViewerClasses.Viewer, button: TiogaButton] ~ {
ViewerOps.AddProp[viewer: this, prop: $TiogaButtonSelected, val: button];
TiogaOps.SetSelection[
viewer: this,
start:
IF button.startLoc.where = NodeItself
THEN [button.startLoc.node, 0]
ELSE button.startLoc,
end:
IF button.endLoc.where = NodeItself
THEN [button.endLoc.node, GetRope[button].Length]
ELSE button.endLoc,
level: char,
caretBefore: TRUE,
pendingDelete: TRUE,
which: feedback];
};
CancelFeedback:
PROC [this: ViewerClasses.Viewer] ~ {
ViewerOps.AddProp[viewer: this, prop: $TiogaButtonSelected, val: NIL];
TiogaOps.CancelSelection[feedback];
};
Hack: TiogaButtonProc ~ {
button: TiogaButton ← NARROW[parent];
MessageWindow.Append[Rope.Cat["button contents ", GetRope[button]], TRUE];
MessageWindow.Blink[];
};
Initialization
buttonTIPTable: TIPUser.TIPTable ← ViewerOps.FetchViewerClass[$Button].tipTable;
tiogaButtonClass: ViewerClasses.ViewerClass ←
NEW[ViewerClasses.ViewerClassRec ← ViewerOps.FetchViewerClass[$Text]^];
textViewerInitProc: ViewerClasses.InitProc ← tiogaButtonClass.init;
tiogaButtonClass.init ← InitViewer;
tiogaButtonClass.save ← NIL; -- avoids saving TiogaButtons properties
tiogaButtonClass.notify ← Notifier;
tiogaButtonClass.cursor ← bullseye;
tiogaButtonClass.icon ← tool;
tiogaButtonClass.tipTable ← buttonTIPTable;
ViewerOps.RegisterViewerClass[$TiogaButtons, tiogaButtonClass];