<> <> DIRECTORY Ascii, Basics, Buttons, Commander USING [CommandProc, Register], Containers USING [ChildXBound, ChildYBound, Container, Create], Convert, FS, IO, MessageWindow, RefText, Rope, Rules USING [Create, Rule], SortDirDefs, TypeScript, VFonts, ViewerClasses USING [Viewer, ViewerClassRec], ViewerIO USING [CreateViewerStreams], ViewerOps USING [CreateViewer, PaintViewer], ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection]; SortDir: CEDAR PROGRAM IMPORTS Buttons, Commander, Containers, Convert, FS, IO, MessageWindow, RefText, Rope, Rules, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools = BEGIN OPEN SortDirDefs; <> 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: "Directory Sorter", -- 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]; <> my.dinnerOrder['d] _ 1; my.dinnerOrder['h] _ 2; my.dinnerOrder['i] _ 3; my.dinnerOrder['o] _ 4; my.dinnerOrder['-] _ 5; my.dinnerOrder[' ] _ 6; my.activityOrder['a] _ 1; my.activityOrder['b] _ 2; my.activityOrder['c] _ 3; my.activityOrder['-] _ 4; my.activityOrder[' ] _ 5; my.ageOrder['k] _ 1; my.ageOrder['y] _ 2; my.ageOrder['a] _ 3; my.ageOrder['s] _ 4; my.ageOrder['-] _ 5; my.ageOrder[' ] _ 6; my.levelOrder['9] _ 1; my.levelOrder['8] _ 2; my.levelOrder['7] _ 3; my.levelOrder['6] _ 4; my.levelOrder['5] _ 5; my.levelOrder['4] _ 6; my.levelOrder['3] _ 7; my.levelOrder['2] _ 8; my.levelOrder['1] _ 9; my.levelOrder['c] _ 10; my.levelOrder['0] _ 11; my.levelOrder['-] _ 12; my.levelOrder[' ] _ 13; 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: [ name: Rope.Concat[label, ":"], wy: handle.height, <> 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, <> 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, <> 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["Sort", DoIt]; Cmd["Count", CountThings]; Cmd["Merge", MergeFiles]; NewLine[]; handle.recruiterNumber _ Bool["recruiterNumber", FALSE]; handle.callerNumber _ Bool["callerNumber", FALSE]; handle.dinner _ Bool["dinner", FALSE]; handle.level _ Bool["level", FALSE]; handle.age _ Bool["age", FALSE]; handle.activity _ Bool["activity", FALSE]; NewLine[]; handle.address _ Bool["address", FALSE]; handle.zip _ Bool["zip", FALSE]; handle.recruiter _ Bool["recruiter", FALSE]; handle.caller _ Bool["caller", FALSE]; handle.phone _ Bool["phone", FALSE]; handle.member _ Bool["member", FALSE]; NewLine[]; handle.cmd.inputFile _ LabeledItem["input", 50, "///FUMC/"]; NewLine[]; handle.cmd.outputFile _ LabeledItem["output", 50, "///FUMC/"]; NewLine[]; handle.cmd.secondary _ LabeledItem["secondary input", 50, "///FUMC/"]; NewLine[]; handle.cmd.callers _ LabeledItem["callers", 50, "///FUMC/CallerNames.txt"]; NewLine[]; END; Prompt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- = BEGIN <> 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]; }; CountThings: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- = BEGIN <> handle: Handle _ NARROW[clientData]; -- get our data CountArray: TYPE = ARRAY CHAR OF CARDINAL; activityK: REF CountArray _ NEW[CountArray _ ALL[0]]; levelK: REF CountArray _ NEW[CountArray _ ALL[0]]; dinnerK: REF CountArray _ NEW[CountArray _ ALL[0]]; ageK: REF CountArray _ NEW[CountArray _ ALL[0]]; PT: PROC [t: ROPE] = {handle.tsOut.PutRope[t]}; PC: PROC [c: CARDINAL] = {handle.tsOut.Put[[cardinal[c]], [character['\n]]]}; total: CARDINAL _ 0; PrintCounts: PROC [a: REF CountArray, category: ROPE] = { PT["\nFor category "]; PT[category]; PT["\n"]; FOR c: CHAR IN CHAR DO IF a[c] = 0 THEN LOOP; PT["\t"]; PT[Rope.FromChar[c]]; PT["\t"]; PC[a[c]]; ENDLOOP; }; 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]; e: REF Entry; <> IF iName = NIL THEN { handle.tsOut.Put[[rope["specify file name"]], [character['\n]]]; RETURN}; handle.in _ OpenFile[iName]; IF handle.in # NIL THEN handle.eof _ FALSE ELSE handle.eof _ TRUE; handle.tsOut.PutText["Reading:"]; WHILE ~handle.eof DO [] _ handle.in.SkipWhitespace[]; IF handle.in.EndOf[] THEN {handle.eof _ TRUE; GO TO done}; e _ ReadEntry[handle, handle.in]; total _ total + 1; activityK[e.activity] _ activityK[e.activity] + 1; levelK[e.level] _ levelK[e.level] + 1; dinnerK[e.dinner] _ dinnerK[e.dinner] + 1; ageK[e.age] _ ageK[e.age] + 1; ENDLOOP; EXITS done => NULL; END; -- of Enable PT["\nTotal number of entries "]; PC[total]; PrintCounts[activityK, "activity"]; PrintCounts[levelK, "level"]; PrintCounts[dinnerK, "dinner"]; PrintCounts[ageK, "age"]; PT["\n\n"]; IF handle.in # NIL THEN handle.in.Close[]; handle.tsOut.Put[[character['\n]], [rope["done"]], [character['\n]]]; END; DoIt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- = BEGIN <> 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]; <> handle.item _ NEW[EntrySeqBody[1000]]; IF handle.caller^ OR handle.recruiter^ AND handle.callerName = NIL THEN handle.callerName _ ParseCallerNames[handle]; <> IF iName = NIL OR oName = NIL THEN { handle.tsOut.Put[[rope["specify file names"]], [character['\n]]]; RETURN}; 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, FALSE]; IF handle.item.count MOD 50 = 0 THEN handle.tsOut.PutChar['.]; ENDLOOP; handle.tsOut.PutText["Sorting:"]; SortEntries[handle, FALSE]; handle.tsOut.PutText["Writing:"]; 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; MergeFiles: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- = BEGIN <> 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]; sName: ROPE = ViewerTools.GetContents[handle.cmd.secondary]; i1, i2: CARDINAL; <> handle.item _ NEW[EntrySeqBody[1000]]; handle.secondary _ NEW[EntrySeqBody[300]]; IF handle.caller^ OR handle.recruiter^ AND handle.callerName = NIL THEN handle.callerName _ ParseCallerNames[handle]; <> IF iName = NIL OR oName = NIL THEN { handle.tsOut.Put[[rope["specify file names"]], [character['\n]]]; RETURN}; handle.in _ OpenFile[iName]; IF handle.in # NIL THEN handle.eof _ FALSE ELSE Quit[handle, "No input file"]; handle.tsOut.PutText["Reading primary:"]; WHILE ~handle.eof DO EnterItem[handle, FALSE]; IF handle.item.count MOD 50 = 0 THEN handle.tsOut.PutChar['.]; ENDLOOP; handle.tsOut.PutText["Sorting:"]; SortEntries[handle, FALSE]; handle.in2 _ OpenFile[sName]; IF handle.in2 # NIL THEN handle.eof _ FALSE ELSE Quit[handle, "No secondary file"]; handle.tsOut.PutText["Reading secondary:"]; WHILE ~handle.eof DO EnterItem[handle, TRUE]; IF handle.secondary.count MOD 50 = 0 THEN handle.tsOut.PutChar['.]; ENDLOOP; handle.tsOut.PutText["Sorting:"]; SortEntries[handle, TRUE]; handle.tsOut.PutText["Merging:"]; handle.out _ FS.StreamOpen[fileName: oName, accessOptions: $create]; i1 _ i2 _ 0; DO r1, r2: REF Entry; comp: Basics.Comparison; IF i1 < handle.item.count THEN r1 _ handle.item[i1] ELSE r1 _ NIL; IF i2 < handle.secondary.count THEN r2 _ handle.secondary[i2] ELSE r2 _ NIL; IF r1 = NIL AND r2 = NIL THEN EXIT; comp _ CompareProc[handle, r1, r2]; SELECT comp FROM less => { WriteEntry[handle, r1]; handle.out.PutChar['\n]; i1 _ i1 + 1}; greater => { WriteEntry[handle, r2]; handle.out.PutChar['\n]; i2 _ i2 + 1}; ENDCASE => { IF r1 # NIL THEN i1 _ i1 + 1; WriteEntry[handle, r2]; handle.out.PutChar['\n]; i2 _ i2 + 1}; ENDLOOP; handle.item _ NIL; handle.secondary _ NIL; EXITS done => NULL; END; -- of Enable IF handle.in # NIL THEN {handle.in.Close[]; handle.in _ NIL}; IF handle.in2 # NIL THEN {handle.in2.Close[]; handle.in2 _ 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 FOR i: INT IN [0..Rope.Length[name]) DO c: CHAR _ UC[Rope.Fetch[name, i]]; SELECT c FROM '*, '+ => LOOP; 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, secondary: BOOL] = { e: REF Entry; st1, st2: CARDINAL; ch: CHAR; num: INT _ 0; st: STREAM = IF secondary THEN handle.in2 ELSE 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, st]; <> e.cname _ CFName[e.name[0]]; st1 _ 0; st2 _ IF e.addr[0] = NIL THEN 0 ELSE CARDINAL[Rope.Length[e.addr[0]]]; WHILE st1 < st2 AND (ch _ Rope.Fetch[e.addr[0], st1]) IN ['0..'9] DO num _ 10*num + ch.ORD - '0.ORD; st1 _ st1 + 1; ENDLOOP; e.number _ num; WHILE st1 < st2 AND Rope.Fetch[e.addr[0], st1] = ' DO st1 _ st1 + 1 ENDLOOP; FOR k: CARDINAL IN [st1..st2) DO IF Rope.Fetch[e.addr[0], k] = ', THEN {st2 _ k; EXIT}; ENDLOOP; e.street _ Rope.Substr[base: e.addr[0], start: st1, len: st2-st1]; IF e.town # NIL THEN e.ctown _ e.town ELSE IF e.addr[0] = NIL THEN e.ctown _ "" ELSE { FOR k: CARDINAL IN [0..4) DO IF e.addr[k] = NIL THEN {e.ctown _ e.addr[k-1]; EXIT}; REPEAT FINISHED => e.ctown _ e.addr[3]; ENDLOOP}; <> IF secondary THEN { IF handle.secondary.count = handle.secondary.max THEN GrowSecondaryRec[handle]; handle.secondary[handle.secondary.count] _ e; handle.secondary.count _ handle.secondary.count + 1} ELSE { 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}; GrowSecondaryRec: PROC [h: Handle] = { n: CARDINAL; new: EntrySeq; IF h.secondary = NIL THEN n _ 500 ELSE n _ h.secondary.max + 100; new _ NEW[EntrySeqBody[n]]; IF h.secondary # NIL THEN { FOR i: CARDINAL IN [0..h.secondary.count) DO new[i] _ h.secondary[i]; ENDLOOP; new.count _ h.secondary.count}; h.secondary _ new}; ReadEntry: PROC [handle: Handle, st: STREAM] RETURNS [e: REF Entry] = { <> ENABLE IO.EndOfStream => {handle.eof _ TRUE; Quit2[handle, st, "Syntax error "]}; caller: ROPE; ch: CHAR; i: CARDINAL; e _ NEW [Entry]; IF (ch _ st.GetChar[]) # '{ THEN Quit2[handle, st, "Syntax error "]; caller _ GetTokenRope[st, MyBreak].token; IF caller # NIL THEN e.caller _ Convert.IntFromRope[caller ! Convert.Error => Quit2[handle, st, "bad caller #"]]; IF (ch _ st.GetChar[]) # '| THEN Quit2[handle, st, "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 Quit2[handle, st, "Syntax error "]; EXITS done => NULL; END; i _ 0; DO e.phone[i] _ GetTokenRope[st, MyBreak].token; SELECT (ch _ st.GetChar[]) FROM '\\ => IF i = 3 THEN Quit2[handle, st, "Syntax error "]; '| => EXIT; '} => RETURN; ENDCASE => Quit2[handle, st, "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 Quit2[handle, st, "Syntax error "]; '| => EXIT; '} => RETURN; ENDCASE => Quit2[handle, st, "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 Quit2[handle, st, "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.mailing _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] = '} THEN RETURN; e.comment _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] # '} THEN Quit2[handle, st, "Syntax error "]; EXITS badsyntax => Quit[handle, "Syntax error "]; }; WriteEntry: PROC [handle: Handle, e: REF Entry] = { st: STREAM _ handle.out; i: CARDINAL; st.PutChar['{]; IF e.caller = 0 THEN st.PutRope["
"] ELSE st.Put[[integer[e.caller]]]; st.PutChar['|]; IF e.activity # ' OR e.level # ' OR e.dinner # ' OR e.age # ' THEN { st.PutChar[e.activity]; st.PutChar[e.level]; st.PutChar[e.dinner]; IF e.age # ' THEN st.PutChar[e.age]}; st.PutChar['|]; FOR i IN [0..4) 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 [0..4) 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 AND e.mailing = NIL AND e.comment = NIL THEN { st.PutChar['}]; RETURN}; st.PutRope["|\t"]; FOR i IN [0..4) 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 AND e.mailing = NIL AND e.comment = NIL THEN {st.PutChar['}]; RETURN}; st.PutRope["|\t"]; IF e.town # NIL THEN st.PutRope[e.town]; IF e.zip = NIL AND e.mailing = NIL AND e.comment = NIL THEN {st.PutChar['}]; RETURN}; st.PutRope["|\t"]; st.PutRope[e.zip]; st.PutRope["|\t"]; st.PutRope[e.mailing]; IF e.comment # NIL THEN {st.PutRope["|\t"]; st.PutRope[e.comment]}; st.PutChar['}]; }; 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}; Quit2: PROC [handle: Handle, st: STREAM, reason: ROPE _ NIL] = { loc: INT = st.GetIndex[]; st.Close[]; handle.tsOut.Put[[rope[reason]], [integer[loc]], [character['\n]]]; ERROR Problem}; ParseCallerNames: PROC [h: Handle] RETURNS [n: REF CallerNameRec] = { cnfile: ROPE _ ViewerTools.GetContents[h.cmd.callers]; ch: CHAR; index: INT; r: INT _ 0; c, p: ROPE; st: STREAM; n _ NEW[CallerNameRec _ ALL[[NIL, NIL, 0]]]; st _ OpenFile[cnfile]; IF st = NIL THEN Quit2[h, st, "No caller names"]; WHILE ~st.EndOf[] DO ENABLE IO.Error => Quit2[h, st, "invalid callernames"]; c _ p _ NIL; [] _ st.SkipWhitespace[]; IF st.EndOf[] THEN RETURN; index _ st.GetInt[]; IF NOT (index IN [0..100)) THEN Quit2[h, st, "Index invalid in callernames"]; IF st.GetChar[] # '\t THEN Quit2[h, st, "Missing tab in callernames"]; c _ GetTokenRope[st, MyBreak].token; BEGIN IF ~st.EndOf[] THEN SELECT (ch _ st.GetChar[]) FROM '\n => GO TO done; '| => NULL; ENDCASE => Quit2[h, st, "Syntax error in callernames"]; p _ GetTokenRope[st, MyBreak].token; IF ~st.EndOf[] THEN SELECT (ch _ st.GetChar[]) FROM '\n => GO TO done; '| => NULL; ENDCASE => Quit2[h, st, "Syntax error in callernames"]; [] _ st.SkipWhitespace[]; IF st.EndOf[] THEN RETURN; r _ st.GetInt[]; IF st.GetChar[] # '\n THEN Quit2[h, st, "Missing CR in callernames"]; EXITS done => NULL; END; n[index] _ [name: c, phone: p, recruiter: r]; ENDLOOP; st.Close[]}; <> 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]; }; <> <<>> CompareProc: PROC [h: Handle, r1, r2: REF Entry] RETURNS [Basics.Comparison] = { IF r1 = NIL THEN -- to simplify merge, make NIL be greater than anything IF r2 = NIL THEN RETURN [equal] ELSE RETURN[greater] ELSE IF r2 = NIL THEN RETURN[less]; IF h.recruiterNumber^ THEN { c1: CallerNumber = h.callerName[r1.caller].recruiter; c2: CallerNumber = h.callerName[r2.caller].recruiter; SELECT c1 FROM > c2 => RETURN[greater]; < c2 => RETURN[less]; ENDCASE; }; IF h.callerNumber^ THEN SELECT r1.caller FROM > r2.caller => RETURN[greater]; < r2.caller => RETURN[less]; ENDCASE; IF h.dinner^ THEN SELECT h.dinnerOrder[r1.dinner] FROM > h.dinnerOrder[r2.dinner] => RETURN[greater]; < h.dinnerOrder[r2.dinner] => RETURN[less]; ENDCASE; IF h.level^ THEN SELECT h.levelOrder[r1.level] FROM > h.levelOrder[r2.level] => RETURN[greater]; < h.levelOrder[r2.level] => RETURN[less]; ENDCASE; IF h.age^ THEN SELECT h.ageOrder[r1.age] FROM > h.ageOrder[r2.age] => RETURN[greater]; < h.ageOrder[r2.age] => RETURN[less]; ENDCASE; IF h.activity^ THEN SELECT h.activityOrder[r1.activity] FROM > h.activityOrder[r2.activity] => RETURN[greater]; < h.activityOrder[r2.activity] => RETURN[less]; ENDCASE; IF h.address^ THEN { SELECT Rope.Compare[r1.ctown, r2.ctown] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; SELECT Rope.Compare[r1.zip, r2.zip] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; SELECT Rope.Compare[r1.street, r2.street] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; SELECT r1.number FROM > r2.number => RETURN[greater]; < r2.number => RETURN[less]; ENDCASE; }; IF h.zip^ THEN SELECT Rope.Compare[r1.zip, r2.zip] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; IF h.recruiter^ THEN { c1: CallerNumber = h.callerName[r1.caller].recruiter; c2: CallerNumber = h.callerName[r2.caller].recruiter; SELECT Rope.Compare[h.callerName[c1].name, h.callerName[c2].name] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE}; IF h.caller^ THEN SELECT Rope.Compare[h.callerName[r1.caller].name, h.callerName[r2.caller].name] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; IF h.phone^ THEN SELECT Rope.Compare[r1.phone[0], r2.phone[0]] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; IF h.member^ THEN { Membership: TYPE = {none, one, all}; Classify: PROC [n: ROPE] RETURNS [Membership] = { IF Rope.Fetch[n, 0] = '* THEN RETURN[none]; FOR i: INT IN [1..Rope.Length[n]) DO IF Rope.Fetch[n, i] = '* THEN RETURN[one]; ENDLOOP; RETURN [all]}; m1: Membership _ Classify[r1.name[0]]; m2: Membership _ Classify[r2.name[0]]; SELECT m1 FROM > m2 => RETURN[greater]; < m2 => RETURN[less]; ENDCASE; }; SELECT Rope.Compare[r1.cname, r2.cname] FROM greater => RETURN[greater]; less => RETURN[less]; ENDCASE; RETURN[equal]}; SortEntries: PROC [h: Handle, secondary: BOOL] = { dinnerOrder: PACKED ARRAY CHAR OF [0..16) _ ALL[0]; levelOrder: PACKED ARRAY CHAR OF [0..16) _ ALL[0]; activityOrder: PACKED ARRAY CHAR OF [0..16) _ ALL[0]; ageOrder: PACKED ARRAY CHAR OF [0..16) _ ALL[0]; Greater: PROC [r1, r2: REF Entry] RETURNS [BOOL] = { RETURN[CompareProc[h, r1, r2] = greater]}; IF secondary THEN Sort[h.secondary, h.secondary.count, Greater] ELSE 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]; DO 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: "SortDir", proc: MakeTool, doc: "Sort a church directory" ]; [ ] _ MakeTool[NIL]; -- and create an instance END.