[Ivy]<Sweet>FUMC>OldSortDir.mesa!2

OldSortDir.mesa;

Last Edited by: Sweet, September 13, 1985 11:32:50 pm 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];

OldSortDir: 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

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: "SortDir.ts", wy: handle.height, parent: handle.outer, border: FALSE ]];

[handle.tsIn, handle.tsOut] ← ViewerIO.CreateViewerStreams [

name: "SortDir.ts", viewer: handle.ts, backingFile: "SortDir.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: [

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: [

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: [

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];

handle.zip ← Bool["zip", FALSE];

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;

handle.tsOut.PutText["Reading:"];

WHILE ~handle.eof DO

EnterItem[handle];

IF handle.item.count MOD 50 = 0 THEN handle.tsOut.PutChar['.];

ENDLOOP;

handle.tsOut.PutText["Sorting:"];

SortEntries[handle];

handle.tsOut.PutText["Writing:"];

oName ← FS.ExpandName[oName, wDir !

FS.Error => Quit[handle, "bad text output file"]].fullFName;

handle.out ← FS.StreamOpen[fileName: oName, accessOptions: $create];

FOR i: CARDINAL IN [0..handle.item.count) DO

WriteEntry[handle, handle.item[i]];

handle.out.PutChar['\n];

handle.item[i] ← NIL;

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;

UC: PROC [c: CHAR] RETURNS [CHAR] = {

RETURN[IF c IN ['a..'z] THEN VAL[c.ORD - ORD['a] + ORD['A]] ELSE c]};

CFName: 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;

tStart: INT;

FOR i: INT IN [0..Rope.Length[name]) DO

c: CHAR ← UC[Rope.Fetch[name, i]];

SELECT c FROM

'*, '+ => LOOP;

ENDCASE => {

SELECT state FROM

last => IF c = ', THEN state ← pretitle;

pretitle => SELECT c FROM

'M => {tStart ← cName.length; state ← mrsXm};

'D => {tStart ← cName.length; state ← drXd};

' => NULL;

ENDCASE => state ← finished;

mrsXm => IF c = 'R THEN state ← mrsXr ELSE state ← finished;

mrsXr => IF c = 'S THEN state ← mrsXs ELSE state ← finished;

mrsXs => IF c = '. THEN state ← dot ELSE state ← finished;

drXd => IF c = 'R THEN state ← drXr ELSE state ← finished;

drXr => IF c = '. THEN state ← dot ELSE state ← finished;

dot => SELECT c FROM

' => state ← space;

ENDCASE => {cName.length ← tStart; state ← finished}; -- throw away title

space => {cName.length ← tStart; state ← finished}; -- throw away title

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]};

EnterItem: PROC [handle: Handle] = {

e: REF Entry;

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];

extract interesting data

e.cname ← CFName[e.name[0]];

FOR i: INT IN [0..Rope.Length[e.zip]) DO

c: CHAR = Rope.Fetch[e.zip, i];

SELECT c FROM

IN ['0..'9] => num ← num * 10 + (c - '0);

'- => ninedigit ← TRUE;

ENDCASE => EXIT;

ENDLOOP;

IF ~ninedigit THEN num ← num * 10000;

e.zipNumber ← num;

enter into list to be sorted

IF handle.item.count = handle.item.max THEN GrowItemRec[handle];

handle.item[handle.item.count] ← e; handle.item.count ← handle.item.count + 1;

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;

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;

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;

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;

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

CompareProc: PROC [h: Handle, r1, r2: REF Entry] RETURNS [Basics.Comparison] = {

IF h.zip^ THEN SELECT r1.zipNumber FROM

> r2.zipNumber => RETURN[greater];

< r2.zipNumber => RETURN[less];

ENDCASE;

SELECT Rope.Compare[r1.cname, r2.cname] FROM

greater => RETURN[greater];

less => RETURN[less];

ENDCASE;

RETURN[equal]};

SortEntries: PROC [h: Handle] = {

Greater: PROC [r1, r2: REF Entry] RETURNS [BOOL] = {

RETURN[CompareProc[h, r1, r2] = greater]};

Sort[h.item, h.item.count, Greater];

};

Sort: PROC [

a: EntrySeq,

n: CARDINAL,

greater: PROC [r1, r2: REF Entry] RETURNS [BOOL]] = {

i: CARDINAL;

temp: REF Entry;

SiftUp: PROC [l, u: CARDINAL] = {

s: CARDINAL;

key: REF Entry ← a[l-1];

s ← l*2;

IF s > u THEN EXIT;

IF s < u AND greater[a[s+1-1], a[s-1]] THEN s ← s+1;

IF greater[key, a[s-1]] THEN EXIT;

a[l-1] ← a[s-1];

l ← s;

ENDLOOP;

a[l-1] ← key};

FOR i DECREASING IN [2..n/2] DO SiftUp[i, n]; ENDLOOP;

FOR i DECREASING IN [2..n] DO

SiftUp[1, i];

temp ← a[1-1];

a[1-1] ← a[i-1];

a[i-1] ← temp;

ENDLOOP};

Commander.Register[key: "OldSortDir", proc: MakeTool,

doc: "Sort a church directory" ];

[ ] ← MakeTool[NIL]; -- and create an instance

END.