
<<MailingList.mesa; >>
<<Last Edited by: Sweet, September 26, 1984 9:03:40 am PDT>>
DIRECTORY
Ascii,
Buttons,
Commander USING [CommandProc, Register],
Containers USING [ChildXBound, ChildYBound, Container, Create],
Convert,
FS,
IO,
MessageWindow,
RefText,
Rope,
Rules USING [Create, Rule],
TypeScript,
VFonts,
ViewerClasses USING [Viewer, ViewerClassRec],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [CreateViewer, PaintViewer],
ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection];
MailingList: CEDAR PROGRAM                
IMPORTS Buttons, Commander, Containers, Convert, FS, IO, MessageWindow, RefText, Rope, Rules, TypeScript, VFonts, ViewerIO, 
ViewerOps, ViewerTools =
BEGIN
<<The Containers interface is used to create an outer envelope or "container" for the different sections below.  For uniformity, we 
define some standard distances between entries in the tool.>>
entryHeight: CARDINAL = 15;    -- how tall to make each line of items
entryVSpace: CARDINAL = 8;     -- vertical leading space between lines
entryHSpace: CARDINAL = 10;     -- horizontal space between items in a line
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
dash: CHAR = Ascii.ControlV;


Handle: TYPE = REF MyRec;    -- a REF to the data for a particular instance of the sample tool; multiple instances can be created.
MyRec: TYPE = RECORD [    -- the data for a particular tool instance
outer: Containers.Container _ NIL,    -- handle for the enclosing container
height: CARDINAL _ 0,        -- height measured from the top of the container
cmd: CommandViewer,        -- the commands
in: STREAM, eof: BOOLEAN _ FALSE,
out: STREAM,    -- for mailing list file
flipNames: REF BOOL,
tsIn, tsOut: STREAM,
ts: ViewerClasses.Viewer ];        -- the typescript

PromptRec: TYPE = RECORD [
handle: Handle, viewer: ViewerClasses.Viewer _ NIL];
PromptHandle: TYPE = REF PromptRec;
MakeTool: Commander.CommandProc = BEGIN
rule: Rules.Rule;
my: Handle _ NEW[MyRec];
my.outer _ Containers.Create[[-- construct the outer container
name: "Mailing List Creator",    -- name displayed in the caption
iconic: TRUE,            -- so tool will be iconic (small) when first created
column: left,                -- initially in the left column
scrollable: FALSE ]];        -- inhibit user from scrolling contents
MakeCommands[my];        -- build each (sub)viewer in turn
rule _ Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]];
Containers.ChildXBound[my.outer, rule];
my.height _ my.height + entryHeight + 2;    -- interline spacing
MakeTypescript[my];
ViewerOps.PaintViewer[my.outer, all];                -- reflect above change
END;
CommandViewer: TYPE = RECORD [
inputFile, outputFile: ViewerClasses.Viewer
];


