ExtractKids.mesa;
Last Edited by: Sweet, September 27, 1985 9:13:54 am PDT
DIRECTORY
Ascii,
Basics,
Buttons,
Commander USING [CommandProc, Register],
CommandTool,
Containers USING [ChildXBound, ChildYBound, Container, Create],
FS,
IO,
MessageWindow,
RefText,
Rope,
Rules USING [Create, Rule],
OldSortDirDefs,
TypeScript,
VFonts,
ViewerClasses USING [Viewer, ViewerClassRec],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [PaintViewer],
ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection];
ExtractKids: CEDAR PROGRAM    
IMPORTS Buttons, Commander, CommandTool, Containers, FS, IO, MessageWindow, RefText, Rope, Rules, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools =
BEGIN OPEN OldSortDirDefs;
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;
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: "Kid extractor", -- 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;
MakeTypescript: PROC [handle: Handle] = BEGIN 
handle.height ← handle.height + entryVSpace; -- space down from the top of the viewer
handle.ts ← TypeScript.Create[
info: [name: "ExtKids.ts", wy: handle.height, parent: handle.outer, border: FALSE ]];
[handle.tsIn, handle.tsOut] ← ViewerIO.CreateViewerStreams [
name: "ExtKids.ts", viewer: handle.ts, backingFile: "ExtKids.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};
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};
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};
NewLine[];
Cmd["Sort", DoIt];
NewLine[];
handle.cmd.workingDir ← LabeledItem["working directory", 50, CommandTool.CurrentWorkingDirectory[]];
NewLine[];
handle.cmd.inputFile ← LabeledItem["input", 50];
NewLine[];
handle.cmd.outputFile ← LabeledItem["output", 50];
NewLine[];
END;
ToggleBool: Buttons.ButtonProc = {
switch: REF BOOL ← NARROW [clientData];
switch^ ← ~switch^;
Buttons.SetDisplayStyle[
button: NARROW[parent],
style: IF switch^ THEN $WhiteOnBlack ELSE $BlackOnWhite];
};
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;
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}};
iName: ROPE ← ViewerTools.GetContents[handle.cmd.inputFile];
oName: ROPE ← ViewerTools.GetContents[handle.cmd.outputFile];
wDir: ROPE = ViewerTools.GetContents[handle.cmd.workingDir];
various initializations
handle.item ← NEW[EntrySeqBody[1000]];
do the work
IF iName = NIL OR oName = NIL THEN {
handle.tsOut.Put[[rope["specify file names"]], [character['\n]]];
RETURN};
iName ← FS.ExpandName[iName, wDir !
FS.Error => Quit[handle, "bad input file"]].fullFName;
handle.in ← OpenFile[iName];
IF handle.in # NIL THEN handle.eof ← FALSE
ELSE handle.eof ← TRUE;
oName ← FS.ExpandName[oName, wDir !
FS.Error => Quit[handle, "bad text output file"]].fullFName;
handle.out ← FS.StreamOpen[fileName: oName, accessOptions: $create];
handle.tsOut.PutText["Reading:"];
WHILE ~handle.eof DO
ProcessItem[handle];
IF handle.item.count MOD 50 = 0 THEN handle.tsOut.PutChar['.];
ENDLOOP;
handle.item ← NIL;
EXITS
done => NULL;
END; -- of Enable
IF handle.in # NIL THEN {handle.in.Close[]; handle.in ← NIL};
IF handle.out # NIL THEN {handle.out.Close[]; handle.out ← NIL};
handle.tsOut.Put[[character['\n]], [rope["done"]], [character['\n]]];
END;
LastName: PROC [name: ROPE] RETURNS [cf: ROPE] = {
cName: REF TEXT ← NEW[TEXT[Rope.Length[name]]]; -- plenty long
state: {last, pretitle, finished, mrsXm, mrsXr, mrsXs, dot, space, drXd, drXr} ← last;
FOR i: INT IN [0..Rope.Length[name]) DO
c: CHAR ← Rope.Fetch[name, i];
SELECT c FROM
'*, '+ => LOOP;
', => EXIT;
ENDCASE => {cName[cName.length] ← c; cName.length ← cName.length + 1};
ENDLOOP;
RETURN[Rope.FromRefText[cName]]};
Problem: ERROR = CODE;
MyBreak: IO.BreakProc -- [char: CHAR] RETURNS [IO.CharClass] -- = {
RETURN [SELECT char FROM
'\\, '|, '}, '\n => 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]};
ProcessItem: PROC [handle: Handle] = {
e: REF Entry;
ns: STREAM ← NIL;
NameBreak: IO.BreakProc = {
RETURN [SELECT char FROM
'&, ', => break,
'\t => sepr, -- blanks are allowed in names
ENDCASE => other]};
GetName: PROC RETURNS [r: ROPE, uninteresting: BOOLEAN] = {
uninteresting ← FALSE;
[] ← ns.SkipWhitespace[];
IF ns.EndOf[] THEN RETURN [NIL, FALSE];
SELECT ns.PeekChar[] FROM
'+ => {uninteresting ← TRUE; [] ← ns.GetChar[]};
'* => {uninteresting ← TRUE; [] ← ns.GetChar[]};
ENDCASE;
r ← GetTokenRope[ns, NameBreak].token;
IF ~ns.EndOf[] THEN [] ← ns.GetChar[]};
num: LONG CARDINAL ← 0;
ninedigit: BOOL ← FALSE;
st: STREAM = handle.in;
IF handle.eof THEN RETURN;
IF handle.in = NIL THEN {
MessageWindow.Append[
message: "Please open a file first",
clearFirst: TRUE];
MessageWindow.Blink[ ];
ERROR ABORTED};
[] ← st.SkipWhitespace[];
IF st.EndOf[] THEN {handle.eof ← TRUE; GO TO done};
e ← ReadEntry[handle];
see if likely to be kids
IF e.name[1] # NIL THEN {
names: ARRAY SmallCount OF ROPE ← e.name;
last: ROPE ← LastName[names[0]];
e.name ← ALL[NIL];
e.name[0] ← Rope.Cat[last, ", ", e.name[1]];
FOR i: CARDINAL IN [1..SmallCount.LAST] DO
ns ← IO.RIS[names[i]];
DO
firstName: ROPE;
tooYoung: BOOL;
[firstName, tooYoung] ← GetName[];
IF firstName = NIL THEN EXIT;
IF ~tooYoung THEN {
e.name[0] ← Rope.Cat[last, ", ", firstName];
WriteEntry[handle, e];
handle.out.PutRope["\n"];
};
ENDLOOP;
ENDLOOP;
};
EXITS
done => NULL;
};
GrowItemRec: PROC [h: Handle] = {
n: CARDINAL;
new: EntrySeq;
IF h.item = NIL THEN n ← 1000 ELSE n ← h.item.max + 100;
new ← NEW[EntrySeqBody[n]];
IF h.item # NIL THEN {
FOR i: CARDINAL IN [0..h.item.count) DO
new[i] ← h.item[i];
ENDLOOP;
new.count ← h.item.count};
h.item ← new};
ReadEntry: PROC [handle: Handle] RETURNS [e: REF 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;
i: CARDINAL;
e ← NEW [Entry];
IF (ch ← st.GetChar[]) # '{ THEN Quit[handle, "Syntax error "];
i ← 0;
DO
e.phone[i] ← GetTokenRope[st, MyBreak].token;
SELECT (ch ← st.GetChar[]) FROM
'\\ => IF i = nLines-1 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 = nLines-1 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 = nLines-1 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;
GO TO badsyntax;
EXITS
badsyntax => Quit[handle, "Syntax error "];
};
WriteEntry: PROC [handle: Handle, e: REF Entry] = {
st: STREAM ← handle.out;
i: CARDINAL;
st.PutChar['{];
FOR i IN SmallCount WHILE e.phone[i] # NIL DO
IF i # 0 THEN st.PutChar['\\];
st.PutRope[e.phone[i]];
ENDLOOP;
st.PutRope["|\t"];
IF e.phone[0] = NIL THEN st.PutRope["\t\t\t\t"];
FOR i IN SmallCount WHILE e.name[i] # NIL DO
IF i # 0 THEN st.PutChar['\\];
st.PutRope[e.name[i]];
ENDLOOP;
IF e.addr[0] = NIL AND e.town = NIL AND e.zip = NIL THEN {
st.PutChar['}]; RETURN};
st.PutRope["|\t"];
FOR i IN SmallCount WHILE e.addr[i] # NIL DO
IF i # 0 THEN st.PutChar['\\];
st.PutRope[e.addr[i]];
ENDLOOP;
IF e.town = NIL AND e.zip = NIL THEN {st.PutChar['}]; RETURN};
st.PutRope["|\t"];
IF e.town # NIL THEN st.PutRope[e.town];
IF e.zip = NIL THEN {st.PutChar['}]; RETURN};
st.PutRope["|\t"];
st.PutRope[e.zip];
st.PutChar['}];
};
Quit: PROC [handle: Handle, reason: ROPE ← NIL] = {
loc: INT ← 0;
IF handle.in # NIL THEN {
loc ← 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];
};
Sort by various keys
Commander.Register[key: "ExtractKids", proc: MakeTool,
doc: "Make cut at kids file" ];
[ ] ← MakeTool[NIL]; -- and create an instance
END.