<> <> <> DIRECTORY Ascii, Basics, Buttons, Commander USING [CommandProc, Register], CommandTool, Containers USING [ChildXBound, ChildYBound, Container, Create], Convert, FS, IO, Labels, MessageWindow, PieViewers, RefText, Rope, Rules USING [Create, Rule], SafeStorage, SirPress, TiogaFileOps, TSFont, TSTypes, TypeScript, VFonts, ViewerClasses USING [Viewer, ViewerClassRec], ViewerIO USING [CreateViewerStreams], ViewerOps USING [PaintViewer], ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection]; SortLabels: CEDAR MONITOR LOCKS h.LOCK USING h: Handle IMPORTS Buttons, Commander, CommandTool, Containers, Convert, FS, IO, Labels, MessageWindow, PieViewers, RefText, Rope, Rules, SafeStorage, SirPress, TiogaFileOps, TSFont, TSTypes, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools = BEGIN <> entryHeight: CARDINAL = 15; -- how tall to make each line of items entryVSpace: CARDINAL = 4; -- 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 = MONITORED 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 dim: DimRecord _ TRASH, in: IO.STREAM, eof: BOOLEAN _ FALSE, out, pressOut: IO.STREAM, item: EntrySeq, root, prevLast: TiogaFileOps.Ref, press: SirPress.PressHandle _ NIL, fontCode: SirPress.FontCode, fontInfo: TSFont.Ref, busy: BOOL _ FALSE, stopFlag: BOOL, row, col: INT, pages: INT, pie: PieViewers.PieViewer, byLastName, zip, textP, pressP, tiogaOut, proof, nProof, doSpruce: REF BOOL, flagZip, showNames: REF BOOL, textOutput, pressOutput: BOOL, doByLastName, doZip, doTioga, doProof, numberProof, spruce: BOOL, -- so they won't change while we're running tsIn, tsOut: STREAM, ts: ViewerClasses.Viewer, numEntries: INT_0]; -- the typescript DimRecord: TYPE = RECORD [ fontSize, leftMargin, lineHeight: INT]; Entry: TYPE = RECORD [ zip: INT _ 0, dataLength: CARDINAL, text: ROPE]; EntrySeqBody: TYPE = RECORD [count: CARDINAL _ 0, e: SEQUENCE max: CARDINAL OF REF Entry]; EntrySeq: TYPE = REF EntrySeqBody; CommandViewer: TYPE = RECORD [ workingDir, inputFile, outputFile, pressFile, size, fontFamily, fontSize, status, leftMargin: ViewerClasses.Viewer ]; 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: "Label Sorter", -- name displayed in the caption iconic: TRUE, column: left, 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: "SortLabels.ts", wy: handle.height, parent: handle.outer, border: FALSE ]]; [handle.tsIn, handle.tsOut] _ ViewerIO.CreateViewerStreams [ name: "SortLabels.ts", viewer: handle.ts, backingFile: "SortLabels.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: FALSE ], 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}; Cmd["DoIt!", DoIt]; Cmd["STOP!", StopIt]; handle.byLastName _ Bool["sort by last name", TRUE]; handle.zip _ Bool["sort by zip", FALSE]; handle.cmd.size _ LabeledItem["expected # of items", 10, "7500"]; NewLine[]; handle.showNames _ Bool["display questionable names", FALSE]; handle.flagZip _ Bool["display missing zips", TRUE]; handle.nProof _ Bool["number proofs", FALSE]; handle.pie _ PieViewers.Create[parent: handle.outer, x: wx, y: handle.height, total: 1]; wx _ wx + 16 + entryHSpace; handle.cmd.status _ Labels.Create[ [ name: NIL, -- initial contents wx: wx, wy: handle.height, ww: VFonts.StringWidth["Writing"]+6, wh: entryHeight, parent: handle.outer, border: FALSE]]; NewLine[]; handle.cmd.workingDir _ LabeledItem["working directory", 50, CommandTool.CurrentWorkingDirectory[]]; NewLine[]; handle.cmd.inputFile _ LabeledItem["input", 50]; NewLine[]; handle.textP _ Bool["do text output", FALSE]; handle.tiogaOut _ Bool["tioga", FALSE]; handle.cmd.outputFile _ LabeledItem["text output", 50]; NewLine[]; handle.pressP _ Bool["do label output", FALSE]; handle.proof _ Bool["proof", FALSE]; handle.numEntries _ 0; handle.doSpruce _ Bool["Spruce", TRUE]; handle.cmd.pressFile _ LabeledItem["label output", 50]; NewLine[]; handle.cmd.fontFamily _ LabeledItem["font family", 20, "Gacha"]; handle.cmd.fontSize _ LabeledItem["font size", 5, "8"]; handle.cmd.leftMargin _ LabeledItem["left margin", 5, "18"]; 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]; }; StopIt: 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 handle.stopFlag _ TRUE; END; EnterTool: ENTRY PROC [h: Handle] RETURNS [BOOL] = { IF h.busy THEN { MessageWindow.Append[message: "Already sorting labels", clearFirst: TRUE]; RETURN[FALSE]}; h.busy _ TRUE; RETURN[TRUE]; }; ExitTool: ENTRY PROC [h: Handle] = {h.busy _ FALSE}; 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 total: REAL; IF ~EnterTool[handle] THEN RETURN; BEGIN ENABLE { UNWIND => {IF handle.in # NIL THEN handle.in.Close[]; handle.in _ NIL; ExitTool[handle]}; Problem, ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}}; iName: ROPE _ ViewerTools.GetContents[handle.cmd.inputFile]; oName: ROPE _ ViewerTools.GetContents[handle.cmd.outputFile]; pName: ROPE _ ViewerTools.GetContents[handle.cmd.pressFile]; wDir: ROPE = ViewerTools.GetContents[handle.cmd.workingDir]; Val: PROC [v: ViewerClasses.Viewer, default: INT] RETURNS [n: INT] = { n _ Convert.IntFromRope[ViewerTools.GetContents[v] ! SafeStorage.NarrowFault => {n _ default; GO TO gub}; Convert.Error => { MessageWindow.Append[message: "invalid number", clearFirst: TRUE]; n _ default; GO TO gub}; ]; EXITS gub => NULL; }; <> handle.stopFlag _ FALSE; <> IF iName = NIL THEN { handle.tsOut.Put[[rope["specify input file"]], [character['\n]]]; ExitTool[handle]; RETURN}; handle.textOutput _ handle.textP^; handle.pressOutput _ handle.pressP^; iName _ FS.ExpandName[iName, wDir ! FS.Error => Quit[handle, "bad input file"]].fullFName; IF handle.textOutput THEN IF oName # NIL AND Rope.Length[oName] # 0 THEN oName _ FS.ExpandName[oName, wDir ! FS.Error => Quit[handle, "bad text output file"]].fullFName ELSE Quit[handle, "specify text output file"]; IF handle.pressOutput THEN IF pName # NIL AND Rope.Length[pName] # 0 THEN pName _ FS.ExpandName[pName, wDir ! FS.Error => Quit[handle, "bad label output file"]].fullFName ELSE Quit[handle, "specify label output"]; IF ~handle.textOutput AND ~handle.pressOutput THEN { handle.tsOut.Put[[rope["specify either text or label output file (or both)"]], [character['\n]]]; ExitTool[handle]; RETURN}; handle.in _ OpenFile[iName]; IF handle.in # NIL THEN handle.eof _ FALSE ELSE Quit[handle, "no input file"]; total _ handle.in.GetLength[]; handle.in.SetIndex[0]; handle.doTioga _ handle.tiogaOut^; handle.doZip _ handle.zip^; handle.doByLastName _ handle.byLastName^; handle.doProof _ handle.proof^; handle.numberProof _ handle.nProof^; handle.spruce _ handle.doSpruce^; handle.pages _ 0; IF handle.pressOutput THEN { family: ROPE _ ViewerTools.GetContents[handle.cmd.fontFamily]; handle.pressOut _ FS.StreamOpen[fileName: pName, accessOptions: $create]; handle.press _ SirPress.Create[outputStream: handle.pressOut, fileNameForHeaderPage: pName]; handle.dim.fontSize _ Val[handle.cmd.fontSize, 8]; handle.dim.leftMargin _ Val[handle.cmd.leftMargin, 18]; handle.dim.lineHeight _ handle.dim.fontSize; handle.press.SetPageSize[110, 85]; handle.fontCode _ handle.press.GetFontCode[ family: family, size: handle.dim.fontSize, face: 0 --faceNormal--]; handle.fontInfo _ TSFont.Lookup[family,TSTypes.IntDimn[handle.dim.fontSize, TSTypes.bp]]; handle.row _ 0; handle.col _ 0; handle.press.SetFontFromCode[handle.fontCode]}; handle.item _ NEW[EntrySeqBody[Val[handle.cmd.size, 5000]]]; Labels.Set[handle.cmd.status, "reading"]; WHILE ~handle.eof DO IF handle.stopFlag THEN {handle.tsOut.PutText["input aborted, no output"]; GO TO done}; EnterItem[handle ! IO.EndOfStream => EXIT]; PieViewers.Set[handle.pie, 1 - handle.in.GetIndex[] / total]; ENDLOOP; PieViewers.Set[handle.pie, 0]; IF handle.doByLastName OR handle.doZip THEN { Labels.Set[handle.cmd.status, "sorting"]; SortEntries[handle]}; total _ handle.item.count; Labels.Set[handle.cmd.status, "writing"]; IF handle.textOutput THEN { IF handle.doTioga THEN { handle.root _ TiogaFileOps.CreateRoot[]; handle.prevLast _ NIL} ELSE handle.out _ FS.StreamOpen[fileName: oName, accessOptions: $create]; }; FOR i: CARDINAL IN [0..handle.item.count) DO IF handle.stopFlag THEN {handle.tsOut.PutText["output truncated"]; EXIT}; WriteEntry[handle, handle.item[i]]; PieViewers.Set[handle.pie, 1 - i/total]; handle.item[i] _ NIL; ENDLOOP; PieViewers.Set[handle.pie, 0]; IF handle.pressOutput AND NOT (handle.row = 0 AND handle.col = 0) THEN { handle.press.WritePage[]; handle.pages _ handle.pages + 1; handle.press.ClosePress[]; handle.press _ NIL}; IF handle.textOutput AND handle.doTioga THEN { Labels.Set[handle.cmd.status, "storing"]; TiogaFileOps.Store[handle.root, oName]}; Labels.Set[handle.cmd.status, 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.PutF["\n %g entries\n", [integer[handle.item.count]]]; IF handle.pressOutput THEN handle.tsOut.PutF["%g label pages\n", [integer[handle.pages]]]; handle.item _ NIL; ExitTool[handle]; END; Problem: ERROR = CODE; OpenFile: PROC [name: ROPE] RETURNS [st: STREAM] = { st _ FS.StreamOpen[name, $read ! FS.Error => IF error.group # bug THEN CONTINUE]}; EnterItem: PROC [handle: Handle] = { flagged: BOOLEAN _ FALSE; Flag: PROC [msg: ROPE _ NIL] = { IF flagged THEN RETURN; flagged _ TRUE; IF msg # NIL THEN handle.tsOut.PutRope[msg]; handle.tsOut.Put[[character['\n]], [rope[e.text]]]}; e: REF Entry; ch: CHAR; zip: INT _ 0; i, len: INT; st: STREAM = handle.in; IF handle.eof THEN RETURN; IF st = NIL THEN { MessageWindow.Append[ message: "Please open a file first", clearFirst: TRUE]; MessageWindow.Blink[ ]; ERROR ABORTED}; [] _ st.SkipWhitespace[]; e _ ReadEntry[handle, st]; <> len _ Rope.Length[e.text]; FOR i IN [0..len) DO IF Rope.Fetch[e.text, i] = '[ THEN { len _ i; EXIT}; ENDLOOP; i _ len - 1; WHILE i >= 0 AND Rope.Fetch[e.text, i] <= Ascii.SP DO i _ i - 1 ENDLOOP; e.dataLength _ i+1; WHILE i >= 0 AND Rope.Fetch[e.text, i] IN ['0..'9] DO i _ i - 1 ENDLOOP; IF Rope.Fetch[e.text, i] = '- THEN { -- 9 digit zip, throw away final 4 i _ i-1; WHILE i >= 0 AND Rope.Fetch[e.text, i] IN ['0..'9] DO i _ i - 1 ENDLOOP}; i _ i+1; WHILE i < len AND (ch _ Rope.Fetch[e.text, i]) IN ['0..'9] DO zip _ zip*10 + ch.ORD - '0.ORD; i _ i + 1; ENDLOOP; IF handle.flagZip^ AND (zip = 0 OR zip > 99999) THEN Flag["**** zip ****"]; e.zip _ zip; IF handle.item.count = handle.item.max THEN GrowItemRec[handle]; handle.item[handle.item.count] _ e; handle.item.count _ handle.item.count + 1; }; GrowItemRec: PROC [h: Handle] = { n: INT; new: EntrySeq; IF h.item = NIL THEN n _ 1000 ELSE n _ MAX[(5*h.item.max)/4, 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, st: STREAM] RETURNS [e: REF Entry] = { <> prevCr: BOOL _ FALSE; DoubleCrBreak: IO.BreakProc -- [char: CHAR] RETURNS [IO.CharClass] -- = { SELECT char FROM '\n => IF prevCr THEN {prevCr _ FALSE; RETURN[break]} ELSE prevCr _ TRUE; ENDCASE => prevCr _ FALSE; RETURN[other] }; e _ NEW [Entry]; e.text _ GetTokenRope[handle.in, DoubleCrBreak].token; }; WriteEntry: PROC [handle: Handle, e: REF Entry] = { flagged: BOOLEAN _ FALSE; Flag: PROC [msg: ROPE _ NIL] = { IF flagged THEN RETURN; flagged _ TRUE; IF msg # NIL THEN handle.tsOut.PutRope[msg]; handle.tsOut.Put[[character['\n]], [rope[e.text]]]}; IF handle.textOutput THEN { IF handle.doTioga THEN { handle.prevLast _ TiogaFileOps.InsertAsLastChild[handle.root, handle.prevLast]; TiogaFileOps.SetContents[handle.prevLast, e.text]} ELSE { handle.out.PutRope[e.text]; handle.out.PutChar['\n]}; }; IF handle.pressOutput THEN { IF ~handle.doProof AND Rope.Length[e.text] # e.dataLength THEN e.text _ Rope.Substr[e.text, 0, e.dataLength]; handle.numEntries _ handle.numEntries+1; PressEntry[handle, e ! TooWide => {Flag["\n**** too wide ****"]; RESUME}; TooHigh => {Flag["\n**** too many lines ****"]; RESUME}; StrangeName => {IF handle.showNames^ THEN Flag["**** no comma ****"]; RESUME}]}; }; Quit: PROC [handle: Handle, reason: ROPE _ NIL] = { loc: INT; IF handle.in = NIL THEN loc _ 0 ELSE { loc _ handle.in.GetIndex[]; handle.in.Close[]; handle.in _ NIL; handle.eof _ TRUE}; handle.tsOut.Put[[rope[reason]], [integer[loc]], [character['\n]]]; ERROR Problem}; Points: TYPE = INT; PBox: TYPE = RECORD [x,y,w,h: Points]; LineY: PROC [h: Handle, box: PBox, line, of: CARDINAL] RETURNS [Points] = BEGIN bottom: Points; line _ of-1-line; -- count from top bottom _ (box.h- of*h.dim.lineHeight)/2; IF bottom < 0 THEN SIGNAL TooHigh; RETURN [box.y + bottom + line*(h.dim.lineHeight)]; END; LJLine: PROC [h: Handle, s: ROPE, box: PBox, line, of: CARDINAL] = BEGIN PT: PROC [t: ROPE, x, y: INT] = { SirPress.PutText[p: h.press, textString: t, xCoordinateOfLeftEdge: x, yCoordinateOfBaseline: y, unit: SirPress.pt]}; y: Points = LineY[h: h, box: box, line: line, of: of]; IF PWidth[h, s] > box.w THEN SIGNAL TooWide; PT[t: s, x: box.x, y: y]; END; TooWide: SIGNAL = CODE; TooHigh: SIGNAL = CODE; pageWidth: Points = 612; pageHeight: Points = 792; LWidth: Points = pageWidth/3; LHeight: Points = 72; PWidth: PROC [h: Handle, s: ROPE] RETURNS [INT] = { w: TSTypes.Dimn _ [0]; ref: TSFont.Ref _ h.fontInfo; IF ref = NIL THEN RETURN [0]; FOR i: INT IN [0..Rope.Length[s]) DO w _ [w + TSFont.Width[ref, Rope.Fetch[s, i]]]; ENDLOOP; RETURN [TSTypes.DimnInt[w, TSTypes.pt]]; }; PressEntry: PROC [h: Handle, e: REF Entry] = { doubleWide: BOOL _ FALSE; NextLabel[h]; PressEntryRope[h, e.text ! TooWide => { SIGNAL TooWide; -- let those above see this doubleWide _ TRUE; IF h.col # 2 THEN RESUME; -- won't fit on page, start on hew line PressEntryRope[h, "**********\n**********\n**********"]; -- wipe out label NextRow[h]; PressEntryRope[h, e.text ! TooWide => RESUME]; CONTINUE}; TooHigh => IF h.row = 0 THEN { PressEntryRope[h, "**********\n**********\n**********"]; -- wipe out label NextRow[h]; PressEntryRope[h, e.text]; CONTINUE}]; h.col _ h.col + (IF doubleWide THEN 2 ELSE 1); }; NextLabel: PROC [h: Handle] = { IF h.col = 3 THEN NextRow[h]; }; NextRow: PROC [h: Handle] = { h.row _ h.row + 1; h.col _ 0; IF h.row = 11 THEN { h.press.WritePage[]; h.pages _ h.pages + 1; h.press.SetFontFromCode[h.fontCode]; h.row _ 0}; }; PressEntryRope: PROC [h: Handle, text: ROPE] = { box: PBox; eLines: CARDINAL _ 1; tl: INT _ Rope.Length[text]; this: ROPE; i1, i2: INT _ 0; ch: CHAR _ '\n; first: BOOL _ TRUE; k: CARDINAL _ 0; lw: INT _ 0; box.x _ h.dim.leftMargin + h.col * LWidth; box.y _ 10*72 - h.row*LHeight; box.w _ LWidth - 27; box.h _ IF h.spruce AND h.row = 0 THEN 72 - 18 ELSE 72; -- don't write on top 1/4 inch of paper <> FOR i: INT IN [0..tl) DO ch _ Rope.Fetch[text, i]; IF ch = '\n THEN {eLines _ eLines + 1; lw _ 1} ELSE lw _ lw + 1; ENDLOOP; IF ch # '\n THEN eLines _ eLines + 1; WHILE i1 < tl DO paren: BOOL _ FALSE; ip: INT; i2 _ i1; WHILE i2 < tl AND (ch _ Rope.Fetch[text, i2]) # '\n DO IF ~h.doProof AND ch = '( AND ~paren THEN {paren _ TRUE; ip _ i2}; i2 _ i2 + 1; ENDLOOP; this _ IF paren THEN Rope.Substr[text, i1, ip-i1] ELSE Rope.Substr[text, i1, i2-i1]; IF first THEN { first _ FALSE; IF ~h.doProof THEN this _ MailingName[this] ELSE IF h.numberProof THEN this _ this.Concat[IO.PutFR[" (%g)", IO.int[h.numEntries]]]; }; -- put out this line LJLine[h: h, s: this, box: box, line: k, of: eLines]; k _ k + 1; i1 _ i2+1; ENDLOOP; }; StrangeName: SIGNAL = CODE; MailingName: PROC [n: ROPE, flipName: BOOL _ TRUE] RETURNS [ROPE] = { len: INT _ Rope.Length[n]; ln2, t1, t2, f1, f2: INT _ 0; slashSeen: BOOL _ FALSE; last, title, first: ROPE; <> ln2 _ 0; IF flipName THEN { WHILE ln2 < len DO SELECT Rope.Fetch[n, ln2] FROM ', => EXIT; '= => RETURN [MailingName[Rope.Substr[n, ln2+1, len - ln2 - 1], FALSE]]; ENDCASE; ln2 _ ln2 + 1; REPEAT FINISHED => {SIGNAL StrangeName; RETURN[n]}; ENDLOOP; last _ Rope.Substr[n, 0, ln2]} ELSE last _ NIL; <> t1 _ ln2+1; WHILE t1 < len AND Rope.Fetch[n, t1] = ' DO t1 _ t1 + 1 ENDLOOP; t2 _ t1; WHILE t2 < len DO SELECT Rope.Fetch[n, t2] FROM '= => RETURN [MailingName[Rope.Substr[n, t2+1, len - t2 - 1], FALSE]]; ' => EXIT; '/ => slashSeen _ TRUE; ENDCASE; t2 _ t2 + 1; ENDLOOP; title _ IF t1 = t2 THEN NIL ELSE Rope.Substr[n, t1, t2-t1]; <> IF slashSeen THEN SELECT TRUE FROM Rope.Equal[title, "M/M", FALSE] => title _ "Mr & Mrs"; Rope.Equal[title, "Dr/M", FALSE] => title _ "Dr & Mrs"; Rope.Equal[title, "Dr/Dr", FALSE] => title _ "Dr & Dr"; Rope.Equal[title, "R/Adm/M", FALSE] => title _ "R/Adm & Mrs"; Rope.Equal[title, "R/Adm", FALSE] => NULL; Rope.Equal[title, "LtC/M", FALSE] => title _ "Lt/Col & Mrs"; Rope.Equal[title, "Judge/M", FALSE] => title _ "Judge & Mrs"; Rope.Equal[title, "Col/M", FALSE] => title _ "Col & Mrs"; Rope.Equal[title, "Rev/M", FALSE] => title _ "Rev & Mrs"; Rope.Equal[title, "Prof/M", FALSE] => title _ "Prof & Mrs"; Rope.Equal[title, "Capt/M", FALSE] => title _ "Capt & Mrs"; Rope.Equal[title, "Admiral/M", FALSE] => title _ "Admiral & Mrs"; Rope.Equal[title, "Gen/M", FALSE] => title _ "Gen & Mrs"; ENDCASE => SIGNAL StrangeName; f1 _ t2+1; WHILE f1 < len AND Rope.Fetch[n, f1] = ' DO f1 _ f1 + 1 ENDLOOP; f2 _ f1; WHILE f2 < len DO SELECT Rope.Fetch[n, f2] FROM '= => RETURN [Rope.Substr[n, f2+1, len - f2 - 1]]; '( => { -- make sure no = follows FOR i: INT IN (f2..len) DO IF Rope.Fetch[n, i] = '= THEN RETURN [MailingName[Rope.Substr[n, i+1, len - i - 1], FALSE]]; ENDLOOP; EXIT}; ENDCASE; f2 _ f2 + 1; ENDLOOP; WHILE f2 > f1 AND Rope.Fetch[n, f2-1] = ' DO f2 _ f2 - 1 ENDLOOP; first _ IF f1 = f2 THEN NIL ELSE Rope.Substr[n, f1, f2-f1]; RETURN [Rope.Cat[title, " ", first, " ", last]]; }; <> 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[300]; { 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 -- make NIL be greater than anything IF r2 = NIL THEN RETURN [equal] ELSE RETURN[greater] ELSE IF r2 = NIL THEN RETURN[less]; IF h.doZip THEN SELECT r1.zip FROM > r2.zip => RETURN[greater]; < r2.zip => RETURN[less]; ENDCASE; SELECT Rope.Compare[r1.text, r2.text, FALSE] 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]}; IF ~h.doZip AND ~h.doByLastName THEN RETURN; 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: "SortLabels", proc: MakeTool, doc: "Sort labels, producing new source file or press file with 33 up labels (or both) Source file has entries (separated by blank lines) of the form Last, Title First Other Address TownAndState Zipcode At least 5 lines will fit in Gacha 8, For proof printing, the first line is printed as-is. For non-proof, the Last name is put last and if the title has one of several special forms (see below), it is expanded. Entries that don't fit within a label are displayed in the log window and printed across two label spaces. One can optionally display entries that have no comma in the first line (for corporate labels, this can be legitimate, but it's helpful for finding typos). Entries with difficult to encode names can have the non-proof label first line given explicitly after an =. e.g., Smith, The Family=The Smith Family Optional info can appear in parentheses, but is surpressed for non-proof labels Smith, Mrs. Joseph (Susie) Finally, the entry can be followed extra non-label information if it begins on a line with a left bracket '[ (but before the blank line separating entries). The text output has the option of a plain text file, or a Tioga node per entry. Either is acceptable input to the program. The expandable titles (ad hoc to handle the Children's Health Council) are M/M => Mr & Mrs Dr/M => Dr & Mrs Dr/Dr => Dr & Dr R/Adm/M => R/Adm & Mrs R/Adm => R/Adm LtC/M => Lt/Col & Mrs Judge/M => Judge & Mrs Col/M => Col & Mrs Rev/M => Rev & Mrs Prof/M => Prof & Mrs Capt/M => Capt & Mrs Admiral/M => Admiral & Mrs Gen/M => Gen & Mrs Non-obvious switches and their meaning: number proofs: if TRUE (inverted), then put sequence numbers on proof entries Spruce: if TRUE, don't mark on the top quarter inch of the paper " ]; END.