MakeTypescript: PROC [handle: Handle] = BEGIN    
handle.height _ handle.height + entryVSpace;    -- space down from the top of the viewer
handle.ts _ TypeScript.Create[
info: [name: "PrintDir.ts", wy: handle.height, parent: handle.outer, border: FALSE ]];
[handle.tsIn, handle.tsOut] _ ViewerIO.CreateViewerStreams [
name: "PrintDir.ts", viewer: handle.ts, backingFile: "PrintDir.ts", editedStream: FALSE];
Containers.ChildXBound[handle.outer, handle.ts];
Containers.ChildYBound[handle.outer, handle.ts];
END;
MakeCommands: PROC [handle: Handle] = BEGIN    
initialData: Rope.ROPE = NIL;
wx: INT _ 0;
NewLine: PROC = {handle.height _ handle.height + entryHeight + entryVSpace; wx _ 0};
LabeledItem: PROC [label: ROPE, width: INT, data: ROPE _ NIL] 
RETURNS [v: ViewerClasses.Viewer] = {
ph: PromptHandle _ NEW [PromptRec _ [handle: handle]];
t: Buttons.Button _ Buttons.Create[
info: [
name: Rope.Concat[label, ":"], 
wy: handle.height,
<<default the width so that it will be computed for us -->>
wh: entryHeight,    -- specify rather than defaulting so line is uniform
wx: wx,
parent: handle.outer,
border: FALSE ],
proc: Prompt,
clientData: ph];    -- this will be passed to our button proc
wx _ wx + t.ww + entryHSpace;
v _ ViewerTools.MakeNewTextViewer[ [
parent: handle.outer,
wx: wx,
wy: handle.height,
ww: width*VFonts.CharWidth['0],
wh: entryHeight,
data: data,
scrollable: FALSE,
border: FALSE]];
ph.viewer _ v;
wx _ wx + v.ww + entryHSpace};
Cmd: PROC [label: ROPE, proc: Buttons.ButtonProc] = {
t: Buttons.Button _ Buttons.Create[
info: [
name: label, 
wx: wx,
wy: handle.height,
<<default the width so that it will be computed for us -->>
wh: entryHeight,    -- specify rather than defaulting so line is uniform
parent: handle.outer,
border: TRUE ],
proc: proc,
clientData: handle];    -- this will be passed to our button proc
wx _ wx + t.ww + entryHSpace};

Bool: PROC [label: ROPE, initial: BOOL] RETURNS [flag: REF BOOL] = {
t: Buttons.Button;
flag _ NEW[BOOL _ initial];
t _ Buttons.Create[
info: [
name: label, 
wx: wx,
wy: handle.height,
<<default the width so that it will be computed for us -->>
wh: entryHeight,    -- specify rather than defaulting so line is uniform
parent: handle.outer,
border: TRUE ],
proc: ToggleBool,
clientData: flag];    -- this will be passed to our button proc
Buttons.SetDisplayStyle[
 button: t, style: IF initial THEN $WhiteOnBlack ELSE $BlackOnWhite, paint: FALSE];
wx _ wx + t.ww + entryHSpace};

NewLine[];
Cmd["Convert", DoIt];
NewLine[];
handle.cmd.inputFile _ LabeledItem["input", 50];

NewLine[];
handle.cmd.outputFile _ LabeledItem["output", 50];
NewLine[];
handle.flipNames _ Bool["flip names", FALSE];
NewLine[];
END;
Prompt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ 
FALSE, control: BOOL _ FALSE] --   = BEGIN
<<force the selection into the user input field>>
ph: PromptHandle _ NARROW[clientData];
ViewerTools.SetSelection[ph.viewer];        -- force the selection
END;

ToggleBool: Buttons.ButtonProc  = {
switch: REF BOOL _ NARROW [clientData]; 
switch^ _ ~switch^;
Buttons.SetDisplayStyle[
 button: NARROW[parent], 
 style: IF switch^ THEN $WhiteOnBlack ELSE $BlackOnWhite];
};

