WhiteboardOpsImpl.mesa
Copyright © 1984, 1986 by Xerox Corporation. All rights reserved.
Maxwell, June 25, 1984 1:31:29 pm PDT
Cattell, September 1, 1983 10:40 am
Donahue, June 13, 1986 9:12:27 am PDT
(Changed to reflect new error-handling policy)
(Fixed treatment of ShowPress viewers)
(Fixed bug in opening tool viewers -- didn't get tool argument properly)
(Removed working directory stuff to be consistent with new DBTools)
(Replaced "AddTool" with "AddCommandFile")
Widom, August 24, 1984 5:05:57 pm PDT
Last Edited by: Winkler, December 18, 1984 4:51:56 pm PST
Rick Beach, January 28, 1986 8:00:57 pm PST
DIRECTORY
Atom USING [MakeAtom],
BasicTime USING [GMT, nullGMT],
Commander USING [CommandProc, Register],
Convert USING [RopeFromTime],
DBDefs USING [Segment],
DBIcons USING [Exists],
DBNames USING [DecomposeName, MakeName],
DBTools USING [ApplyTool, ViewerToTool],
FileNames USING [GetShortName],
Icons USING [IconFlavor],
InputFocus USING [GetInputFocus, Focus],
IO USING [EndOf, GetTokenRope, GetLineRope, RIS, SkipWhitespace, STREAM],
Menus USING [FindEntry, MenuEntry, ReplaceMenuEntry],
Nut USING [Display, GetNutInfo, NoRegistration, SetFrozenProperty],
Process USING [Detach],
Rope USING [Cat, Equal, IsEmpty, ROPE],
TIPUser USING [TIPScreenCoords],
ViewerClasses USING [Column, NotifyProc, Viewer, ViewerClass, ViewerFlavor, ViewerRec],
ViewerOps USING [CloseViewer, EnumerateViewers, EnumProc, FetchProp, FindViewer, OpenIcon, PaintViewer],
ViewerPrivate USING [InvertForMenus],
ViewerTools USING [GetSelectedViewer, GetTiogaContents, TiogaContentsRec],
WhiteboardDB USING [Close, CopyWB, Delete, Destroy, Display, Enumerate, Erase, EstablishWhiteboardDB, GetChildren, GetCreateDate, GetIconProps, GetToolArgument, New, NewBox, NewIcon, stopped, WBError, WBExists, whiteboard],
WhiteboardNut USING [CreateWBViewer, CreateTextViewer, DoCommandFile],
WhiteboardOps USING [],
WhiteboardViewers USING [DontLog, Expand, GrowBox, MoveChild, NearestChild];
WhiteboardOpsImpl: CEDAR PROGRAM
IMPORTS Atom, Commander, Convert, DBIcons, DBNames, DBTools, FileNames, InputFocus, IO, Menus, Nut, Process, Rope, ViewerOps, ViewerPrivate, ViewerTools, WhiteboardDB, WhiteboardNut, WhiteboardViewers
EXPORTS WhiteboardOps
SHARES ViewerOps, ViewerClasses, Menus
= BEGIN OPEN WhiteboardOps;
ROPE: TYPE = Rope.ROPE;
Command interpreter
Notify: PUBLIC ViewerClasses.NotifyProc = {
OPEN WhiteboardViewers;
p: TIPUser.TIPScreenCoords;
FOR list: LIST OF REF ANY ← input, list.rest UNTIL list = NIL DO
WITH list.first SELECT FROM
z: ATOM => {
parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent;
IF WhiteboardDB.stopped THEN LOOP;
SELECT z FROM
$Grow =>
IF parent.class.flavor = $Whiteboard THEN {
v: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY, $Text];
IF v # NIL THEN GrowBox[parent, v, p.mouseX, parent.ch -p.mouseY] };
$Instructions => {
[] ← WhiteboardDB.NewBox[self, 100, 100, 241, 116,
NEW[ViewerTools.TiogaContentsRec ← [contents: "\nINSTRUCTIONS:\nLEFT => move entity\nshift LEFT => add text box\nctrl shift LEFT => copy text box\nctrl LEFT => delete entity\nMIDDLE => open icon\nshift MIDDLE => open icon fullsize\nctrl MIDDLE => expand whiteboard\nRIGHT => grow text box\n\n", formatting: "\000\000\000\006\000\000\235\312\000\215\000\000\002\230\000\002\232\002\233\b\002 @\f\317s\001\230\nJ\232\003\233H\002 \000\004\236\004\320cs\013\230\023J\232\003\237\l\236\004\240\f\230\032J\232\005\237\004\234\001\237\l\236\004\240\n\230 J\232\003\237\t\236\004\240\n\230\032J\232\003\237\006\236\004\240\t\230\023J\232\003\237\f\236\004\240\022\230\"J\232\003\237\013\236\004\240\021\230 J\232\003\237\005\236\004\240\n\230\026\227J\230\000\227\000\205\227\000\000\000\000\000\352\000\000\001}\000\000"]]];
};
$NewBox => {
[] ← WhiteboardDB.NewBox[parent, p.mouseX, parent.ch - p.mouseY, 128, 32];
};
$CopyBox => {
focus: InputFocus.Focus = InputFocus.GetInputFocus[];
boxToCopy: ViewerClasses.Viewer = IF focus = NIL THEN NIL ELSE focus.owner;
IF boxToCopy.parent = NIL OR boxToCopy.parent.class.flavor # $Whiteboard THEN RETURN; -- not a whiteboard text box
[] ← WhiteboardDB.NewBox[parent, p.mouseX, parent.ch - p.mouseY, boxToCopy.ww, boxToCopy.wh, ViewerTools.GetTiogaContents[boxToCopy]]
};
$Open => {
v: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon];
IF v # NIL THEN OpenProc[v];
};
$OpenFull => {
v: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon];
IF v # NIL THEN OpenFullProc[v];
};
$Remove => {
child: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY];
parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent;
IF child = NIL THEN RETURN;
WhiteboardDB.Delete[child];
parent.newVersion ← TRUE;
ViewerOps.PaintViewer[parent, client];
ViewerOps.PaintViewer[parent, caption];
};
$Expand => {
v: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY];
parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent;
name: ROPE;
type: ATOM;
IF v = NIL THEN RETURN;
[name, type] ← WhiteboardDB.GetIconProps[v];
IF type = WhiteboardDB.whiteboard AND WhiteboardDB.WBExists[name] THEN
TRUSTED{ Process.Detach[ FORK ExpandProc[parent, v, name] ] };
};
$Freeze => {
self: ViewerClasses.Viewer = NARROW[parent];
frozen: Menus.MenuEntry = Menus.FindEntry[self.menu, "Freeze"];
IF frozen = NIL THEN RETURN;
Menus.ReplaceMenuEntry[self.menu, frozen];
ViewerOps.PaintViewer[self, menu];
[] ← Nut.SetFrozenProperty[self, TRUE];
};
$AddSelected => {
icon: ViewerClasses.Viewer ← ViewerTools.GetSelectedViewer[];
parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent; 
IF icon = NIL THEN RETURN;
WHILE icon.parent # NIL DO icon ← icon.parent ENDLOOP;
IF icon # NIL THEN AddNewIcon[parent, icon, 100, 100];
};
$AddCommandFile => {
parent: ViewerClasses.Viewer = IF self.parent = NIL THEN self ELSE self.parent; 
icon: ViewerClasses.Viewer ← ViewerTools.GetSelectedViewer[];
IF icon = NIL THEN RETURN;
IF icon.icon # document THEN RETURN;
[] ← WhiteboardDB.NewIcon[parent, 100, 100, icon.name, $ToolRope, "Typescript", FileNames.GetShortName[icon.name]];
};
$Erase => {
WhiteboardDB.Erase[self];
self.newVersion ← TRUE;
ViewerOps.PaintViewer[self, all];
};
$Move => {
child: ViewerClasses.Viewer = NearestChild[self, p.mouseX, p.mouseY];
IF child # NIL THEN MoveChild[child];
};
ENDCASE => NULL;
};
z: TIPUser.TIPScreenCoords => p ← z;
ENDCASE => NULL;
ENDLOOP;
};
Support routines
AddNewIcon: PROC[wb, child: ViewerClasses.Viewer, x, y: INTEGER] = {
name, label, iconName, argument: ROPE;
segment: DBDefs.Segment;
domain, entity: ROPE;
[segment , domain, entity] ← Nut.GetNutInfo[child];
IF NOT Rope.Equal[domain, NIL] AND NOT Rope.Equal[entity, NIL] THEN {
IF Rope.Equal[domain, "Whiteboard"] THEN { -- it's one of ours!
[] ← WhiteboardDB.NewIcon[wb, x, y, entity, WhiteboardDB.whiteboard, "Whiteboard"] }
ELSE {
name ← DBNames.MakeName[segment, domain, entity];
iconName ← IF DBIcons.Exists[domain] THEN domain ELSE "Acorn";
label ← NARROW[ViewerOps.FetchProp[child, $IconLabel]];
IF Rope.IsEmpty[label] THEN label ← child.label;
[] ← WhiteboardDB.NewIcon[wb, x, y, name, $Entity, iconName, label] };
RETURN };
IF child.icon = document AND child.class.flavor = $Text THEN {
[] ← WhiteboardDB.NewIcon[wb, x, y, child.name, $Text, "Document", FileNames.GetShortName[child.name]];
RETURN };
otherwise it's a tool
[name, argument] ← DBTools.ViewerToTool[child];
IF name = NIL THEN
try out the child before giving up (a hack to handle ShowPress viewers)
IF child.class.flavor = $Container AND child.child # NIL THEN {
child ← child.child;
[name, argument] ← DBTools.ViewerToTool[child] };
IF name = NIL THEN RETURN; -- the viewer can't be mapped into a tool
try finding an appropriate label from the tools database, the $IconLabel property, or the name of the tool
IF child.class.flavor = $Sil OR child.class.flavor = $Press THEN {
IF Rope.Equal[child.name, "No Name"] THEN label ← NIL
ELSE { argument ← label; label ← FileNames.GetShortName[label] } }
ELSE {
label ← NARROW[ViewerOps.FetchProp[child, $IconLabel]];
IF Rope.IsEmpty[label] THEN label ← child.label };
it's a tool that creates a viewer; find an appropriate icon for it
iconName ← IF DBIcons.Exists[name] THEN name ELSE "Tool";
[] ← WhiteboardDB.NewIcon[wb, x, y, name, $Tool, iconName, label, argument];
};
OpenProc: PROC[ clientData: REF ANY ] = TRUSTED {
Process.Detach[ FORK OpenIcon[NARROW[clientData]] ];
};
OpenIcon: PROCEDURE[icon: ViewerClasses.Viewer] = {
ENABLE UNWIND => icon.spare0 ← FALSE;
name: ROPE;
type: ATOM;
IF icon = NIL THEN RETURN;
invert the icon first to give information on when display complete
ViewerPrivate.InvertForMenus[icon, 0, 0, icon.ww, icon.wh];
icon.spare0 ← TRUE; -- remember that the viewer is inverted
IF WhiteboardViewers.DontLog[icon] THEN {
it's an ephemeral icon (one that doesn't really exist on the whiteboard); make it a whiteboard
name ← icon.name;
type ← WhiteboardDB.whiteboard }
ELSE [name, type] ← WhiteboardDB.GetIconProps[icon];
SELECT type FROM
NIL => NULL;
$Entity => {
domain, entity, segment: ROPE;
seg: DBDefs.Segment;
[domain ~ domain, entity ~ entity, segment ~ segment] ← DBNames.DecomposeName[name];
seg ← IF NOT Rope.Equal[segment, ""] THEN Atom.MakeAtom[segment] ELSE NIL;
IF seg # NIL THEN
[] ← Nut.Display[entity, domain, seg, icon.parent ! Nut.NoRegistration => { CONTINUE }] };
$Whiteboard => WhiteboardNut.CreateWBViewer[name, icon.parent];
$Text => WhiteboardNut.CreateTextViewer[name];
$Tool => {
Note: in the case of tools, the name of the viewer is taken as the argument to be provided (unless it has the same name as the tool itself)
v: ViewerClasses.Viewer ← ViewerOps.FindViewer[name];
IF v = NIL OR v.destroyed THEN {
argument: ROPE = WhiteboardDB.GetToolArgument[icon];
DBTools.ApplyTool[name, argument] }
ELSE { IF v.iconic THEN ViewerOps.OpenIcon[v]; ViewerOps.PaintViewer[v, all] } };
$ToolRope => { WhiteboardNut.DoCommandFile[name] };
ENDCASE;
now repaint the icon that was inverted when this got started
IF NOT icon.destroyed THEN
ViewerPrivate.InvertForMenus[icon, 0, 0, icon.ww, icon.wh];
icon.spare0 ← FALSE -- reset the inverted bit (checked by PaintIconic)
};
OpenFullProc: PROC[ clientData: REF ANY ] = {
viewer: ViewerClasses.Viewer = NARROW[clientData];
CloseViewers: ViewerOps.EnumProc = {
IF v.column = viewer.column THEN ViewerOps.CloseViewer[v];
};
IF viewer # NIL THEN ViewerOps.EnumerateViewers[CloseViewers];
TRUSTED { Process.Detach[ FORK OpenIcon[NARROW[clientData]] ] };
};
ExpandProc: PROC[parent, wb: ViewerClasses.Viewer, wbName: ROPE] = {
wbList: LIST OF ROPE ← WhiteboardDB.GetChildren[wbName];
WhiteboardViewers.Expand[parent, wb, wbList];
};
Registration (with Commander)
RegisterProcs: PROC[] = {
Commander.Register[key: "Whiteboard", proc: DisplayIt, doc: "\nDisplays the named whiteboard"];
Commander.Register[key: "WBDisplay", proc: DisplayIt, doc: "\nDisplays the named whiteboard"];
Commander.Register[key: "WBCreate", proc: NewIt, doc: "Creates a new whiteboard with the given name"];
Commander.Register[key: "WBDestroy", proc: DestroyIt, doc: "\nDestroys the named whiteboard (be careful!)"];
Commander.Register[key: "WBCopy", proc: CopyIt, doc: "\nCopyWB <from> <to> (for copying whiteboards)"];
Commander.Register[key: "WBlist", proc: Enumerate,
doc: "\nEnumerates whiteboards contained in the named whiteboard\n (Enumerates all whiteboards if no name is given)"];
Commander.Register[key: "WBOpen", proc: OpenIt, doc: "\nWBOpen <file> opens a new whiteboard database (closing a previously open one, if necessary)"];
Commander.Register[key: "WBClose", proc: CloseIt, doc: "\nWBClose closes the database connections whiteboards uses and destroys all current whiteboard viewers"];
};
DisplayIt: Commander.CommandProc = {
ENABLE WhiteboardDB.WBError => {
SELECT reason FROM
$ServerDown => {msg ← "Display Failed -- server unavailable; retry later"; CONTINUE};
$TransactionAbort => {msg ← "Display Failed -- transaction aborted; retry later"; CONTINUE};
ENDCASE => REJECT;
};
h: IO.STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
[] ← h.SkipWhitespace[];
IF h.EndOf THEN {
msg ← "A whiteboard name must be supplied.";
RETURN };
name ← h.GetTokenRope[].token;
IF NOT WhiteboardDB.WBExists[name] THEN
msg ← Rope.Cat["Whiteboard ", name, " doesn't exist."]
ELSE [] ← WhiteboardDB.Display[name];
};
NewIt: Commander.CommandProc = {
ENABLE WhiteboardDB.WBError => {
SELECT reason FROM
$ServerDown => {msg ← "Display Failed -- server unavailable; retry later"; CONTINUE};
$TransactionAbort => {msg ← "Display Failed -- transaction aborted; retry later"; CONTINUE};
$ReadOnly => {msg ← "Can't create new whiteboard -- database is readonly"; CONTINUE};
ENDCASE => REJECT;
};
h: IO.STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
[] ← h.SkipWhitespace[];
IF h.EndOf THEN {
msg ← "A whiteboard name must be supplied.";
RETURN };
name ← h.GetTokenRope[].token;
IF WhiteboardDB.WBExists[name] THEN
msg ← Rope.Cat["Whiteboard ", name, " already exists."]
ELSE [] ← WhiteboardDB.New[name];
};
DestroyIt: Commander.CommandProc = {
ENABLE WhiteboardDB.WBError => {
SELECT reason FROM
$ServerDown => {msg ← "Destroy Failed -- server unavailable; retry later"; CONTINUE};
$TransactionAbort => {msg ← "Destroy Failed -- transaction aborted; retry later"; CONTINUE};
$ReadOnly => {msg ← "Destroy Failed -- database is readonly"; CONTINUE};
ENDCASE => REJECT;
};
h: IO.STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
[] ← h.SkipWhitespace[];
IF h.EndOf THEN {
msg ← "A whiteboard name must be supplied.";
RETURN };
name ← h.GetTokenRope[].token;
IF NOT WhiteboardDB.WBExists[name] THEN msg ← "No such whiteboard"
ELSE WhiteboardDB.Destroy[name];
};
CopyIt: Commander.CommandProc = {
ENABLE WhiteboardDB.WBError => {
SELECT reason FROM
$ServerDown => {msg ← "Copy Failed -- server unavailable; retry later"; CONTINUE};
$TransactionAbort => {msg ← "Copy Failed -- transaction aborted; retry later"; CONTINUE};
$ReadOnly => {msg ← "Copy Failed -- database is readonly"; CONTINUE};
ENDCASE => REJECT;
};
h: IO.STREAM = IO.RIS[cmd.commandLine];
from, to: ROPE;
[] ← h.SkipWhitespace[];
IF h.EndOf THEN {
msg ← "Syntax is: CopyWB <from> <to>";
RETURN };
from ← h.GetTokenRope[].token;
[] ← h.SkipWhitespace[];
IF h.EndOf THEN {
msg ← "Syntax is: CopyWB <from> <to>";
RETURN };
to ← h.GetTokenRope[].token;
IF NOT WhiteboardDB.WBExists[from] THEN {
msg ← "No such whiteboard to copy from";
RETURN };
WhiteboardDB.CopyWB[from, to];
};
Enumerate: Commander.CommandProc = {
ENABLE WhiteboardDB.WBError => {
SELECT reason FROM
$ServerDown => {msg ← "Enumerate Failed -- server unavailable; retry later"; CONTINUE};
$TransactionAbort => {msg ← "Enumerate Failed -- transaction aborted; retry later"; CONTINUE};
ENDCASE => REJECT;
};
h: IO.STREAM = IO.RIS[cmd.commandLine];
pattern: ROPE;
wbList: LIST OF ROPE;
[] ← h.SkipWhitespace[];
IF h.EndOf THEN pattern ← NIL ELSE pattern ← h.GetLineRope[];
wbList ← WhiteboardDB.Enumerate[pattern];
IF wbList = NIL THEN msg ← "No whiteboards matching pattern"
ELSE TRUSTED {
FOR wbNames: LIST OF ROPE ← wbList, wbNames.rest UNTIL wbNames = NIL DO
createDate: BasicTime.GMT = WhiteboardDB.GetCreateDate[wbNames.first];
dateRope: Rope.ROPE = IF createDate = BasicTime.nullGMT THEN "unknown" ELSE LOOPHOLE[Convert.RopeFromTime[createDate]];
msg ← Rope.Cat[msg, wbNames.first, " last edited: "];
msg ← Rope.Cat[msg, dateRope, "\n"]
ENDLOOP;
};
};
OpenIt: Commander.CommandProc = {
ENABLE WhiteboardDB.WBError => {
SELECT reason FROM
$ServerDown => {msg ← "Server unavailable; retry later"; CONTINUE};
$NoDatabaseOpen => {msg ← "Must supply a database name"; CONTINUE};
ENDCASE => REJECT;
};
h: IO.STREAM = IO.RIS[cmd.commandLine];
name: ROPE;
[] ← h.SkipWhitespace[];
IF h.EndOf THEN name ← NIL ELSE name ← h.GetLineRope[];
WhiteboardDB.EstablishWhiteboardDB[name]
};
CloseIt: Commander.CommandProc = { WhiteboardDB.Close[] };
Initialization
RegisterProcs[];
END.