PeanutWindowImpl.mesa
Copyright (C) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.
Written by Scott McGregor, February 1983
Last edited by Paxton on March 1, 1983 8:59 am
Last edited by McGregor on March 4, 1983 9:55 am
Last Edited by: Pausch, July 14, 1983 2:28 pm
Last Edited by: Wyatt, January 18, 1985 10:55:44 am PST
DIRECTORY
Buttons USING [Create],
Containers USING [Container, Create, ChildYBound, ChildXBound],
Icons USING [IconFlavor, NewIconFromFile],
Menus USING [AppendMenuEntry, ClickProc, CreateEntry, CreateMenu, Menu],
PeanutProfile USING [startIconic, windowHeight],
PeanutWindow USING [],
Rope USING [ROPE],
Rules USING [Create, Rule],
TypeScript USING [Create, PutChar, PutRope, PutText, TS],
VFonts USING [StringWidth],
ViewerOps USING [DestroyViewer, MoveViewer, PaintViewer],
ViewerSpecs USING [openRightWidth, scrollBarW];
PeanutWindowImpl: CEDAR MONITOR
IMPORTS Buttons, Containers, Icons, Menus, PeanutProfile, Rules, TypeScript, VFonts, ViewerOps, ViewerSpecs
EXPORTS PeanutWindow =
BEGIN
abortFlag: PUBLIC BOOL ← FALSE;
OutputRope: PUBLIC ENTRY PROC [text: Rope.ROPE] = BEGIN
ENABLE ANY => UNWIND;
IF ~Destroyed[] THEN TypeScript.PutRope[peanutScript, text];
END;
OutputText: PUBLIC ENTRY PROC [text: REF READONLY TEXT] = BEGIN
ENABLE ANY => UNWIND;
IF ~Destroyed[] THEN TypeScript.PutText[peanutScript, text];
END;
OutputChar: PUBLIC ENTRY PROC [char: CHAR] = BEGIN
ENABLE ANY => UNWIND;
IF ~Destroyed[] THEN TypeScript.PutChar[peanutScript, char];
END;
SetNewMail: PUBLIC ENTRY PROC [newMail: BOOL] = BEGIN
ENABLE ANY => UNWIND;
IF newMailExists=newMail THEN RETURN;
newMailExists ← newMail;
IF Destroyed[] THEN RETURN;
peanutParent.icon ← IF newMailExists THEN newMailIcon ELSE noMailIcon;
peanutParent.name ← Caption[newMailExists];
ViewerOps.PaintViewer[peanutParent, caption];
END;
AddCommand: PUBLIC ENTRY PROC [name: Rope.ROPE, proc: Menus.ClickProc, data: REF ANY ← NIL, fork: BOOL ← TRUE, guarded: BOOL ← FALSE] = BEGIN
ENABLE ANY => UNWIND;
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name, proc, data, NIL, fork, guarded]];
IF peanutScript#NIL THEN ViewerOps.PaintViewer[peanutParent, all];
END;
AddButton: PUBLIC ENTRY PROC [name: Rope.ROPE, proc: Menus.ClickProc, data: REF ANY ← NIL, fork: BOOL ← TRUE, guarded: BOOL ← FALSE, redisplay: BOOL ← TRUE] = BEGIN
ENABLE ANY => UNWIND;
buttonHeight: INTEGER = 15;
buttonSpacing: INTEGER = 5;
width: INTEGER;
IF Destroyed[] THEN RETURN;
width ← VFonts.StringWidth[name]+6;
IF width+buttonX>maxButtonX THEN BEGIN
ViewerOps.MoveViewer[peanutRule, peanutRule.wx, peanutRule.wy+buttonHeight, peanutRule.ww, peanutRule.wh, FALSE];
ViewerOps.MoveViewer[peanutScript, peanutScript.wx, peanutScript.wy+buttonHeight, peanutScript.ww, peanutScript.wh-buttonHeight, FALSE];
buttonX ← 0;
peanutParent.openHeight ← peanutParent.openHeight+buttonHeight;
END;
[] ← Buttons.Create[info: [parent: peanutParent, name: name, wx: buttonX, wy: peanutRule.wy-buttonHeight, border: FALSE, scrollable: FALSE], proc: proc, clientData: data, fork: fork, guarded: guarded];
buttonX ← buttonX+width+buttonSpacing;
IF ~peanutParent.iconic AND redisplay THEN ViewerOps.PaintViewer[peanutParent, all];
END;
Create: PUBLIC ENTRY PROC RETURNS [new: BOOL] = BEGIN
ENABLE ANY => UNWIND;
peanutOpenHeight: INTEGER;
startIconic: BOOLEAN;
IF ~Destroyed[] THEN RETURN [FALSE]; -- already exists
peanutOpenHeight ← PeanutProfile.windowHeight;
startIconic ← PeanutProfile.startIconic;
peanutParent ← Containers.Create[[name: Caption[newMailExists], iconic: startIconic, icon: IF newMailExists THEN newMailIcon ELSE noMailIcon, column: right, openHeight: peanutOpenHeight, menu: menu, scrollable: FALSE]];
peanutRule ← Rules.Create[[parent: peanutParent, wx: 0, wy: 0, ww: maxButtonX, wh: 1, scrollable: FALSE, border: FALSE]];
peanutScript ← TypeScript.Create[[parent: peanutParent, wx: 0, wy: peanutRule.wy+peanutRule.wh, ww: maxButtonX, wh: 60, scrollable: TRUE, border: FALSE]];
Containers.ChildXBound[peanutParent, peanutRule];
Containers.ChildXBound[peanutParent, peanutScript];
Containers.ChildYBound[peanutParent, peanutScript];
buttonX ← LAST[INTEGER]/2;
RETURN [TRUE];
END;
Destroy: PUBLIC ENTRY PROC = BEGIN
ENABLE ANY => UNWIND;
IF ~Destroyed[] THEN ViewerOps.DestroyViewer[peanutParent];
peanutParent ← peanutScript ← NIL;
END;
Destroyed: PROC RETURNS [destroyed: BOOL] = BEGIN
IF peanutParent=NIL THEN RETURN [TRUE]
ELSE IF peanutParent.destroyed THEN {peanutParent←peanutScript←NIL; RETURN [TRUE]};
RETURN [FALSE];
END;
newMailCaption: Rope.ROPE ~ "Peanut - You have new mail";
noNewMailCaption: Rope.ROPE ~ "Peanut - No new mail";
Caption: PROC [newMail: BOOL] RETURNS [name: Rope.ROPE] = BEGIN
IF newMail THEN RETURN[newMailCaption] ELSE RETURN[noNewMailCaption];
END;
peanutParent: PUBLIC Containers.Container;
peanutRule: Rules.Rule;
peanutScript: TypeScript.TS;
menu: PUBLIC Menus.Menu ← Menus.CreateMenu[];
newMailIcon: PUBLIC Icons.IconFlavor ← Icons.NewIconFromFile["Peanut.icons", 0];
noMailIcon: PUBLIC Icons.IconFlavor ← Icons.NewIconFromFile["Peanut.icons", 1];
messageSetIcon: PUBLIC Icons.IconFlavor ← Icons.NewIconFromFile["Peanut.icons",2];
dirtyMessageSetIcon: PUBLIC Icons.IconFlavor ← Icons.NewIconFromFile["Peanut.icons", 3];
mailMessageIcon: PUBLIC Icons.IconFlavor ← Icons.NewIconFromFile["Peanut.icons", 4];
dirtyMailMessageIcon: PUBLIC Icons.IconFlavor ← Icons.NewIconFromFile["Peanut.icons", 5];
maxButtonX: INTEGER = ViewerSpecs.openRightWidth-ViewerSpecs.scrollBarW-4;
buttonX: INTEGER;
newMailExists: BOOL ← FALSE;
END.