DoIt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, 
control: BOOL _ FALSE] --   = BEGIN
<<force the selection into the user input field>>
handle: Handle _ NARROW[clientData];    -- get our data
BEGIN
ENABLE {
UNWIND => {IF handle.in # NIL THEN handle.in.Close[]; handle.in _ NIL};
Problem, ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}};
fName: ROPE = ViewerTools.GetContents[handle.cmd.inputFile];
pName: ROPE = ViewerTools.GetContents[handle.cmd.outputFile];
IF fName = NIL OR pName = NIL THEN {
handle.tsOut.Put[[rope["specify input file name"]], [character['\n]]];
RETURN};
handle.in _ OpenFile[fName];
IF handle.in # NIL THEN handle.eof _ FALSE; 
IF pName # NIL AND Rope.Length[pName] # 0 THEN 
handle.out _ FS.StreamOpen[fileName: pName, accessOptions: $create];
handle.tsOut.PutText["Processing:"];
WHILE ~handle.eof DO
ProcessEntry[handle];
ENDLOOP;
EXITS
done => NULL;
END; -- of Enable
IF handle.in # NIL THEN handle.in.Close[];
IF handle.out # NIL THEN handle.out.Close[];
handle.tsOut.Put[[character['\n]], [rope["done"]], [character['\n]]];
END;


UC: PROC [c: CHAR] RETURNS [CHAR] = {
RETURN[IF c IN ['a..'z] THEN VAL[c.ORD - ORD['a] + ORD['A]] ELSE c]};

CFName: PROC [h: Handle, name: ROPE] RETURNS [cf: ROPE] = {
funny: BOOLEAN _ FALSE;
lastName: REF TEXT _ NEW[TEXT[Rope.Length[name]]]; -- plenty long
FOR i: INT IN [0..Rope.Length[name]) DO
c: CHAR _ UC[Rope.Fetch[name, i]];
SELECT c FROM
', => EXIT;
'*, '+ => LOOP;
ENDCASE => {
IF c = '  AND ~funny THEN {
funny _ TRUE; h.tsOut.Put[[character['\n]], [rope[name]], [character['\n]]]};
lastName[lastName.length] _ c; lastName.length _ lastName.length + 1};
ENDLOOP;
RETURN[Rope.FromRefText[lastName]]};

OutputName: PROC [h: Handle, name: ROPE] RETURNS [flagged: BOOLEAN _ FALSE] = {
NameBreak: IO.BreakProc = {
RETURN [SELECT char FROM
'&, ', => break,
'\t => sepr, -- blanks are allowed in names
ENDCASE => other]};
ns: STREAM _ NIL;
GetName: PROC RETURNS [r: ROPE, brk: CHAR, starred: BOOL _ FALSE] = {
[] _ ns.SkipWhitespace[];
IF ns.EndOf[] THEN RETURN [NIL, 0C];
DO
SELECT ns.PeekChar[] FROM
'+, '  => {[] _ ns.GetChar[]};
'* => {[] _ ns.GetChar[]; starred _ TRUE};
ENDCASE => EXIT;
ENDLOOP;
r _ GetTokenRope[ns, NameBreak].token;
IF ns.EndOf[] THEN brk _ 0C ELSE brk _ ns.GetChar[]};
Flag: PROC = {
IF flagged THEN RETURN;
flagged _ TRUE;
h.tsOut.Put[[character['\n]], [rope[name]]]};
PR: PROC [r: ROPE] = {h.out.PutRope[r]};
t, last: ROPE; bk: CHAR;
nonMember: BOOL;
ns _ IO.RIS[name];
[last, bk] _ GetName[]; -- last name
IF bk # ', THEN Flag[];
DO
[t, bk, nonMember] _ GetName[];
IF t = NIL THEN EXIT;
SELECT bk FROM
'& => IF ~nonMember THEN PR["Mr. & Mrs. "];
', => Flag[];
ENDCASE;
IF ~nonMember THEN h.out.PutRope[t];
SELECT bk FROM
'& => IF ~nonMember THEN EXIT;
', => PR[", "];
ENDCASE => PR[" "];
ENDLOOP;
PR[last];
};

OutputEntry: PROC [h: Handle, e: Entry] = {
flagged: BOOLEAN;
PR: PROC [r: ROPE] = {h.out.PutRope[r]};
PL: PROC [r: ROPE] = {h.out.Put[[character['\n]], [rope[r]]]};
Flag: PROC = {
IF flagged THEN RETURN;
flagged _ TRUE;
h.tsOut.Put[[character['\n]], [rope[e.name[0]]]]};

IF e.addr[0] = NIL THEN RETURN;
IF h.flipNames^ THEN flagged _ OutputName[h, e.name[0]]
ELSE PL[e.name[0]];
FOR i: CARDINAL IN [0..4) DO
IF e.addr[i] = NIL THEN EXIT;
PL[e.addr[i]];
ENDLOOP;
IF e.town = NIL THEN PR["   "]
ELSE
SELECT TRUE FROM
Rope.Equal[e.town, "PA"] => PL["Palo Alto, CA   "];
Rope.Equal[e.town, "MP"] => PL["Menlo Park, CA   "];
Rope.Equal[e.town, "S"] => PL["Stanford, CA   "];
Rope.Equal[e.town, "LA"] => PL["Los Altos, CA   "];
Rope.Equal[e.town, "LAH"] => PL["Los Altos Hills, CA   "];
Rope.Equal[e.town, "C"] => PL["Cupertino, CA   "];
Rope.Equal[e.town, "Svl"] => PL["Sunnyvale, CA   "];
Rope.Equal[e.town, "A"] => PL["Atherton, CA   "];
Rope.Equal[e.town, "EPA"] => PL["Palo Alto, CA   "];
Rope.Equal[e.town, "RC"] => PL["Redwood City, CA   "];
Rope.Equal[e.town, "MV"] => PL["Mountain View, CA   "];
Rope.Equal[e.town, "SC"] => PL["Santa Clara, CA   "];
Rope.Equal[e.town, "SJ"] => PL["San Jose, CA   "];
Rope.Equal[e.town, "W"] => PL["Woodside, CA   "];
Rope.Equal[e.town, "PV"] => PL["Portola Valley, CA   "];
Rope.Equal[e.town, "LG"] => PL["Los Gatos, CA   "];
Rope.Equal[e.town, "SF"] => PL["San Francisco, CA   "];
Rope.Equal[e.town, "SM"] => PL["San Mateo, CA   "];
ENDCASE => {Flag[]; PL["????   "]};
IF e.zip # NIL THEN PR[e.zip];
h.out.Put[[character['\n]], [character['\n]]]
};

Entry: TYPE = RECORD [
caller: [0..100) _ 0,
activity, level, dinner, age: CHAR _ ' ,
phone: ARRAY [0..4) OF ROPE _ ALL[NIL],
name: ARRAY [0..4) OF ROPE _ ALL[NIL],
addr: ARRAY [0..4) OF ROPE _ ALL[NIL],
town: ROPE _ NIL,
zip: ROPE _ NIL,
comment: ROPE _ NIL];


Problem: ERROR = CODE;

MyBreak: IO.BreakProc -- [char: CHAR] RETURNS [IO.CharClass] --  = {
RETURN [SELECT char FROM
'\\, '|, '} => break,
'\t => sepr,
ENDCASE => other];
};

OpenFile: PROC [name: ROPE] RETURNS [st: STREAM] = {
st _ FS.StreamOpen[name, $read
! FS.Error => IF error.group # bug THEN CONTINUE]};

ProcessEntry: PROC [handle: Handle] = {
e: Entry;
IF handle.eof THEN RETURN;
IF handle.in = NIL THEN {
MessageWindow.Append[
message: "Please open a file first",
clearFirst: TRUE];
MessageWindow.Blink[ ];
ERROR ABORTED};
[] _ handle.in.SkipWhitespace[];
IF handle.in.EndOf[] THEN {handle.eof _ TRUE; GO TO done};
e _ ReadEntry[handle];
OutputEntry[handle, e];
EXITS
done => NULL;
};

ReadEntry: PROC [handle: Handle] RETURNS [e: Entry] = {
<<one should SkipWhitespace before calling (and check for eof)>>
ENABLE IO.EndOfStream => {handle.eof _ TRUE; Quit[handle, "Syntax error "]};
st: STREAM _ handle.in;
ch: CHAR;
caller: ROPE;
i: CARDINAL;
IF (ch _ st.GetChar[]) # '{ THEN Quit[handle, "Syntax error "];
caller _ GetTokenRope[st, MyBreak].token;
IF caller # NIL THEN 
e.caller _ Convert.IntFromRope[caller ! Convert.Error => Quit[handle, "bad caller #"]];
IF (ch _ st.GetChar[]) # '| THEN Quit[handle, "Syntax error "];
BEGIN -- get campaign info
IF (ch _ st.GetChar[]) = '| THEN GO TO done;
e.activity _ ch;
IF (ch _ st.GetChar[]) = '| THEN GO TO done;
e.level _ ch;
IF (ch _ st.GetChar[]) = '| THEN GO TO done;
e.dinner _ ch;
IF (ch _ st.GetChar[]) = '| THEN GO TO done;
e.age _ ch;
IF (ch _ st.GetChar[]) # '| THEN Quit[handle, "Syntax error "];
EXITS
done => NULL;
END;
i _ 0;
DO
e.phone[i] _ GetTokenRope[st, MyBreak].token;
SELECT (ch _ st.GetChar[]) FROM
'\\ => IF i = 2 THEN Quit[handle, "Syntax error "];
'| => EXIT;
'} => RETURN;
ENDCASE => Quit[handle, "Syntax error "];
i _ i + 1;
ENDLOOP;
i _ 0;
DO
e.name[i] _ GetTokenRope[st, MyBreak].token;
SELECT (ch _ st.GetChar[]) FROM
'\\ => IF i = 3 THEN Quit[handle, "Syntax error "];
'| => EXIT;
'} => RETURN;
ENDCASE => Quit[handle, "Syntax error "];
i _ i + 1;
ENDLOOP;
i _ 0;
DO
e.addr[i] _ GetTokenRope[st, MyBreak].token;
SELECT (ch _ st.GetChar[]) FROM
'\\ => IF i = 3 THEN Quit[handle, "Syntax error "];
'| => EXIT;
'} => RETURN;
ENDCASE => GO TO badsyntax;
i _ i + 1;
ENDLOOP;
e.town _ GetTokenRope[st, MyBreak].token;
IF st.GetChar[] = '} THEN RETURN;
e.zip _ GetTokenRope[st, MyBreak].token;
IF st.GetChar[] = '} THEN RETURN;
e.comment _ GetTokenRope[st, MyBreak].token;
IF st.GetChar[] # '} THEN Quit[handle, "Syntax error "];
EXITS
badsyntax => Quit[handle, "Syntax error "];
};

Quit: PROC [handle: Handle, reason: ROPE _ NIL] = {
loc: INT = handle.in.GetIndex[];
handle.in.Close[]; handle.in _ NIL; handle.eof _ TRUE;
handle.tsOut.Put[[rope[reason]], [integer[loc]], [character['\n]]];
ERROR Problem};

<<copied from IOSearchImpl because it didn't handle empty tokens properly>>
GetToken: PROC [stream: STREAM, breakProc: IO.BreakProc, buffer: REF TEXT]
RETURNS[token: REF TEXT, charsSkipped: INT] = {
quit, include: BOOL _ FALSE;
anySeen: BOOL _ FALSE;
charsSkipped _ 0;
buffer.length _ 0;
DO
char: CHAR _
stream.GetChar[ ! IO.EndOfStream => IF buffer.length > 0 THEN EXIT ELSE REJECT];
SELECT breakProc[char] FROM
break => {include _ FALSE; quit _ TRUE};
sepr => {include _ FALSE; quit _ anySeen };
other => {include _ TRUE; quit _ FALSE; anySeen _ TRUE};
ENDCASE => ERROR;
IF include THEN buffer _ RefText.InlineAppendChar[buffer, char]
ELSE
IF quit THEN stream.Backup[char] ELSE charsSkipped _ charsSkipped + 1;
IF quit THEN EXIT;
ENDLOOP;
RETURN[buffer, charsSkipped];
};
GetTokenRope: PUBLIC PROC [stream: STREAM, breakProc: IO.BreakProc]
RETURNS [token: ROPE, charsSkipped: INT] = {
buffer: REF TEXT = RefText.ObtainScratch[100];
{ ENABLE UNWIND => RefText.ReleaseScratch[buffer];
tokenText: REF TEXT;
[tokenText, charsSkipped] _ GetToken[stream, breakProc, buffer];
token _ IF tokenText.length = 0 THEN NIL ELSE Rope.FromRefText[tokenText];
};
RefText.ReleaseScratch[buffer];
RETURN [token, charsSkipped];
};

Commander.Register[key: "MailingList", proc: MakeTool,
doc: "Create a mailing list file" ];
[ ] _ MakeTool[NIL];    -- and create an instance
END.