MJSContainersImpl.mesa;
Copyright Ó 1991 by Xerox Corporation. All rights reserved.
Edited by McGregor on November 23, 1982 1:30 pm
Last Edited by: Maxwell, June 6, 1983 8:33 am
Last Edited by: Mike Spreitzer, January 9, 1987 9:11:53 pm PST
Last tweaked by Mike Spreitzer on March 16, 1988 4:25:23 pm PST
Eric Nickell, August 28, 1986 5:50:41 am PDT
Copied from ContainersImpl.mesa 6382 6-Jun-83 8:33:21 PDT
DIRECTORY
Atom, MJSContainers, Process, ViewerClasses,
ViewerLocks USING [CallUnderWriteLock],
ViewerOps USING [AddProp, CreateViewer, EstablishViewerPosition, FetchProp, MoveViewer, PaintViewer, RegisterViewerClass];
MJSContainersImpl: CEDAR PROGRAM
IMPORTS Atom, ViewerLocks, ViewerOps
EXPORTS MJSContainers =
BEGIN OPEN MJSContainers;
ViewerList: TYPE ~ LIST OF Viewer;
ContainerData: TYPE = REF ContainerDataRec;
ContainerDataRec: TYPE = RECORD [
class: MJSContainerClass,
recursivelyIconic: BOOL,
scrolled, hscrolled, ch, cw: INTEGER ¬ 0,
yBounded: ViewerList ¬ NIL,
xBounded: ViewerList ¬ NIL,
pendingChangedChildren: BOOL ¬ FALSE,
clientData: REF ANY
];
classProp: ATOM ~ Atom.MakeAtom["Mike Spreitzer December 12, 1983 4:45 pm"];
pccProp: ATOM ~ Atom.MakeAtom["Mike Spreitzer March 16, 1988 3:55:09 pm PST"];
bltH: ViewerClasses.HBltRule ¬ none;
bltV: ViewerClasses.VBltRule ¬ none;
RegisterClass: PUBLIC PROC [viewerFlavor: ATOM, class: MJSContainerClass] =
BEGIN
viewerClass: ViewerClasses.ViewerClass ¬ NEW [ViewerClasses.ViewerClassRec ¬ [
flavor: viewerFlavor,
notify: class.notify,
paint: class.paint,
modify: class.modify,
destroy: class.destroy,
copy: class.copy,
set: class.set,
get: class.get,
init: ContainerInit,
save: class.save,
scroll: ContainerScroll,
hscroll: ContainerHScroll,
caption: class.caption,
adjust: ContainerAdjust,
menu: class.menu,
tipTable: class.tipTable,
topDownCoordSys: TRUE,
bltH: bltH,
bltV: bltV,
icon: class.icon,
cursor: class.cursor]];
ViewerOps.RegisterViewerClass[viewerFlavor, viewerClass];
Atom.PutProp[atom: viewerFlavor, prop: classProp, val: class];
END;
GetClass: PUBLIC PROC [viewerFlavor: ATOM] RETURNS [class: MJSContainerClass] =
{class ¬ NARROW[Atom.GetProp[atom: viewerFlavor, prop: classProp]]};
Create: PUBLIC PROC [viewerFlavor: ATOM, info: ViewerRec ¬ [], paint: BOOL ¬ TRUE] RETURNS [container: MJSContainer] =
{RETURN[ViewerOps.CreateViewer[viewerFlavor, info, paint]]};
ContainerInit: ViewerClasses.InitProc--PROC [self: Viewer]-- =
BEGIN
class: MJSContainerClass ¬ GetClass[self.class.flavor];
self.data ¬ NEW[ContainerDataRec ¬ [
class: class,
recursivelyIconic: RecursivelyIconic[self],
clientData: self.data]];
IF class.init # NIL THEN class.init[self];
END;
RecursivelyIconic: PROC [v: Viewer] RETURNS [BOOL] ~ {
FOR v ¬ v, v.parent WHILE v.parent#NIL DO NULL ENDLOOP;
RETURN [v.iconic]};
ChildXBound: PUBLIC PROC [container: MJSContainer, child: Viewer] = {
cd: ContainerData ¬ NARROW[container.data];
cd.xBounded ¬ CONS[child, cd.xBounded];
};
ChildYBound: PUBLIC PROC [container: MJSContainer, child: Viewer] = {
cd: ContainerData ¬ NARROW[container.data];
cd.yBounded ¬ CONS[child, cd.yBounded];
};
ContainerHScroll: ViewerClasses.HScrollProc = {
[self: ViewerClasses.Viewer, op: ViewerClasses.HScrollOp, amount: INTEGER, shift: BOOLFALSE, control: BOOLFALSE] RETURNS [left: INTEGER, right: INTEGER]
LockedHScroll: PROC ~ {
FOR v: Viewer ¬ self.child, v.sibling UNTIL v=NIL DO
ViewerOps.EstablishViewerPosition[viewer: v, x: v.wx+incr, y: v.wy, w: v.ww, h: v.wh];
ENDLOOP;
cd.hscrolled ¬ cd.hscrolled+incr;
ViewerOps.PaintViewer[viewer: self, hint: client];
};
ComputeHBounds: PROC ~ {
min ¬ INTEGER.LAST;
max ¬ INTEGER.FIRST;
FOR v: Viewer ¬ self.child, v.sibling UNTIL v=NIL DO
min ¬ MIN[min, v.wx];
max ¬ MAX[max, v.wx+v.ww];
ENDLOOP;
IF self.child#NIL --Careful not to overflow-- THEN width ¬ max-min;
};
incr: INTEGER ¬ 0;
min, max, width: INTEGER;
cd: ContainerData ~ NARROW[self.data];
SELECT op FROM
query => {
left, right: INT;
ComputeHBounds[];
IF self.child=NIL OR width=0 THEN RETURN [0, 100];
left ¬ LONG[100]*MAX[0, MIN[width, -cd.hscrolled]]/width;
right ¬ LONG[100]*MAX[0, MIN[width, self.cw-cd.hscrolled]]/width;
RETURN [left, right];
};
left => incr ¬ -amount;
right => incr ¬ MIN[amount, -cd.hscrolled];
thumb => {
newPos: INT;
ComputeHBounds[];
newPos ¬ INT[amount]*width/100;
incr ¬ -cd.hscrolled - (IF amount~<5 THEN INTEGER[newPos] ELSE 0);
};
ENDCASE;
IF incr#0 THEN ViewerLocks.CallUnderWriteLock[proc: LockedHScroll, viewer: self];
};
ContainerScroll: ViewerClasses.ScrollProc--PROC [self: Viewer, op: ScrollOp, amount: INTEGER, shift, control: BOOL ¬ FALSE] RETURNS [top, bottom: INTEGER ¬ LAST [INTEGER]]-- =
BEGIN
cd: ContainerData ¬ NARROW[self.data];
incr, height: INTEGER;
LockedScroll: PROC = {
FOR v: Viewer ¬ self.child, v.sibling UNTIL v=NIL DO
ViewerOps.EstablishViewerPosition[v, v.wx, v.wy+incr, v.ww, v.wh];
ENDLOOP;
cd.scrolled ¬ cd.scrolled+incr;
ViewerOps.PaintViewer[self, client]};
IF cd = NIL THEN RETURN;
IF op=query OR op=thumb THEN BEGIN-- compute total height
min, max: INTEGER;
[min, max] ¬ GetBounds[self];
height ¬ max-min;
END;
IF op=thumb THEN BEGIN
thumbIncr: LONG INTEGER;
thumbIncr ¬ LONG[amount]*height/100;
height ¬ thumbIncr; -- narrow to short integer
END;
IF op=query THEN BEGIN
top, bottom: INT;
IF self.child = NIL OR height=0 THEN RETURN [0, 100];
top ¬ LONG[100]*MAX[0, MIN[height, -cd.scrolled]]/height;
bottom ¬ LONG[100]*MAX[0, MIN[height, self.ch-cd.scrolled]]/height;
RETURN[top, bottom];
END;
incr ¬ SELECT op FROM
up => -amount,
down => MIN[-cd.scrolled, amount],
thumb => -cd.scrolled-(IF amount<5 THEN 0 ELSE height),
ENDCASE => ERROR;
IF incr#0 THEN ViewerLocks.CallUnderWriteLock[LockedScroll, self];
END;
GetBounds: PROC [self: Viewer] RETURNS [min, max: INTEGER] =
BEGIN
min ¬ LAST[INTEGER];
max ¬ -LAST[INTEGER];
FOR v: Viewer ¬ self.child, v.sibling UNTIL v=NIL DO
min ¬ MIN[min, v.wy];
max ¬ MAX[max, v.wy+v.wh];
ENDLOOP;
END;
HScrollOffset: PUBLIC PROC [container: MJSContainer] RETURNS [offLeft: INTEGER] ~ {
cd: ContainerData = NARROW[container.data];
offLeft ¬ IF cd#NIL THEN cd.hscrolled ELSE 0;
};
ScrollOffset: PUBLIC PROC [container: MJSContainer] RETURNS [offTop: INTEGER] =
{cd: ContainerData = NARROW[container.data];
offTop ¬ IF cd # NIL THEN cd.scrolled ELSE 0};
ContainerAdjust: PROC [self: Viewer] RETURNS [adjusted: BOOL ¬ FALSE] --ViewerClasses.AdjustProc-- = {
WITH self.data SELECT FROM
cd: ContainerData => {
wasRecursivelyIconic: BOOL ~ cd.recursivelyIconic;
cd.recursivelyIconic ¬ RecursivelyIconic[self];
{clearPCC: BOOL ~ cd.pendingChangedChildren AND wasRecursivelyIconic AND NOT cd.recursivelyIconic;
IF (NOT (cd.recursivelyIconic AND cd.class.dontAdjustIconic)) AND (clearPCC OR (cd.ch # self.ch OR cd.cw # self.cw) AND (cd.class.adjust # NIL OR cd.xBounded # NIL OR cd.yBounded # NIL))
THEN adjusted ¬ ReallyNoteSize[self, cd, FALSE, clearPCC];
RETURN}};
ENDCASE => adjusted ¬ FALSE;
RETURN};
NoteSize: PUBLIC PROC [container: MJSContainer, mayPaint: BOOL] RETURNS [change: BOOL] = {
cd: ContainerData = NARROW[container.data];
IF cd.recursivelyIconic AND cd.class.dontAdjustIconic THEN RETURN [FALSE];
change ¬ ReallyNoteSize[container, cd, mayPaint, cd.pendingChangedChildren];
RETURN};
ReallyNoteSize: PROC [container: MJSContainer, cd: ContainerData, mayPaint, clearPCC: BOOL] RETURNS [change: BOOL] = {
ReallyFixWidth: PROC =
BEGIN
v: Viewer;
l, last, next: ViewerList ¬ NIL;
cd.ch ¬ container.ch;
cd.cw ¬ container.cw;
FOR l ¬ cd.xBounded, next UNTIL l=NIL DO
v ¬ l.first;
next ¬ l.rest;
IF v.destroyed THEN
{IF last = NIL THEN cd.xBounded ¬ next ELSE last.rest ¬ next}
ELSE {
change ¬ FlushChildX[v] OR change;
last ¬ l;
};
ENDLOOP;
last ¬ NIL;
FOR l: ViewerList ¬ cd.yBounded, next UNTIL l=NIL DO
v ¬ l.first;
next ¬ l.rest;
IF v.destroyed THEN
{IF last = NIL THEN cd.xBounded ¬ next ELSE last.rest ¬ next}
ELSE {
change ¬ FlushChildY[v] OR change;
last ¬ l;
};
ENDLOOP;
IF clearPCC THEN {
cd.pendingChangedChildren ¬ FALSE;
FOR child: Viewer ¬ container.child, child.sibling UNTIL child=NIL DO
IF ViewerOps.FetchProp[child, pccProp]#NIL THEN {
ViewerOps.AddProp[child, pccProp, NIL];
change ¬ cd.class.childAdjust[container, child] # [NIL, FALSE] OR change;
clearPCC ¬ clearPCC};
ENDLOOP;
clearPCC ¬ clearPCC};
END;
change ¬ FALSE;
IF cd.class.adjust # NIL THEN change ¬ cd.class.adjust[container];
ViewerLocks.CallUnderWriteLock[ReallyFixWidth, container];
IF mayPaint AND change THEN ViewerOps.PaintViewer[viewer: container, hint: all];
RETURN};
NoteChildSize: PUBLIC PROC [child: Viewer] RETURNS [viewerToPaint: Viewer, paintColumn: BOOL] = {
parent: Viewer = child.parent;
viewerToPaint ¬ NIL;
paintColumn ¬ FALSE;
IF parent = NIL THEN RETURN;
IF parent.data # NIL THEN WITH parent.data SELECT FROM
cd: ContainerData => IF cd.class.childAdjust=NIL THEN NULL
ELSE IF cd.recursivelyIconic AND cd.class.dontAdjustIconic THEN {
cd.pendingChangedChildren ¬ TRUE;
ViewerOps.AddProp[child, pccProp, pccProp];
}
ELSE [viewerToPaint, paintColumn] ¬ cd.class.childAdjust[parent, child];
ENDCASE => NULL;
};
FlushChildX: PUBLIC PROC [child: Viewer] RETURNS [changed: BOOLEAN] =
BEGIN
temp: INTEGER;
IF changed ¬ (temp ¬ MAX[child.parent.cw-child.wx, 5]) # child.ww THEN
ViewerOps.MoveViewer[viewer: child, x: child.wx, y: child.wy, w: temp, h: child.wh, paint: FALSE];
END;
FlushChildY: PUBLIC PROC [child: Viewer] RETURNS [changed: BOOLEAN] =
BEGIN
temp: INTEGER;
IF changed ¬ (temp ¬ MAX[child.parent.ch-child.wy, 5]) # child.wh THEN
ViewerOps.MoveViewer[viewer: child, x: child.wx, y: child.wy, w: child.ww, h: temp, paint: FALSE];
END;
GetClientData: PUBLIC PROC [container: MJSContainer] RETURNS [clientData: REF ANY] =
BEGIN
cd: ContainerData ¬ NARROW[container.data];
clientData ¬ cd.clientData;
END;
IsMJSContainer: PUBLIC PROC [viewer: Viewer] RETURNS [BOOLEAN] =
{RETURN [viewer.data # NIL AND ISTYPE[viewer.data, ContainerData]]};
RegisterClass[$VanillaMJSContainer, NEW [MJSContainerClassRep ¬ []]];
END.
Edited on July 11, 1983, by Spreitzer
Added using MoreViewerOps to notify on size change.
Edited on July 12, 1983 3:24 pm, by Spreitzer
Fixed ChildZBound implementation to FORK and CallUnderWriteLock.
Simplified code in FixWidth: no manipulating ch & cw directly, no specials for Tioga.
Made ContainerData.scrolled mean ContainerScroll.min.
changes to: DIRECTORY, IMPORTS, ContainerScroll, ContainerPaint, FixWidth, ContainerDataRec, ContainerScroll, LockedScroll (local of ContainerScroll), DIRECTORY, IMPORTS, FixWidth, FixWidth, True, ContainerDataRec, ContainerScroll, FixWidth
Edited on October 31, 1983 9:09 am, by Spreitzer
Added subclassing. Changed ContainerData.scrolled back to original meaning.
changes to: ContainerDataRec, classProp, RegisterClass, GetClass, Create, ContainerInit, ContainerSet, ContainerScroll, GetBounds, ScrollOffset, ContainerPaint, FixWidth, RegisterClass, GetClientData, IsMJSContainer, BEGIN, DIRECTORY, MJSContainersImpl, FlushChildX, FlushChildY, ContainerScroll, ContainerScroll, LockedScroll, ScrollOffset
Edited on April 14, 1985 11:36:01 am PST, by Spreitzer
changes to: ContainerPaint, FixWidth, NoteSize
Spreitzer, May 3, 1985 6:42:02 pm PDT
Updated to use AdjustProcs in Cedar6.0
changes to: RegisterClass, ChildXBound, ContainerScroll
Spreitzer, April 25, 1986 4:07:55 pm PST
Added `upward' notification of positioning.
changes to: NoteChildSize , cd (local of NoteChildSize) 
Eric Nickell, August 28, 1986 5:35:27 am PDT
changes to: HScrollOffset (newly added), ScrollOffset, DIRECTORY, MJSContainersImpl
Last tweaked by Mike Spreitzer on March 16, 1988 4:03:43 pm PST
Added the option to not adjust while iconic.
changes to: ContainerDataRec, ContainerInit, RecursivelyIconic, DIRECTORY, MJSContainersImpl, BEGIN, ViewerList, ContainerData, pccProp, RegisterClass, GetClass, Create, ChildXBound, ChildYBound, ContainerHScroll, LockedHScroll (local of ContainerHScroll), ComputeHBounds (local of ContainerHScroll), ContainerScroll, LockedScroll, GetBounds, HScrollOffset, ScrollOffset, ContainerAdjust, cd (local of ContainerAdjust), NoteSize, ReallyNoteSize, NoteChildSize, FlushChildX, FlushChildY, GetClientData, IsMJSContainer, RegisterClass, END