[Indigo]<Whiteboard>Whiteboard>WhiteboardOpsImpl.mesa!14

WhiteboardOpsImpl.mesa

Last edited by

Maxwell, June 25, 1984 1:31:29 pm PDT

Cattell, September 1, 1983 10:40 am

Donahue, June 14, 1985 4:49:17 pm 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

DIRECTORY

Atom USING[MakeAtom],

BasicTime,

Commander USING [CommandProc, Register],

Convert USING[RopeFromTime],

DB,

DBIcons USING [Exists],

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],

Process USING[Detach],

Rope,

TIPUser USING[TIPScreenCoords],

ViewerClasses USING [NotifyProc, Column, Viewer, ViewerClass, ViewerRec, ViewerFlavor],

ViewerOps,

ViewerPrivate USING[InvertForMenus],

ViewerTools,

WhiteboardDB,

WhiteboardNut,

WhiteboardOps,

WhiteboardViewers;

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 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, parent.ch -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, parent.ch - 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;

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: 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];

iconName ← IF DBIcons.Exists[domain] THEN domain ELSE "Acorn";

label ← NARROW[ViewerOps.FetchProp[child, $IconLabel]];

IF label = NIL THEN label ← entity;

[] ← WhiteboardDB.NewIcon[wb, x, y, name, $Entity, iconName, 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, 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.Equal[label, ""] THEN label ← argument };

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.Exists[name] THEN name ELSE "Tool";

[] ← WhiteboardDB.NewIcon[wb, x, y, name, $Tool, iconName, label, argument];

END;

OpenProc: PROC[ clientData: REF ANY ] =

TRUSTED { Process.Detach[ FORK OpenIcon[NARROW[clientData]] ] };

OpenIcon: PROCEDURE[icon: Viewer] =

BEGIN ENABLE UNWIND => icon.spare0 ← FALSE;

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: 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

ViewerPrivate.InvertForMenus[icon, 0, 0, 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];

TRUSTED { Process.Detach[ FORK OpenIcon[NARROW[clientData]] ] } };

ExpandProc: PROC[parent, wb: Viewer, wbName: ROPE] =

BEGIN

wbList: LIST OF ROPE ← WhiteboardDB.GetChildren[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: "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];

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];

[] ← 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];

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 = {

h: IO.STREAM = IO.RIS[cmd.commandLine];

[] ← h.SkipWhitespace[];

IF h.EndOf THEN name ← NIL ELSE name ← h.GetLineRope[];

WhiteboardDB.EstablishWhiteboardDB[name]

};

CloseIt: Commander.CommandProc = { WhiteboardDB.Close[] };

Initialization

RegisterProcs[];

END..