SortLabels.mesa;
Last Edited by: Sweet, October 18, 1984 2:26:05 pm PDT
DIRECTORY
Ascii,
Basics,
Buttons,
Commander USING [CommandProc, Register],
CommandTool,
Containers USING [ChildXBound, ChildYBound, Container, Create],
Convert,
FS,
IO,
MessageWindow,
RefText,
Rope,
Rules USING [Create, Rule],
SafeStorage,
SirPress,
TiogaFileOps,
TSFont,
TSTypes,
TypeScript,
VFonts,
ViewerClasses USING [Viewer, ViewerClassRec],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [CreateViewer, PaintViewer],
ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection];
SortLabels: CEDAR MONITOR LOCKS h.LOCK USING h: Handle    
IMPORTS Buttons, Commander, CommandTool, Containers, Convert, FS, IO, MessageWindow, RefText, Rope, Rules, SafeStorage, SirPress, TiogaFileOps, TSFont, TSTypes, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools =
BEGIN
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;
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: BOOLEANFALSE,
out, pressOut: IO.STREAM,
item: EntrySeq,
root, prevLast: TiogaFileOps.Ref,
press: SirPress.PressHandle ← NIL,
fontCode: SirPress.FontCode,
fontInfo: TSFont.Ref,
busy: BOOLFALSE,
stopFlag: BOOL,
row, col: INT,
pages: INT,
zip, textP, pressP, tiogaOut, proof: REF BOOL,
flagZip, showNames: REF BOOL,
textOutput, pressOutput: BOOL,
doZip, doTioga, doProof: BOOL, -- so they won't change while we're running
tsIn, tsOut: STREAM,
ts: ViewerClasses.Viewer ];  -- the typescript
DimRecord: TYPE = RECORD [
fontSize, lead, 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, lead: 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,   -- 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: "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: ROPENIL]
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};
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};
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["Sort", DoIt];
Cmd["STOP!", StopIt];
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];
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.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.lead ← LabeledItem["lead", 5, "0"];
NewLine[];
END;
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;
ToggleBool: Buttons.ButtonProc = {
switch: REF BOOLNARROW [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
force the selection into the user input field
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
force the selection into the user input field
handle: Handle ← NARROW[clientData]; -- get our data
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;
};
various initializations
handle.stopFlag ← FALSE;
do the work
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"];
handle.doTioga ← handle.tiogaOut^;
handle.doZip ← handle.zip^;
handle.doProof ← handle.proof^;
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.lead ← Val[handle.cmd.lead, 0];
handle.dim.lineHeight ← handle.dim.fontSize + handle.dim.lead;
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]]];
handle.tsOut.PutText["Reading:"];
WHILE ~handle.eof DO
IF handle.stopFlag THEN {handle.tsOut.PutText["input aborted, no output"]; GO TO done};
EnterItem[handle, FALSE ! IO.EndOfStream => EXIT];
IF handle.item.count MOD 50 = 0 THEN handle.tsOut.PutChar['.];
ENDLOOP;
handle.tsOut.PutText["Sorting:"];
SortEntries[handle, FALSE];
handle.tsOut.PutText["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]];
IF (i+1) MOD 50 = 0 THEN handle.tsOut.PutChar['.];
handle.item[i] ← NIL;
ENDLOOP;
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 {
handle.tsOut.PutText["Storing:"];
TiogaFileOps.Store[handle.root, oName]};
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, secondary: BOOL] = {
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];
extract zip
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;
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] = {
one should SkipWhitespace before calling (and check for eof)
prevCr: BOOLFALSE;
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];
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: ROPENIL] = {
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: BOOLFALSE;
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}];
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: BOOLTRUE;
k: CARDINAL ← 0;
lw: INT ← 0;
box.x ← 18 + h.col * LWidth;
box.y ← 10*72 - h.row*LHeight;
box.w ← LWidth - 27;
box.h ← IF h.row = 0 THEN 72 - 18 ELSE 72; -- don't write on top 1/4 inch of paper
compute number of lines
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: BOOLFALSE;
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 ~h.doProof AND first THEN {first ← FALSE; this ← MailingName[this]};
-- 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: BOOLFALSE;
last, title, first: ROPE;
find last name
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;
find title
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];
one could be a lot more clever, but this works quick enough
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]];
};
copied from IOSearchImpl because it didn't handle empty tokens as I wanted
GetToken: PROC [stream: STREAM, breakProc: IO.BreakProc, buffer: REF TEXT]
RETURNS[token: REF TEXT, charsSkipped: INT] = {
quit, include: BOOLFALSE;
anySeen: BOOLFALSE;
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];
};
copied from IOSearchImpl because I wanted a bigger scratch buffer
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];
};
Sort by various keys
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, secondary: BOOL] = {
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];
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, lead 0. 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
" ];
END.