WhiteboardOpsImpl.mesa
Copyright (C) 1984 by Xerox Corporation. All rights reserved.
Last edited by
Maxwell, June 25, 1984 1:31:29 pm PDT
Cattell, September 1, 1983 10:40 am
Donahue, January 21, 1985 8:51:53 am PST
(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
DIRECTORY
Atom USING[MakeAtom],
Commander USING [CommandProc, Register],
DB,
DBIcons USING [IsRegistered, GetIconNameForEntity],
DBNames USING [DecomposeName, MakeName],
DBTools USING [ViewerToTool, ApplyTool, GetLoadFile],
FileNames USING[GetShortName],
Icons USING [IconFlavor],
InputFocus USING [GetInputFocus, SetInputFocus],
IO,
Menus,
Nut USING [GetNutInfo, SetFrozenProperty, Display, NoRegistration],
Rope,
TIPUser USING[TIPScreenCoords],
ViewerClasses USING [NotifyProc, Column, Viewer, ViewerClass, ViewerRec, ViewerFlavor],
ViewerOps,
ViewerTools,
WhiteboardDB,
WhiteboardNut,
WhiteboardOps,
WhiteboardViewers;
WhiteboardOpsImpl:
CEDAR
PROGRAM
IMPORTS
Atom, Commander, DBIcons, DBNames, DBTools, FileNames, InputFocus, IO, Menus, Nut, Rope, ViewerOps, ViewerTools, WhiteboardDB, WhiteboardNut, WhiteboardViewers
EXPORTS WhiteboardOps
SHARES ViewerOps, ViewerClasses, Menus =
BEGIN
OPEN ViewerClasses, WhiteboardOps;
ROPE: TYPE = Rope.ROPE;
Command interpreter
Notify:
PUBLIC NotifyProc =
BEGIN
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: Viewer =
IF self.parent =
NIL
THEN self
ELSE self.parent;
KillInputFocus[parent]; -- get rid of blinking carat if there is one
SELECT z FROM
$Grow =>
IF parent.class.flavor = $Whiteboard
THEN {
v: Viewer = NearestChild[self, p.mouseX, p.mouseY, $Text];
IF v # NIL THEN GrowBox[parent, v, p.mouseX, p.mouseY] };
$Instructions =>
{ [] ← WhiteboardDB.NewBox[self, 100, 100, 250, 104,
NEW[ViewerTools.TiogaContentsRec ← [contents: "INSTRUCTIONS:\n LEFT => move entity\n shift LEFT => add text box\n ctrl LEFT => delete entity\n MIDDLE => open icon\n shift MIDDLE => open icon fullsize\n ctrl MIDDLE => expand whiteboard\n RIGHT => grow text box"]]] };
$NewBox =>
{ [] ← WhiteboardDB.NewBox[parent, p.mouseX, p.mouseY, 128, 32] };
$Open => {
v: Viewer = NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon];
IF v # NIL THEN OpenProc[v] };
$OpenFull => {
v: Viewer = NearestChild[self, p.mouseX, p.mouseY, $WhiteboardIcon];
IF v # NIL THEN OpenFullProc[v] };
$Remove => {
child: Viewer = NearestChild[self, p.mouseX, p.mouseY];
parent: 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: Viewer = NearestChild[self, p.mouseX, p.mouseY];
parent: 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 ExpandProc[parent, v, name] };
$Freeze =>
{ self: 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: Viewer ← ViewerTools.GetSelectedViewer[];
parent: Viewer = IF self.parent = NIL THEN self ELSE self.parent;
WHILE icon.parent # NIL DO icon ← icon.parent ENDLOOP;
IF icon # NIL THEN AddNewIcon[parent, icon, 100, 100] };
$AddCommandFile => {
parent: Viewer = IF self.parent = NIL THEN self ELSE self.parent;
icon: Viewer ← ViewerTools.GetSelectedViewer[];
IF icon.icon # document THEN RETURN;
[] ← WhiteboardDB.NewIcon[parent, 100, 100, icon.name, $ToolRope, "Typescript", FileNames.GetShortName[icon.name]] };
$Erase =>
{ WhiteboardDB.Erase[self];
ViewerOps.PaintViewer[self, all] };
$Move => {
child: Viewer = NearestChild[self, p.mouseX, p.mouseY];
IF child # NIL THEN MoveChild[child] };
ENDCASE => NULL };
z: TIPUser.TIPScreenCoords => p ← z;
ENDCASE => NULL;
ENDLOOP;
END;
Support routines
KillInputFocus:
PROC [v: Viewer] =
BEGIN
focus: Viewer ← InputFocus.GetInputFocus[].owner;
WHILE focus # v
AND focus #
NIL
DO
focus ← focus.parent
ENDLOOP;
IF focus = v THEN InputFocus.SetInputFocus[];
END;
AddNewIcon:
PROC[wb, child: Viewer, x, y:
INTEGER] =
BEGIN
name, label, iconName, argument: ROPE;
segment: DB.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];
label ← NARROW[ViewerOps.FetchProp[child, $IconLabel]];
IF label = NIL THEN label ← entity;
[] ← WhiteboardDB.NewIcon[wb, x, y, name, $Entity, DBIcons.GetIconNameForEntity[entity, domain, segment], label] };
RETURN };
IF child.icon = document
THEN {
[] ← WhiteboardDB.NewIcon[wb, x, y, child.name, $Text, "Document", FileNames.GetShortName[child.name]];
RETURN };
otherwise it's a tool
This line is a hack to handle ShowPress viewers
IF child.class.flavor = $Container AND child.child # NIL THEN child ← child.child;
[name, label] ← 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 {
IF Rope.Equal[label, ""] THEN label ← NARROW[ViewerOps.FetchProp[child, $IconLabel]];
IF Rope.Equal[label, ""] THEN label ← name };
IF child.icon = typescript
THEN {
we assume that we should save the load file for the tool and load it through a CommandTool when invoked
loadFileName: Rope.ROPE = Rope.Concat["///Commands/", DBTools.GetLoadFile[name]];
[] ← WhiteboardDB.NewIcon[wb, x, y, loadFileName, $ToolRope, "Typescript", label];
RETURN };
it's a tool that creates a viewer; find an appropriate icon for it
iconName ← IF DBIcons.IsRegistered[name].file # NIL THEN name ELSE "Tool";
[] ← WhiteboardDB.NewIcon[wb, x, y, name, $Tool, iconName, label, argument];
END;
OpenProc:
PROC[ clientData:
REF
ANY ] =
{ OpenIcon[NARROW[clientData]] };
OpenIcon:
PROCEDURE[icon: Viewer] =
BEGIN 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
ViewerOps.InvertForMenus[icon, 0, icon.wy, 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: DB.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: 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
ViewerOps.InvertForMenus[icon, 0, icon.wy, icon.ww, icon.wh];
icon.spare0 ← FALSE -- reset the inverted bit (checked by PaintIconic)
END;
OpenFullProc:
PROC[ clientData:
REF
ANY ] =
{ viewer: Viewer =
NARROW[clientData];
CloseViewers: ViewerOps.EnumProc = {
IF v.column = viewer.column THEN ViewerOps.CloseViewer[v] };
IF viewer #
NIL
THEN ViewerOps.EnumerateViewers[CloseViewers];
OpenIcon[NARROW[clientData]] };
ExpandProc:
PROC[parent, wb: Viewer, wbName:
ROPE] =
BEGIN
wbList: LIST OF ROPE ← WhiteboardDB.EnumerateWhiteboards[wbName];
WhiteboardViewers.Expand[parent, wb, wbList];
END;
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: DisplayIt, 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: "WBEnumerate", 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;
success: BOOL;
[] ← h.SkipWhitespace[];
IF h.EndOf
THEN {
msg ← "A whiteboard name must be supplied.";
RETURN };
name ← h.GetID[];
IF
NOT WhiteboardDB.WBExists[name]
THEN {
success ← WhiteboardDB.New[name];
IF success THEN msg ← "New whiteboard created."
ELSE msg ← "Can't create new whiteboard." };
[] ← WhiteboardDB.Display[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.GetID[];
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.GetID[];
[] ← h.SkipWhitespace[];
IF h.EndOf
THEN {
msg ← "Syntax is: CopyWB <from> <to>";
RETURN };
to ← h.GetID[];
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];
name: ROPE;
wbList: LIST OF ROPE;
[] ← h.SkipWhitespace[];
IF h.EndOf THEN name ← NIL ELSE name ← h.GetLineRope[];
IF name #
NIL
AND
NOT WhiteboardDB.WBExists[name]
THEN {
msg ← "No such whiteboard";
RETURN };
wbList ← WhiteboardDB.EnumerateWhiteboards[name];
msg ← NIL;
FOR wbNames:
LIST
OF
ROPE ← wbList, wbNames.rest
UNTIL wbNames =
NIL
DO
msg ← Rope.Cat[msg, wbNames.first, "\n"];
ENDLOOP };
OpenIt: Commander.CommandProc = {
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..