WalnutViewerImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Contents: Implementation of Viewers interface (WalnutViewer).
Created by: Willie-Sue Haugeland on March 8, 1983 (copied from NutViewerMiscImpl)
Willie-Sue on January 20, 1984 2:40:23 pm PST
Russ Atkinson (RRA) April 25, 1985 3:08:29 am PST
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.