TiogaButtonsImpl.Mesa
Copyright © 1984, 1985 Xerox Corporation. All rights reserved.
Rick Beach, May 14, 1986 11:56:37 am PDT
Russ Atkinson (RRA) May 21, 1985 0:03:26 am PDT
Last edited by: Mik Lamming - August 25, 1986 5:13:58 pm PDT
DIRECTORY
EditSpan USING [ChangeLooks, Delete, Insert],
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];
TiogaButtonsImpl: CEDAR PROGRAM
IMPORTS EditSpan, InputFocus, MessageWindow, NodeProps, Process, Rope, TEditDisplay, TEditDocumentPrivate, TEditSelection, TEditSelectionPrivate, TextEdit, TextLooks, TextNode, TiogaExtraOps, TiogaFileOps, TiogaOps, ViewerOps
EXPORTS TiogaButtons, TiogaButtonsExtra
~ BEGIN OPEN TiogaButtons;
ROPE: TYPE ~ Rope.ROPE;
NodeItself: INT ~ -1;
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: BOOLFALSE, subtreeAsButton: BOOLTRUE,
proc: TiogaButtonProc ← NIL, clientData: REF ANYNIL, fork: BOOLEANTRUE] ~ {
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: ROPENIL, format: ROPENIL, looks: ROPENIL,
proc: TiogaButtonProc ← NIL, clientData: REF ANYNIL, fork: BOOLEANTRUE]
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: INTINT.LAST,
proc: TiogaButtonProc ← NIL, clientData: REF ANYNIL, fork: BOOLEANTRUE]
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: ROPENIL, looks: ROPENIL,
proc: TiogaButtonProc ← NIL, clientData: REF ANYNIL, fork: BOOLEANTRUE]
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: ROPENIL] ~ {
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.Insert[root: TextNodeRef[root], old: TextNode.LastChild[TextNodeRef[root]], where: sibling]];
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: BOOLEANFALSE;
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];
};
Type Conversion Routines (for the client and the implementation)
TextNodeRef: PUBLIC PROC [ref: REF] RETURNS [TextNode.Ref] ~ TRUSTED {
RETURN [LOOPHOLE[ref]];
};
TiogaOpsRef: PUBLIC PROC [ref: REF] RETURNS [TiogaOps.Ref] ~ TRUSTED {
RETURN [LOOPHOLE[ref]];
};
TiogaFileOpsRef: PUBLIC PROC [ref: REF] RETURNS [TiogaFileOps.Ref] ~ TRUSTED {
RETURN [LOOPHOLE[ref]];
};
The $TiogaButtons viewer class
InitViewer: ViewerClasses.InitProc ~ {
root: TiogaOps.Ref;
textViewerInitProc[self];
self.tipTable ← buttonTIPTable;
root ← TiogaOps.ViewerDoc[self];
TiogaOps.PutProp[root, $InitialTiogaButtons, NEW[BOOLEANTRUE]];
};
Notifier: ViewerClasses.NotifyProc ~ {
mouseButton: Menus.MouseButton ← red;
shift, control: BOOLFALSE;
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];
END.
Some Neat things to add to TiogaButtons in the future:
a) box style attributes that Tioga would draw boxes around the run of text with this attribute
b) rule style attribute that Tioga would draw horizontal or vertical rules
c) background color style attribute
d) cursor changes when mouse is over a button
e) secondary selection to still work from $TiogaButtons viewers