WalnutViewerImpl.mesa
Copyright Ó 1985, 1988, 1992 by Xerox Corporation. All rights reserved.
Willie-Sue on March 9, 1988 12:31:00 pm PST
Contents: Implementation of Viewers interface (WalnutViewer).
Created by: Willie-Sue Haugeland on March 8, 1983 (copied from NutViewerMiscImpl)
DIRECTORY
Rope,
TBQueue 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, TBQueue,
Rules, TypeScript, ViewerSpecs, ViewerTools, VFonts
EXPORTS WalnutViewer =
BEGIN OPEN WalnutViewer;
Types and global variables
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 = TBQueue.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: buttonEntryHeight, 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: buttonEntryHeight, 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: buttonEntryHeight,
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: buttonEntryHeight, wy: 1, ww: width,
wx: IF parent.scrollable THEN 0 ELSE xFudge, border: border];
IF ~CheckAborted[parent] THEN RETURN;
nV ¬ TBQueue.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, guarded:
BOOL ¬
FALSE, font: VFonts.Font ¬ VFonts.defaultFont, newLine:
BOOL ¬
FALSE, paint:
BOOL ¬
TRUE]
RETURNS [nV: Viewer] = {
info: ViewerRec ¬ [name: name, wy: sib.wy, wh: buttonEntryHeight, 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[TBQueue.CreateButton[
q: q, info: info, proc: proc, clientData: data, font: font, guarded: guarded,
paint: paint]]
};
ImmediateButton:
PUBLIC
PROC[name:
ROPE, proc: Buttons.ButtonProc, sib: Viewer, data:
REF
ANY ¬
NIL, border:
BOOL, guarded:
BOOL ¬
FALSE, newLine:
BOOL ¬
FALSE, paint:
BOOL ¬
TRUE]
RETURNS[Viewer] = {
info: ViewerClasses.ViewerRec ¬ [name: name, wy: sib.wy, wh: buttonEntryHeight, 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, clientData: data, guarded: guarded, paint: paint]];
};
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[TBQueue.CreateMenuEntry[
q: q, name: name, proc: proc, clientData: clientData, documentation: documentation,
guarded: guarded, immediate: FALSE]]};
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.