WalnutViewerImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Willie-Sue on May 3, 1985 12:43:33 pm PDT
Contents: Implementation of Viewers interface (WalnutViewer).
Created by: Willie-Sue Haugeland on March 8, 1983 (copied from NutViewerMiscImpl)
DIRECTORY
Rope,
MBQueue USING [CreateButton, CreateMenuEntry, Queue],
Buttons USING[ButtonProc, Create],
Containers USING [ChildXBound, ChildYBound],
Labels USING[Create],
Menus USING[MenuEntry, MenuProc],
Rules USING [Create],
TypeScript USING [Create],
ViewerClasses,
ViewerTools USING [MakeNewTextViewer, SetContents],
ViewerSpecs USING [openTopY],
VFonts USING[defaultFont, Font],
WalnutViewer;
WalnutViewerImpl:
CEDAR
PROGRAM
IMPORTS
Buttons, Containers, Labels, MBQueue,
Rules, TypeScript, ViewerSpecs, ViewerTools, VFonts
EXPORTS WalnutViewer =
BEGIN OPEN WalnutViewer;
Types and global variables
entryHeight: INTEGER = 14;
yTextFudge: INTEGER = 0;
xTextFudge: INTEGER = 8;
xFudge: INTEGER = 4;
yFudge: INTEGER = 0;
Viewer: TYPE = ViewerClasses.Viewer;
ViewerRec: TYPE = ViewerClasses.ViewerRec;
ROPE: TYPE = Rope.ROPE;
Queue: TYPE = MBQueue.Queue;
creates text viewer on line after sib, full width of parent
NextTextViewer:
PUBLIC
PROC[sib: Viewer]
RETURNS [nV: Viewer] =
BEGIN
nV← ViewerTools.MakeNewTextViewer[
info: [parent: sib.parent, wy: sib.wy+sib.wh, ww: sib.parent.ww,
wh: ViewerSpecs.openTopY]];
Containers.ChildXBound[sib.parent, nV];
Containers.ChildYBound[sib.parent, nV];
END;
creates a text viewer, next right on the same line as v
v must be a Viewer, not NIL
NextRightTextViewer:
PUBLIC
PROC[sib: Viewer, w:
INTEGER]
RETURNS [nV: Viewer] =
BEGIN
IF ~CheckAborted[sib] THEN RETURN;
nV← ViewerTools.MakeNewTextViewer[
info: [parent: sib.parent, wx: sib.wx+sib.ww+xFudge, wy: sib.wy,
ww: w, wh: entryHeight, border: FALSE]];
END;
makes a label which is the first one in a viewer, at standard Y value
FirstLabel:
PUBLIC
PROC[name:
ROPE, parent: Viewer]
RETURNS [nV: Viewer] =
BEGIN
IF ~CheckAborted[parent]
THEN
RETURN;
nV← Labels.Create[
info: [name: name, parent: parent, wh: entryHeight, wy: 1,
wx: IF parent.scrollable THEN 0 ELSE xFudge, border: FALSE]]
END;
sib is a viewer to the left or above the label to be made
AnotherLabel:
PUBLIC
PROC[name:
ROPE, sib: Viewer←
NIL, newLine:
BOOL←
FALSE]
RETURNS [nV: Viewer] =
BEGIN
info: ViewerRec← [name: name, parent: sib.parent, wy: sib.wy, wh: entryHeight,
border: FALSE];
IF ~CheckAborted[sib] THEN RETURN;
IF newLine
THEN
{ info.wx←
IF sib.parent.scrollable
THEN 0
ELSE xFudge;
info.wy← info.wy + sib.wh;
}
ELSE info.wx← sib.wx+sib.ww;
nV← Labels.Create[info: info];
END;
If q#NIL THEN button will be serialized with other buttons/menus on q,
otherwise it uses defaultDBQueue
makes a button which is the first one in a viewer
FirstButton:
PUBLIC
PROC[q: Queue, name:
ROPE, proc: Buttons.ButtonProc,
parent: Viewer, data: REF ANY← NIL, border: BOOL← FALSE, width: INTEGER← 0,
guarded: BOOL← FALSE, font: VFonts.Font ← VFonts.defaultFont,
paint: BOOL← TRUE]
RETURNS [nV: Viewer] =
BEGIN
info: ViewerRec←
[name: name, parent: parent, wh: entryHeight, wy: 1, ww: width,
wx: IF parent.scrollable THEN 0 ELSE xFudge, border: border];
IF ~CheckAborted[parent] THEN RETURN;
nV← MBQueue.CreateButton[
q: q, info: info, proc: proc, clientData: data, font: font, guarded: guarded,
paint: paint];
END;
sib is a viewer to the left or above the button to be made
AnotherButton:
PUBLIC
PROC[q: Queue, name:
ROPE, proc: Buttons.ButtonProc,
sib: Viewer, data: REF ANY← NIL, border: BOOL← FALSE, width: INTEGER← 0,
guarded: BOOL← FALSE, font: VFonts.Font ← VFonts.defaultFont, newLine: BOOL← FALSE,
paint:
BOOL←
TRUE]
RETURNS [nV: Viewer] =
BEGIN
info: ViewerRec← [name: name, wy: sib.wy, ww: width, wh: entryHeight,
parent: sib.parent, border: border];
IF ~CheckAborted[sib] THEN RETURN;
IF newLine
THEN
-- first button on new line
{ info.wy← sib.wy + sib.wh + (
IF border
THEN 1
ELSE 0);
-- extra bit
info.wx←
IF sib.parent.scrollable
THEN 0
ELSE xFudge;
}
ELSE
-- next button right on same line as previous
info.wx← sib.wx+sib.ww+xFudge;
RETURN[MBQueue.CreateButton[
q: q, info: info, proc: proc, clientData: data, font: font, guarded: guarded,
paint: paint]]
END;
ImmediateButton:
PUBLIC
PROC[name:
ROPE, proc: Buttons.ButtonProc, border:
BOOL,
sib: Viewer, fork: BOOL← TRUE, guarded: BOOL← FALSE, newLine: BOOL← FALSE]
RETURNS[Viewer] =
BEGIN
info: ViewerClasses.ViewerRec← [name: name, wy: sib.wy, wh: entryHeight,
parent: sib.parent, border: border];
IF newLine THEN -- first button on new line
{ info.wy← sib.wy + sib.wh + (
IF border
THEN 1
ELSE 0);
-- extra bit
info.wx←
IF sib.parent.scrollable
THEN 0
ELSE xFudge;
}
ELSE
-- next button right on same line as previous
info.wx← sib.wx+sib.ww+xFudge;
RETURN[Buttons.Create[info: info, proc: proc, fork: fork, guarded: guarded]];
END;
CreateMenuEntry:
PUBLIC
PROC[q: Queue, name:
ROPE, proc: Menus.MenuProc,
clientData: REF ANY← NIL, documentation: REF ANY← NIL, fork: BOOL← TRUE,
guarded:
BOOL←
FALSE]
RETURNS[Menus.MenuEntry] =
{
RETURN[MBQueue.CreateMenuEntry[q, name, proc, clientData, documentation,
fork, guarded]]};
sib is sibling to create TS after
MakeTypescript:
PUBLIC
PROC[sib: Viewer]
RETURNS [ts: Viewer] =
BEGIN
y: INTEGER← sib.wy+sib.wh+xFudge;
IF ~CheckAborted[sib] THEN RETURN;
ts← TypeScript.Create[
info: [parent: sib.parent, ww: sib.cw, wy: y, wh: sib.parent.ch - y, border: FALSE] ];
Containers.ChildYBound[sib.parent, ts];
Containers.ChildXBound[sib.parent, ts];
END;
MakeBigTextBox:
PUBLIC
PROC[sib: Viewer, contents:
ROPE]
RETURNS [nV: Viewer]=
Makes editable text viewer taking rest of sib.parent's viewer, suitable for msg body or whatever.
BEGIN
y: INTEGER← 0;
oldV: Viewer← sib.parent;
h: INTEGER;
IF ~CheckAborted[sib] THEN RETURN;
IF oldV = NIL THEN oldV← sib ELSE y← sib.wy+sib.wh+xFudge;
h← oldV.ch - y;
nV ← ViewerTools.MakeNewTextViewer[
info: [parent: oldV, wy: y, border: FALSE, ww: oldV.ww, wh: h],
paint: FALSE];
ViewerTools.SetContents[nV, contents];
Containers.ChildYBound[oldV, nV];
Containers.ChildXBound[oldV, nV];
END;
MakeRuler:
PUBLIC
PROC[sib: Viewer, h:
INTEGER← 1]
RETURNS [r: Viewer] =
make a one-bit wide line after sib
BEGIN
IF ~CheckAborted[sib] THEN RETURN;
r← Rules.Create[
info: [parent: sib.parent, wy: sib.wy+sib.wh+1, ww: sib.parent.ww, wh: h]];
Containers.ChildXBound[sib.parent, r];
END;
CheckAborted:
PROC[sib: Viewer]
RETURNS[ok:
BOOL] =
BEGIN
IF sib = NIL THEN RETURN[TRUE];
IF sib.destroyed THEN RETURN[FALSE];
RETURN[TRUE];
END;
END.