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]; InsertMailing: CEDAR PROGRAM IMPORTS Buttons, Commander, Containers, Convert, FS, IO, MessageWindow, RefText, Rope, Rules, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools = BEGIN 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; CP: TYPE = RECORD [caller, recruiter: ROPE]; CallerNameRec: TYPE = ARRAY [0..100) OF CP; 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, item: EntrySeq, address, zip, level, activity, dinner, age, phone, caller, recruiter, member: REF BOOL, items: CARDINAL _ 0, tsIn, tsOut: STREAM, callerName: REF CallerNameRec, 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: "Insert Mailing", -- 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, callers: 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: "Insertmailing.ts", wy: handle.height, parent: handle.outer, border: FALSE ]]; [handle.tsIn, handle.tsOut] _ ViewerIO.CreateViewerStreams [ name: "Insertmailing.ts", viewer: handle.ts, backingFile: "Insertmailing.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]; handle.zip _ Bool["zip", FALSE]; handle.level _ Bool["level", FALSE]; handle.activity _ Bool["activity", FALSE]; handle.age _ Bool["age", FALSE]; handle.dinner _ Bool["dinner", FALSE]; handle.address _ Bool["address", FALSE]; handle.phone _ Bool["phone", FALSE]; handle.caller _ Bool["caller", FALSE]; handle.recruiter _ Bool["recruiter", FALSE]; handle.member _ Bool["member", FALSE]; NewLine[]; Cmd["Count", CountThings]; NewLine[]; handle.cmd.inputFile _ LabeledItem["input", 50]; NewLine[]; handle.cmd.outputFile _ LabeledItem["output", 50]; 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]; 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[500]]; handle.items _ 0; 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]; ENDLOOP; handle.tsOut.PutText["Sorting:"]; SortEntries[handle]; handle.tsOut.PutText["Writing:"]; handle.out _ FS.StreamOpen[fileName: oName, accessOptions: $create]; FOR i: CARDINAL IN [0..handle.items) 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[]; 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 [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]]}; 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, cname: ROPE, -- cannonical form name street: ROPE, number: INT _ 0, ctown: ROPE]; EntrySeqBody: TYPE = RECORD [SEQUENCE max: CARDINAL OF REF Entry]; EntrySeq: TYPE = REF EntrySeqBody; 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; st1, st2: CARDINAL; ch: CHAR; num: INT _ 0; 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]; 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 handle.items = handle.item.max THEN GrowItemRec[handle]; handle.item[handle.items] _ e; handle.items _ handle.items + 1; EXITS done => NULL; }; GrowItemRec: PROC [h: Handle] = { n: CARDINAL; new: EntrySeq; IF h.item = NIL THEN n _ 500 ELSE n _ h.item.max + 100; new _ NEW[EntrySeqBody[n]]; IF h.item # NIL THEN FOR i: CARDINAL IN [0..h.items) DO new[i] _ h.item[i]; ENDLOOP; h.item _ new}; ReadEntry: PROC [handle: Handle] RETURNS [e: REF Entry] = { ENABLE IO.EndOfStream => {handle.eof _ TRUE; Quit[handle, "Syntax error "]}; st: STREAM _ handle.in; caller: ROPE; ch: CHAR; i: CARDINAL; e _ NEW [Entry]; 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 = 3 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; [] _ GetTokenRope[st, MyBreak]; -- old mailing 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 "]; }; 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] = { [] _ ns.SkipWhitespace[]; IF ns.EndOf[] THEN RETURN [NIL]; DO SELECT ns.PeekChar[] FROM '+, ' => {[] _ ns.GetChar[]}; '* => {[] _ ns.GetChar[]}; ENDCASE => EXIT; ENDLOOP; r _ GetTokenRope[ns, NameBreak].token; IF ~ns.EndOf[] THEN [] _ ns.GetChar[]}; PR: PROC [r: ROPE] = {h.out.PutRope[r]}; PC: PROC [c: CHAR] = {h.out.PutChar[c]}; ch, lastOut: CHAR; last: ROPE; first: BOOL _ TRUE; ns _ IO.RIS[name]; last _ GetName[]; -- last name WHILE ~ns.EndOf[] DO ch _ ns.GetChar[]; SELECT ch FROM ' => IF ~first THEN PC[lastOut _ ' ]; '+, '* => NULL; '( => EXIT; ENDCASE => {first _ FALSE; PC[lastOut _ ch]}; ENDLOOP; IF lastOut # ' THEN PC[' ]; PR[last]; }; 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.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; st.PutRope["|\t"]; IF e.town # NIL THEN st.PutRope[e.town]; st.PutRope["|\t"]; st.PutRope[e.zip]; st.PutRope["|\t"]; [] _ OutputName[handle, e.name[0]]; 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; c, r: ROPE; st: STREAM; n _ NEW[CallerNameRec _ ALL[[NIL, NIL]]]; st _ OpenFile[cnfile]; IF st = NIL THEN Quit2[h, st, "No caller names"]; WHILE ~st.EndOf[] DO c _ r _ 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; IF ~st.EndOf[] THEN SELECT (ch _ st.GetChar[]) FROM '\n => NULL; '| => { r _ GetTokenRope[st, MyBreak].token; IF st.GetChar[] # '\n THEN Quit2[h, st, "Missing CR in callernames"]}; ENDCASE => Quit2[h, st, "Syntax error in callernames"]; n[index] _ [caller: c, 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]; }; SortEntries: PROC [h: Handle] = { 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] = { IF h.dinner^ THEN SELECT dinnerOrder[r1.dinner] FROM > dinnerOrder[r2.dinner] => RETURN[TRUE]; < dinnerOrder[r2.dinner] => RETURN[FALSE]; ENDCASE; IF h.level^ THEN SELECT levelOrder[r1.level] FROM > levelOrder[r2.level] => RETURN[TRUE]; < levelOrder[r2.level] => RETURN[FALSE]; ENDCASE; IF h.age^ THEN SELECT ageOrder[r1.age] FROM > ageOrder[r2.age] => RETURN[TRUE]; < ageOrder[r2.age] => RETURN[FALSE]; ENDCASE; IF h.activity^ THEN SELECT activityOrder[r1.activity] FROM > activityOrder[r2.activity] => RETURN[TRUE]; < activityOrder[r2.activity] => RETURN[FALSE]; ENDCASE; IF h.address^ THEN { SELECT Rope.Compare[r1.ctown, r2.ctown] FROM greater => RETURN[TRUE]; less => RETURN[FALSE]; ENDCASE; SELECT Rope.Compare[r1.zip, r2.zip] FROM greater => RETURN[TRUE]; less => RETURN[FALSE]; ENDCASE; SELECT Rope.Compare[r1.street, r2.street] FROM greater => RETURN[TRUE]; less => RETURN[FALSE]; ENDCASE; SELECT r1.number FROM > r2.number => RETURN[TRUE]; < r2.number => RETURN[FALSE]; ENDCASE; }; IF h.zip^ THEN SELECT Rope.Compare[r1.zip, r2.zip] FROM greater => RETURN[TRUE]; less => RETURN[FALSE]; ENDCASE; IF h.recruiter^ THEN SELECT Rope.Compare[h.callerName[r1.caller].recruiter, h.callerName[r2.caller].recruiter] FROM greater => RETURN[TRUE]; less => RETURN[FALSE]; ENDCASE; IF h.caller^ THEN SELECT Rope.Compare[h.callerName[r1.caller].caller, h.callerName[r2.caller].caller] FROM greater => RETURN[TRUE]; less => RETURN[FALSE]; ENDCASE; IF h.phone^ THEN SELECT Rope.Compare[r1.phone[0], r2.phone[0]] FROM greater => RETURN[TRUE]; less => RETURN[FALSE]; ENDCASE; IF h.member^ THEN { c1: CHAR _ Rope.Fetch[r1.name[0], 0]; c2: CHAR _ Rope.Fetch[r2.name[0], 0]; IF c1 = '* THEN {IF c2 # '* THEN RETURN [FALSE]} ELSE IF c2 = '* THEN RETURN[TRUE]}; SELECT Rope.Compare[r1.cname, r2.cname] FROM greater => RETURN[TRUE]; less => RETURN[FALSE]; ENDCASE; RETURN[FALSE]}; dinnerOrder['d] _ 1; dinnerOrder['h] _ 2; dinnerOrder['i] _ 3; dinnerOrder['o] _ 4; dinnerOrder['-] _ 5; dinnerOrder[' ] _ 6; activityOrder['a] _ 1; activityOrder['b] _ 2; activityOrder['c] _ 3; activityOrder['-] _ 4; activityOrder[' ] _ 5; ageOrder['k] _ 1; ageOrder['y] _ 2; ageOrder['a] _ 3; ageOrder['s] _ 4; ageOrder['-] _ 5; ageOrder[' ] _ 6; levelOrder['9] _ 1; levelOrder['8] _ 2; levelOrder['7] _ 3; levelOrder['6] _ 4; levelOrder['5] _ 5; levelOrder['4] _ 6; levelOrder['3] _ 7; levelOrder['2] _ 8; levelOrder['1] _ 9; levelOrder['c] _ 10; levelOrder['0] _ 11; levelOrder['-] _ 12; levelOrder[' ] _ 13; Sort[h.item, h.items, 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: "InsertMailing", proc: MakeTool, doc: "Insert mailing names" ]; [ ] _ MakeTool[NIL]; -- and create an instance END. คInsertMailing.mesa; Last Edited by: Sweet, October 11, 1984 1:34:55 am PDT 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. default the width so that it will be computed for us -- default the width so that it will be computed for us -- default the width so that it will be computed for us -- force the selection into the user input field force the selection into the user input field do the work force the selection into the user input field various initializations do the work extracted for use by sort comparison extract interesting data enter into list to be sorted one should SkipWhitespace before calling (and check for eof) copied from IOSearchImpl because it didn't handle empty tokens properly Sort by various keys set order on interesting values (bogus ones come out first) ส L– "Cedar" style˜Iproc– "Cedar" stylešœ™J™6unitšฯk ˜ Lšœ˜Jšœ˜Jšœ œ˜(Jšœ œ/˜?J˜Jšœ˜Jšœ˜J˜J˜Jšœ˜Jšœœ˜J˜ J˜Jšœœ˜-Jšœ œ˜%Jšœ œ˜,Jšœ œ0˜A—šœœœ˜ Jšœ.œ]˜”—Lš˜Jšœฝ™ฝJšœ œฯc&˜BJšœ œž'˜CJšœ œž+˜HJšœœœ˜Jšœœœœ˜Jšœœ˜J˜J˜Jšœœœœ˜,š œœœ œœ˜+J˜—Lšœœœžะckž]˜šœœœž+˜AJšœœž%˜HJšœœž0˜GJšœž˜$Jšœœœœ˜!Jšœœ˜ J˜JšœNœ˜WJšœœ˜Jšœ œ˜Jšœ œ˜Jšœž˜.J˜—šœ œœ˜Jšœ/œ˜4—Jšœœœ ˜#šœ"˜'Jšœ˜Jšœ œ˜emphasisšœžœ˜>Jšœž ˜8Jšœœž4˜DJšœž˜0Jšœ œœž'˜>—Jšœž!˜4JšœP˜PJšœ'˜'Jšœ)ž˜=Jšœ˜Jšœ)ž˜@Jšœ˜—šœœœ˜Jšœ4˜4Jšœ˜J˜—J˜šฯnœœœ˜.Jšœ-ž(˜Ušœ˜JšœRœ˜[—šœ<˜Jšœ%˜%Jšœœ ˜6šœ#˜#šœ˜Jšœ˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœ˜Jšœœ˜—Jšœ ˜ Jšœž)˜:—Jšœ˜šœ$˜$Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ˜Jšœ ˜ Jšœ œ˜Jšœœ˜—J˜Jšœ˜—š œœ œ˜5šœ#˜#šœ˜Jšœ ˜ J˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœœ˜—Jšœ ˜ Jšœž(œ˜>—Jšœ˜—š œœ œ œœœœ˜DJ˜Jšœœœ ˜šœ˜šœ˜Jšœ ˜ J˜Jšœ˜Jšœ7™7Jšœž4˜EJšœ˜Jšœœ˜—Jšœ˜Jšœž(œ˜<—J•StartOfExpansion[]š œ,œ œœœ˜lJšœ˜—J˜Jšœ ˜ J˜Jšœœ˜ Jšœœ˜$Jšœ#œ˜*Jšœœ˜ Jšœœ˜&Jšœ!œ˜(Jšœœ˜$Jšœœ˜&Jšœ%œ˜,Jšœœ˜&Jšœ ˜ J˜J˜Jšœ ˜ Jšœ0˜0J˜Jšœ ˜ Jšœ2˜2J˜Jšœ ˜ J˜JšœK˜KJ˜Jšœ ˜ Jšœ˜—–† -- [parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE] -- šœŸ…œ˜ฉJšœ-™-Jšœœ ˜&Jšœ&ž˜šœœœ˜'Jšœœœ˜"šœ˜ Jšœ œ˜šœ˜ Jšœ:˜:——Jšœ˜—Jšœ˜!J˜—šœœœ˜J˜Jšœœ˜(Jš œœœœœœ˜'Jš œœœœœœ˜&Jš œœœœœœ˜&Jšœœœ˜Jšœœœ˜Jšœ œœ˜Jšœ$™$Jšœœž˜%Jšœœ˜ Jšœœ˜Jšœœ˜ J˜—Jš œœœœœœœ˜Bšœ œœ˜"J˜—Jšœ œœ˜J˜–+ -- [char: CHAR] RETURNS [IO.CharClass] -- šœ œ Ÿ*œ˜Dšœœ˜Jšœ˜J˜Jšœ ˜—J˜J˜—š  œœœœœ˜4šœœ˜Jš œœ œœœ˜3—J˜—š  œœ˜$Jšœœ˜ Jšœ œ˜Jšœœ˜ Jšœœ˜ Jšœ œœ˜šœ œœ˜šœ˜Jšœ$˜$Jšœ œ˜—Jšœ˜Jš œ˜—Jšœ ˜ Jš œœœœœ˜:Jšœ˜Jšœ™J˜Jš œœ œœœœ˜Ošœ œ#œ ˜DJšœœœ˜J˜Jšœ˜—J˜Jšœ œ!œœ˜Mšœœœ ˜ Jšœœ œ˜6Jšœ˜—J˜BJšœ œœ˜%Jšœœ œœ ˜)šœ˜šœœœ˜Jšœ œœœ˜6š˜Jšœ˜ —Jšœ˜ ——Jšœ™Jšœ œ˜;J˜?š˜Jšœœ˜ —J˜—J˜š  œœ˜!Jšœœ˜ J˜Jšœ œœ œ˜7Jšœœ˜š œ œœœœœ˜7J˜Jšœ˜—J˜J˜—š  œœœœ ˜;Jšœ<™J˜>J˜DJ˜-J˜5J˜5J˜;J˜;J˜;J˜>J˜—J˜J˜J˜—š œœ˜ J˜ Jšœœ˜ Jš œ œ œœœ˜5Jšœœ˜ Jšœœ˜J˜š œœœ˜!Jšœœ˜ Jšœœ˜š˜J˜Jšœœœ˜Jšœœœ ˜4Jšœœœ˜"J˜J˜Jšœ˜—J˜J˜—Jš œ œœ œœ˜6šœ œœ˜J˜ J˜J˜J˜Jšœ˜ J˜——J˜šœ8˜8Jšœ˜—Mšœœž˜.I modheaderšœ˜Ic˜N˜J˜—…—U๒yโ