SortLabels.mesa;
Last Edited by: Sweet, July 2, 1985 4:31:15 pm PDT
Last Edited by: Swinehart, May 9, 1985 10:53:33 am PDT
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
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 = 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𡤀]; -- 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,
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: 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,
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["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
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 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
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
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};
];
};
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"];
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];
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];
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;
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] = {
one should SkipWhitespace before calling (and check for eof)
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;
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
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: 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;
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: 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];
};
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] = {
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.