ViewerOpsImplB.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, April 21, 1985 4:04:37 pm PST
Russ Atkinson (RRA) August 7, 1985 9:15:55 pm PDT
DIRECTORY
Carets USING [ResumeCarets, SuspendCarets],
CedarProcess USING [DoWithPriority],
Cursors USING [InvertCursor, SetCursor],
InputFocus USING [GetInputFocus, SetInputFocus],
Menus USING [CopyMenu, Menu],
MessageWindow USING [Append, Blink],
RefTab USING [Create, Fetch, Ref, Store],
Rope USING [Compare, ROPE],
TIPUser USING [TIPScreenCoords],
ViewerBLT USING [Invalidate],
ViewerClasses USING [Column, Viewer, ViewerClass, ViewerFlavor],
ViewerEvents USING [ProcessEvent],
ViewerForkers USING [ForkPaint],
ViewerLocks USING [CallUnderViewerTreeLock, CallUnderWriteLock],
ViewerGroupLocks USING [CallRootAndLinksUnderWriteLock],
ViewerOps USING [ComputeColumn, EnumProc, EstablishViewerPosition, PaintViewer],
ViewerPrivate USING [GreyScreen, rootViewerTree, WaitForPaintingToFinish],
ViewerSpecs USING [captionHeight, menuBarHeight, menuHeight, windowBorderSize],
WindowManager USING [colorDisplayOn];
ViewerOpsImplB:
CEDAR
PROGRAM
IMPORTS Carets, CedarProcess, Cursors, InputFocus, Menus, MessageWindow, RefTab, Rope, ViewerBLT, ViewerEvents, ViewerForkers, ViewerGroupLocks, ViewerLocks, ViewerOps, ViewerPrivate, ViewerSpecs, WindowManager
EXPORTS ViewerClasses, ViewerOps
SHARES Menus, ViewerEvents
= BEGIN OPEN ViewerClasses, ViewerSpecs, ViewerOps, WindowManager;
ROPE: TYPE = Rope.ROPE;
classTable: RefTab.Ref ← RefTab.Create[mod:31];
to hold viewer classes
RegisterViewerClass:
PUBLIC
PROC [flavor: ViewerFlavor, class: ViewerClass] = {
let the Viewer package know about a new class of viewer.
class.flavor ← flavor;
[] ← RefTab.Store[classTable, flavor, class];
};
FetchViewerClass:
PUBLIC
PROC [flavor: ViewerFlavor]
RETURNS [ViewerClass] = {
class information from an existing viewer class.
IF flavor = $TypeScript THEN flavor ← $Typescript;
RETURN[NARROW[RefTab.Fetch[classTable, flavor].val]];
};
EnumerateViewers:
PUBLIC
PROC [enum: EnumProc] = {
Safe in that caller can move the enumerated viewer in the tree in which case all viewers get seen at least once
FOR c: Column
DECREASING
IN Column
DO
-- decreasing so will try static viewers last
v: Viewer ← ViewerPrivate.rootViewerTree[c];
next: Viewer;
UNTIL v=
NIL
DO
next ← v.sibling;
IF ~enum[v] THEN RETURN;
v ← next;
ENDLOOP;
ENDLOOP;
};
EnumerateChildren:
PUBLIC
PROC [viewer: Viewer, enum: EnumProc] = {
v: Viewer ← viewer.child;
next: Viewer;
WHILE v#
NIL
DO
next ← v.sibling;
EnumerateChildren[v, enum];
IF ~enum[v] THEN RETURN;
v ← next;
ENDLOOP;
};
FindViewer:
PUBLIC
PROC [name:
ROPE]
RETURNS [viewer: Viewer] = {
MatchName: EnumProc = {
IF Rope.Compare[name, v.name,
FALSE]=equal
THEN {
viewer ← v;
RETURN[FALSE];
}
ELSE RETURN[TRUE];
};
EnumerateViewers[MatchName];
};
SaveAborted: PUBLIC ERROR [error: ROPE] = CODE; -- exported to ViewerClasses
SaveViewer:
PUBLIC
PROC [viewer: Viewer] = {
innerSaveFile:
PROC = {
list: LIST OF Viewer;
errorMessage: ROPE ← NIL;
First interogate the preSave procedures registered for this viewer to see if we should abort the save.
FOR v: Viewer ← viewer, v.link
WHILE v #
NIL
DO
IF ViewerEvents.ProcessEvent[save, v, TRUE].abort THEN RETURN;
IF v.link = viewer THEN EXIT;
ENDLOOP;
Now post the Save message in the caption(s)
FOR v: Viewer ← viewer, v.link
WHILE v #
NIL
DO
v.saveInProgress ← TRUE;
PaintViewer[v, caption, FALSE];
list ← CONS[v, list];
IF v.link = viewer THEN EXIT;
ENDLOOP;
Now call the Save procedure for the class (if any)
IF viewer.class.save=
NIL
THEN errorMessage ← "no save procedure in viewer class"
ELSE viewer.class.save[viewer ! SaveAborted => { errorMessage ← error; CONTINUE }];
IF errorMessage#
NIL
THEN {
MessageWindow.Append["Can't SAVE -- ", TRUE];
MessageWindow.Append[errorMessage];
MessageWindow.Blink[];
};
Finally, post the notice that the viewer is no longer being saved, and notify the postSave procedures registered for this viewer.
FOR saved:
LIST
OF Viewer ← list, saved.rest
UNTIL saved =
NIL
DO
v: Viewer = saved.first;
IF v.destroyed THEN LOOP;
IF errorMessage=NIL THEN v.newVersion ← v.newFile ← FALSE;
v.saveInProgress ← FALSE;
PaintViewer[v, caption, FALSE];
[] ← ViewerEvents.ProcessEvent[save, v, FALSE];
ENDLOOP;
};
ViewerGroupLocks.CallRootAndLinksUnderWriteLock[innerSaveFile, viewer];
};
RestoreViewer:
PUBLIC
PROC [viewer: Viewer] = {
RRA: for some reason, reset of a split viewer is fatal. I don't have time to fix this, but I can keep it from hurting anyone (I think).
innerRestore:
PROC = {
IF viewer.link # NIL THEN {linked ← TRUE; RETURN};
KillInputFocus[viewer];
IF viewer.class.init # NIL THEN viewer.class.init[viewer];
viewer.newVersion ← viewer.newFile ← FALSE;
ViewerForkers.ForkPaint[viewer: viewer, hint: all];
};
linked: BOOL ← FALSE;
ViewerGroupLocks.CallRootAndLinksUnderWriteLock[innerRestore, viewer];
IF linked
THEN {
MessageWindow.Append["Sorry, can't reset a split viewer!"];
MessageWindow.Blink[];
};
};
KillInputFocus:
PROC [viewer: Viewer] = {
focus: Viewer ← InputFocus.GetInputFocus[].owner;
WHILE focus #
NIL
DO
IF focus # viewer
THEN focus ← focus.parent
ELSE {InputFocus.SetInputFocus[]; EXIT};
ENDLOOP;
};
SetMenu:
PUBLIC
PROC [viewer: Viewer, menu: Menus.Menu, paint:
BOOL ←
TRUE] = {
sameSize:
BOOL = (menu#
NIL
AND viewer.menu#
NIL
AND
viewer.menu.linesUsed=menu.linesUsed);
IF viewer.iconic THEN paint ← FALSE;
IF viewer.parent # NIL THEN ERROR;
viewer.menu ← IF menu=NIL THEN NIL ELSE Menus.CopyMenu[menu];
IF ~sameSize
AND paint
THEN
EstablishViewerPosition[viewer, viewer.wx, viewer.wy, viewer.ww, viewer.wh];
IF paint
THEN
ViewerForkers.ForkPaint[viewer: viewer, hint: IF sameSize THEN menu ELSE all, tryShortCuts: TRUE];
};
IndicateNewVersion:
PUBLIC
PROC [viewer: Viewer] = {
Can't lock this because some callers do not have the proper locks set. The code is reasonably careful, and we fork all of the paints.
FOR v: Viewer ← viewer, v.link
WHILE v #
NIL
DO
IF ViewerEvents.ProcessEvent[edit, v, TRUE].abort THEN RETURN;
IF v.link = viewer THEN EXIT;
ENDLOOP;
FOR v: Viewer ← viewer, v.link
WHILE v #
NIL
DO
v.newVersion ← TRUE;
ViewerForkers.ForkPaint[viewer: v, hint: caption, tryShortCuts: TRUE];
[] ← ViewerEvents.ProcessEvent[edit, v, FALSE];
IF v.link = viewer THEN EXIT;
ENDLOOP;
};
SetNewFile:
PUBLIC
PROC [viewer: Viewer] = {
Can't lock this because some callers do not have the proper locks set. The code is reasonably careful, and we fork all of the paints.
FOR v: Viewer ← viewer, v.link
WHILE v #
NIL
DO
v.newFile ← TRUE;
ViewerForkers.ForkPaint[viewer: v, hint: caption, tryShortCuts: TRUE];
IF v.link = viewer THEN EXIT;
ENDLOOP;
};
SetOpenHeight:
PUBLIC
PROC [viewer: Viewer, clientHeight:
INTEGER] = {
innerSetHeight:
PROC = {
wbs: INTEGER ~ IF viewer.border THEN ViewerSpecs.windowBorderSize ELSE 0;
h: INTEGER ← clientHeight;
h ← h+(IF viewer.caption THEN ViewerSpecs.captionHeight ELSE wbs); -- top border or caption
IF viewer.menu#
NIL
THEN {
menu and menu bar
lines: NAT ~ viewer.menu.linesUsed;
h ← h+lines*ViewerSpecs.menuHeight+ViewerSpecs.menuBarHeight;
};
h ← h+wbs; -- bottom border
viewer.openHeight ← h;
};
ViewerLocks.CallUnderWriteLock[innerSetHeight, viewer];
};
SaveAllEdits:
PUBLIC
PROC = {
poor man's crash recovery
Save: EnumProc = {
Cursors.InvertCursor[];
IF (v.newVersion
OR v.newFile)
AND v.class.save #
NIL THEN
v.class.save[v, TRUE ! ANY => CONTINUE];
v.newVersion ← v.newFile ← FALSE;
IF v.icon=dirtyDocument THEN v.icon ← document;
IF v.link#
NIL
THEN
FOR t: Viewer ← v.link, t.link
UNTIL t=v
DO
t.newVersion ← t.newFile ← FALSE;
ENDLOOP;
Cursors.InvertCursor[];
RETURN[TRUE];
};
PaintCaption: EnumProc = { PaintViewer[v, caption] };
inner:
PROC = {
Cursors.SetCursor[activate];
EnumerateViewers[Save];
Cursors.SetCursor[textPointer];
EnumerateViewers[PaintCaption]; -- ok if this doesn't finish
};
CedarProcess.DoWithPriority[foreground, inner];
};
PaintEverything:
PUBLIC
PROC ~ {
inner:
PROC = {
ViewerPrivate.GreyScreen[bw, 0, 0, 9999, 9999];
ViewerBLT.Invalidate[];
ComputeColumn[static];
ComputeColumn[left];
ComputeColumn[right];
IF WindowManager.colorDisplayOn THEN ComputeColumn[color];
};
Carets.SuspendCarets[];
ViewerLocks.CallUnderViewerTreeLock[inner];
ViewerPrivate.WaitForPaintingToFinish[];
Carets.ResumeCarets[];
};
UserToScreenCoords:
PUBLIC
PROC [self: Viewer, vx, vy:
INTEGER ← 0]
RETURNS [sx, sy:
INTEGER] ~ {
sx ← vx;
sy ← vy;
FOR viewer: Viewer ← self, viewer.parent
UNTIL viewer=
NIL
DO
parent: Viewer ~ viewer.parent;
invert: BOOL ~ (parent#NIL AND parent.class.topDownCoordSys);
sx ← sx+viewer.cx+viewer.wx;
sy ← sy+viewer.cy+(IF invert THEN parent.ch-(viewer.wy+viewer.wh) ELSE viewer.wy);
ENDLOOP;
};
TopLevelHit:
PROC[x, y:
INTEGER, color:
BOOL]
RETURNS[Viewer] = {
FOR column: Column
DECREASING
IN Column
DO
firstInColumn: Viewer ~ ViewerPrivate.rootViewerTree[column];
FOR v: Viewer ← firstInColumn, v.sibling
UNTIL v=
NIL
DO
IF x IN[v.wx..v.wx+v.ww) AND y IN[v.wy..v.wy+v.wh)
AND color=(v.column=color AND NOT v.iconic) THEN RETURN[v];
ENDLOOP;
ENDLOOP;
RETURN[NIL];
};
ViewerHit:
PROC [parent: Viewer, px, py:
INTEGER]
RETURNS [viewer: Viewer, x, y:
INTEGER, client:
BOOL] ~ {
IF
NOT parent.iconic
AND px
IN[parent.cx..parent.cx+parent.cw)
AND py
IN[parent.cy..parent.cy+parent.ch)
THEN {
topDown: BOOL ~ parent.class.topDownCoordSys;
x ← px-parent.cx; y ← py-parent.cy;
FOR v: Viewer ← parent.child, v.sibling
UNTIL v=
NIL
DO
wx: INTEGER ~ v.wx;
wy: INTEGER ~ IF topDown THEN parent.ch-(v.wy+v.wh) ELSE v.wy;
IF x
IN[wx..wx+v.ww)
AND y
IN[wy..wy+v.wh)
THEN
RETURN ViewerHit[v, x-wx, y-wy];
ENDLOOP;
RETURN [viewer: parent, x: x, y: y, client: TRUE];
}
ELSE RETURN [viewer: parent, x: px, y: py, client: FALSE];
};
MouseInViewer:
PUBLIC
PROC[tsc: TIPUser.TIPScreenCoords]
RETURNS [viewer: Viewer ←
NIL, client:
BOOL ←
FALSE] ~ {
parent: Viewer ~ TopLevelHit[tsc.mouseX, tsc.mouseY, tsc.color];
IF parent#
NIL
THEN
[viewer, tsc.mouseX, tsc.mouseY, client] ←
ViewerHit[parent, tsc.mouseX-parent.wx, tsc.mouseY-parent.wy];
};
END.