-- file:  IntHardcopyCom.Mesa
-- edited by Brotz, May 4, 1981  2:39 PM
-- edited by Schroeder, November 21, 1980  11:48 AM
-- edited by Levin, January 16, 1981  10:55 AM.

DIRECTORY
  Ascii,
  dsD: FROM "DisplayDefs",
  displayCommon: FROM "DisplayCommon",
  Editor,
  exD: FROM "ExceptionDefs",
  inD: FROM "InteractorDefs",
  intCommon: FROM "IntCommon",
  LaurelHardcopyDefs,
  lmD: FROM "LaurelMenuDefs",
  lsD: FROM "LaurelStateDefs",
  MailParse,
  opD: FROM "OperationsDefs",
  ovD: FROM "OverviewDefs",
  Storage,
  String,
  tsD: FROM "TOCSelectionDefs",
  vmD: FROM "VirtualMgrDefs";

IntHardcopyCom: PROGRAM
  IMPORTS disC: displayCommon, dsD, exD, inD, intC: intCommon, LaurelHardcopyDefs,
    lmD, lsD, MailParse, Storage, String, tsD, vmD
  EXPORTS inD, LaurelHardcopyDefs = PUBLIC

BEGIN
OPEN inD, LaurelHardcopyDefs;


AbortHardcopy: ERROR = CODE;

widthTable: WidthTable;  -- exported variable.
aborted: HardcopyAbortCode;  -- exported variable.


HardcopyCommand: CommandProcedure =
-- Calls HardcopyOperation with current mail file.
BEGIN
IF intC.hardcopyInstallError THEN
  BEGIN
  exD.DisplayException[exD.errorsDuringInstall];
  exD.DisplayExceptionLine[exD.hardcopyCanceled, 2];
  RETURN;
  END;
IF confirmed THEN
	BEGIN
	IF MessagesToPrint[] THEN
		BEGIN
		IndicateCommandBusy[hp];
		HardcopyOperation[];
		ResetHardcopyParameters[];
		END;
	IndicateCommandFinished[hp];
	IF CaretIsBlinking[] THEN SetCaretBlinking[intC.target.point, intC.target.mnp];
	END
ELSE BEGIN
	hp, h: HousePtr;
	cnp: CommandNbrPtr _ intC.tocCommandNbr;
	MakeCommandsCallable[FALSE];
	hp _ lmD.SwapInMenu[intC.hardcopyMenuSegment];
	intC.printerBracketsHouse _ lmD.MapHouseNumberToHousePtr
													[hp, 0, lmD.printerBracketsNumber];
	intC.printerBracketsHouse.text.length _ 0;
	String.AppendString[intC.printerBracketsHouse.text, intC.hardcopyHost];
	intC.copiesBracketsHouse _ lmD.MapHouseNumberToHousePtr
													[hp, 0, lmD.copiesBracketsNumber];
	intC.copiesBracketsHouse.text.length _ 0;
	String.AppendDecimal[intC.copiesBracketsHouse.text, intC.hardCopies];
	intC.duplexBracketsHouse _ lmD.MapHouseNumberToHousePtr
													[hp, 0, lmD.duplexBracketsNumber];
	intC.duplexBracketsHouse.text.length _ 0;
	String.AppendString[intC.duplexBracketsHouse.text,
								IF intC.twoSidedPrinting THEN "Yes"L ELSE "No"L];
	intC.formBracketsHouse _ lmD.MapHouseNumberToHousePtr
													[hp, 0, lmD.overrideFormBracketsNumber];
	intC.formBracketsHouse.text.length _ 0;
	h _ lmD.MapHouseNumberToHousePtr[hp, 0, lmD.passwordPrintingBracketsNumber];
	h.text.length _ 0;
	String.AppendString[h.text, IF intC.passwordPrinting THEN "Yes"L ELSE "No"L];
	cnp.houses _ hp;
	ChangeCommandMenu[cnp: cnp, region: intC.TOCCommandRegion, linesToKeep: 0];
	END;
END;  -- of HardcopyCommand --


ResetHardcopyParameters: PRIVATE PROCEDURE =
BEGIN
intC.hardCopies _ intC.defaultHardCopies;
intC.passwordPrinting _ intC.passwordPrintingDefault;
intC.twoSidedPrinting _ intC.twoSidedPrintingDefault;
END;  -- of ResetHardcopyParameters --


SetPrinterCommand: CommandProcedure =
-- Sets intC.hardcopyHost to contents of following brackets.
BEGIN
IF ConfirmBrackets[hp.nextHouse] THEN
	BEGIN
	Storage.FreeString[intC.hardcopyHost];
	intC.hardcopyHost _ Storage.String[hp.nextHouse.text.length];
	String.AppendString[intC.hardcopyHost, hp.nextHouse.text];
	END;
END;  -- of SetPrinterCommand --


SetCopiesCommand: CommandProcedure =
-- Sets intC.hardCopies to contents of following brackets.
BEGIN
IF ConfirmBrackets[hp.nextHouse] THEN
	BEGIN
	n: CARDINAL;
	n _ String.StringToDecimal[hp.nextHouse.text
			! String.InvalidNumber => GO TO BadInput];
	IF n IN [1 .. 99] THEN intC.hardCopies _ n ELSE GO TO BadInput;
	EXITS
	BadInput => BEGIN
		hp.nextHouse.text.length _ 0;
		String.AppendDecimal[hp.nextHouse.text, intC.hardCopies];
		hp.nextHouse.houseRefresher[hp.nextHouse];
		END;
	END;
END;  -- of SetCopiesCommand --


SetOverrideFormCommand: CommandProcedure =
-- Sets form to use for subsequent hardcopies to contents of following brackets.
BEGIN
newFormIndex: CARDINAL _ 0;
table: HardcopyFormTable _ intC.hardcopyFormTable;
text: STRING _ hp.nextHouse.text;
	BEGIN
	IF text.length = 0 THEN GO TO SetText;
	FOR newFormIndex IN [1 .. table.nForms) DO
		IF String.EquivalentString[text, table.formTable[newFormIndex - 1].name] THEN
			GO TO SetText;
		REPEAT
		FINISHED => text.length _ 0;
		ENDLOOP;
	EXITS
	SetText =>
		{text.length _ 0; String.AppendString[text, table.formTable[newFormIndex].name]};
	END;
hp.nextHouse.houseRefresher[hp.nextHouse];
END;  -- of SetOverrideFormCommand --


SetDuplexCommand: CommandProcedure =
-- Complements intC.twoSidedPrinting and Yes/No contents of following brackets.
BEGIN
ComplementYesOrNo[bool: @intC.twoSidedPrinting, hp: hp];
END;  -- of SetDuplexCommand --


SetPasswordProtectedCommand: CommandProcedure =
-- Complements intC.passwordPrinting and Yes/No contents of following brackets.
BEGIN
ComplementYesOrNo[bool: @intC.passwordPrinting, hp: hp];
END;  -- of SetPasswordProtectedCommand --


ComplementYesOrNo: PROCEDURE [bool: POINTER TO BOOLEAN, hp: HousePtr] =
-- Complements both bool^ and corresponding Yes/No contents of hp.nextHouse.text.
BEGIN
nextHouse: HousePtr = hp.nextHouse;
s: STRING = nextHouse.text;
bool^ _ ~bool^;
s.length _ 0;
String.AppendString[s, IF bool^ THEN "Yes"L ELSE "No"L];
nextHouse.houseRefresher[nextHouse];
END;  -- of ComplementYesOrNo --


HardcopyConfirmCommand: CommandProcedure =
-- Restores original command menu and continues hardcopy processing.
BEGIN
RestoreTocCommandMenu[];
HardcopyCommand[intC.hardcopyCommandHouse, TRUE];
END;  -- of HardcopyConfirmCommand --


HardcopyCancelCommand: CommandProcedure =
-- Cancels hardcopy processing and restores original command menu.
BEGIN
RestoreTocCommandMenu[];
ResetHardcopyParameters[];
IF CaretIsBlinking[] THEN SetCaretBlinking[intC.target.point, intC.target.mnp];
END;  -- of HardcopyCancelCommand --


RestoreTocCommandMenu: PROCEDURE =
BEGIN
cnp: CommandNbrPtr _ intC.tocCommandNbr;
lmD.ReleaseMenu[intC.hardcopyMenuSegment];
cnp.houses _ intC.displayCommandHouse;
ChangeCommandMenu[cnp: cnp, region: intC.TOCCommandRegion, linesToKeep: 0];
MakeCommandsCallable[TRUE];
END;  -- of RestoreTocCommandMenu --


MessagesToPrint: PROCEDURE RETURNS [canPrint: BOOLEAN] =
-- Returns TRUE iff there are selected messages to print.
BEGIN
fixedPart: vmD.TOCFixedPart;
i: vmD.TOCIndex;
canPrint _ FALSE;

IF ~intC.haveMailFile THEN {exD.DisplayException[exD.noCurrentFile]; RETURN[FALSE]};
IF tsD.TOCSelectionEmpty[] THEN
	{exD.DisplayException[exD.noSelectedEntries]; RETURN[FALSE]};

-- Check that there is at least one message to print.
FOR i _ tsD.FirstSelectedEntry[], tsD.NextSelectedEntry[i] UNTIL i = 0 DO
	vmD.GetTOCFixedPart[i, @fixedPart];
	IF ~fixedPart.deleted THEN RETURN[TRUE];
	REPEAT
	FINISHED => {exD.DisplayException[exD.noUndeletedEntries]; RETURN[FALSE]};
	ENDLOOP;
END;  -- of MessagesToPrint --


HardcopyOperation: PROCEDURE =
BEGIN
error: ovD.ErrorCode;
currentFont: CARDINAL;
currentY: Mica;
messageNumber: vmD.TOCIndex;
fixedPart: vmD.TOCFixedPart;
message: vmD.DisplayMessagePtr;
formSegment: lsD.StateSegment _ NIL;
form: HardcopyForm;
otherFieldName: STRING _ [MailParse.maxFieldNameSize];
lineBuffer: STRING _ [160];
messageLength, charIndex: ovD.CharIndex;
currentPage: CARDINAL;
diabloHardcopy: BOOLEAN = String.EquivalentString[intC.hardcopyHost, "Local"L];
parsable: BOOLEAN;
havePageOpen: BOOLEAN _ FALSE;
lineSegmentTable: LineSegmentTable;

-- many local procedures follow

InitPage: PROCEDURE =
	-- Initializes output of a press page.
	BEGIN
	totalPages _ totalPages + 1;
	totalPagesString.length _ 0;
	String.AppendDecimal[totalPagesString, totalPages];
	dsD.ClearRectangle[totalPagesLeftX, totalPagesRightX, totalPagesTopY, totalPagesBottomY];
	[] _ dsD.PutStringInBitMap[totalPagesRightX - totalPagesString.length * inD.digitWidth,
									totalPagesTopY, totalPagesString, plainFace];
	IF diabloHardcopy THEN {NewDiabloPage[]; exD.DisplayExceptionLine[exD.printing, 2]}
	ELSE InitPressPage[];
	havePageOpen _ TRUE;
	currentY _ form.top;
	SetCurrentFont[0];
	fileSent _ FALSE;
	PrintOptions[];
	END; -- of InitPage --


InitMessageProcessing: PROCEDURE =
	BEGIN
	messageLength _ vmD.GetMessageSize[message];
	form _ GetHardcopyForm[];
	IF ~diabloHardcopy AND intC.twoSidedPrinting AND totalPages MOD 2 = 1
		AND form.startOnNewPage THEN
		BEGIN
		IF havePageOpen THEN FlushPage[FALSE];
		InitPressPage[];
		FinishPressPage[];
		totalPages _ totalPages + 1;
		END;
	IF form.startOnNewPage OR ~havePageOpen THEN
		BEGIN
		IF havePageOpen THEN FlushPage[FALSE];
		currentPage _ 1;
		InitPage[];
		END;
	END; -- of InitMessageProcessing --


PrintMessage: PROCEDURE =
	BEGIN
	rowRelPtr: RowRelPtr;
	row: Row;
	InitMessageProcessing[];
	FOR rowRelPtr _ form.rows, row.nextRow UNTIL rowRelPtr = RowNIL DO
		row _ @form[rowRelPtr];
		PrintRow[row];
		ENDLOOP;
	FinishMessageProcessing[];
	END; -- of PrintMessage --


PrintRow: PROCEDURE [row: Row] =
	BEGIN
	columnRelPtr: ColumnRelPtr;
	column: Column;
	rowPrinted, printed, rowFinished, finished, firstLine: BOOLEAN;
	lineHeight: Mica _ 0;
	savedCurrentY: Mica _ currentY;
	rowLeading: Mica _ row.rowLeading;
	lineLeading: Mica _ row.lineLeading;

	-- Initialize line height and start, end points for each column
	FOR columnRelPtr _ row.columns, column.nextColumn
		UNTIL columnRelPtr = ColumnNIL DO
		column _ @form[columnRelPtr];
		column.start _ column.end _ 0;
		lineHeight _ MAX[lineHeight, widthTable[column.font][0C]];
		IF column.columnType = field THEN
			lineHeight _ MAX[lineHeight, widthTable
				[WITH c: column SELECT FROM field => c.fieldFont, ENDCASE => 0][0C]];
		ENDLOOP;
	IF diabloHardcopy THEN
		BEGIN
		rowLeading _ (rowLeading / micasPerDiabloY) * micasPerDiabloY;
		lineLeading _ (lineLeading / micasPerDiabloY) * micasPerDiabloY;
		lineHeight _ (lineHeight / micasPerDiabloY) * micasPerDiabloY;
		END;
	currentY _ currentY - rowLeading;
	IF row.verticalTab # 0 THEN currentY _ MIN[currentY, row.verticalTab];
	currentY _ currentY - lineHeight;
	IF currentY < form.bottom THEN
		BEGIN
		savedCurrentY _ form.top;
		FlushPage[];
		currentY _ currentY - lineHeight;
		END;
	firstLine _ TRUE;
	rowPrinted _ FALSE;
	DO  -- for each line to be printed in the row.
		rowFinished _ TRUE;
		FOR columnRelPtr _ row.columns, column.nextColumn
			UNTIL columnRelPtr = ColumnNIL DO
			column _ @form[columnRelPtr];
			[printed, finished] _ PrintLineOfColumn[column, firstLine];
			rowPrinted _ rowPrinted OR printed;
			rowFinished _ rowFinished AND finished;
			ENDLOOP;
		IF ~rowPrinted THEN
			BEGIN
			currentY _ savedCurrentY;
			EXIT;
			END;
		firstLine _ FALSE;
		IF rowFinished THEN RETURN
		ELSE BEGIN
			currentY _ currentY - lineHeight - lineLeading;
			IF currentY < form.bottom THEN
				BEGIN
				FlushPage[];
				currentY _ currentY - lineHeight - lineLeading;
				END;
			END;
		ENDLOOP;
	END; -- of PrintRow --


PrintLineOfColumn: PROCEDURE [column: Column, firstLine: BOOLEAN]
		RETURNS [printed, finished: BOOLEAN] =
	-- Formats and prints one line of a column, beginning at the CharIndex at the CharIndex
	--   at which printing stopped the last time this procedure was called on this column.
	BEGIN
	WITH c: column SELECT FROM
		field =>
			WITH fc: c SELECT FROM
				specific => [printed, finished] _ PrintLineOfSpecificField[@fc, firstLine];
				other => [printed, finished] _ PrintLineOfOtherFields[@fc, firstLine];
				ENDCASE => exD.SysBug[];
		caption => BEGIN
				PrintString[@form[c.text], c.font, c.left, currentY, FALSE];
				printed _ finished _ TRUE;
				END;
		body => [printed, finished] _ PrintLineOfBody[@c, firstLine];
		everything => [printed, finished] _ PrintLineOfEverything[@c, firstLine];
		ENDCASE => exD.SysBug[];
	END;  -- of PrintLineOfColumn --


PrintLineOfSpecificField: PROCEDURE [sfc: POINTER TO specific field ColumnRec,
		firstLine: BOOLEAN] RETURNS [printed, finished: BOOLEAN] =
	BEGIN
	fieldName: STRING _ @form[form[form.fieldTable][sfc.fieldIndex]];
	aliasFieldName: STRING _ IF sfc.aliasFieldIndex = LAST[CARDINAL] THEN NIL
									ELSE @form[form[form.fieldTable][sfc.aliasFieldIndex]];
	foundField: BOOLEAN;
	left: Mica;
	IF sfc.suppress THEN RETURN[FALSE, TRUE];
	IF firstLine THEN
		BEGIN
		[foundField, sfc.start, sfc.end] _ SetUpField[fieldName, aliasFieldName, 0];
		IF sfc.required OR foundField THEN
			BEGIN
			IF sfc.printFieldName THEN
				BEGIN
				PrintString[fieldName, sfc.fieldFont, sfc.left, currentY, FALSE];
				left _ sfc.left + PrintWidth[fieldName, sfc.fieldFont];
				IF sfc.colonAfterFieldName THEN
					PrintString[":"L, sfc.fieldFont, left, currentY, FALSE];
				left _ MIN[MAX[left + postColonSpacing, sfc.textLeft], sfc.right];
				END
			ELSE left _ sfc.left;
			IF sfc.fieldNameAbove THEN RETURN[TRUE, ~foundField];
			END
		ELSE RETURN[FALSE, TRUE];
		END
	ELSE BEGIN
		IF sfc.start = sfc.end THEN RETURN[FALSE, TRUE]
		ELSE left _ sfc.textLeft;
		END;
	sfc.start _ GetLineOfText
		[sfc.start, sfc.end, left, sfc.right, sfc.font, sfc.breakOnComma];
	PrintString[lineBuffer, sfc.font, left, currentY, TRUE];
	IF sfc.start = sfc.end THEN
		BEGIN
		[foundField, sfc.start, sfc.end] _ SetUpField[fieldName, aliasFieldName, sfc.start];
		RETURN[TRUE, ~foundField];
		END
	ELSE RETURN[TRUE, FALSE];
	END;  -- of PrintLineOfSpecificField --


PrintLineOfOtherFields: PROCEDURE  [ofc: POINTER TO other field ColumnRec,
		firstLine: BOOLEAN] RETURNS [printed, finished: BOOLEAN] =
	BEGIN
	left: Mica;
	IF firstLine THEN
		BEGIN
		IF ~SetUpOtherField[ofc] THEN RETURN[FALSE, TRUE]
		ELSE ofc.newField _ TRUE;
		END;
	IF ofc.newField THEN
		BEGIN
		ofc.newField _ FALSE;
		PrintString[otherFieldName, ofc.fieldFont, ofc.left, currentY, FALSE];
		left _ ofc.left + PrintWidth[otherFieldName, ofc.fieldFont];
		IF ofc.colonAfterFieldName THEN
			PrintString[":"L, ofc.fieldFont, left, currentY, FALSE];
		left _ MIN[MAX[left + postColonSpacing, ofc.textLeft], ofc.right];
		IF ofc.fieldNameAbove THEN RETURN[TRUE, FALSE];
		END
	ELSE left _ ofc.textLeft;
	ofc.start _ GetLineOfText[ofc.start, ofc.end, left, ofc.right, ofc.font, FALSE];
	PrintString[lineBuffer, ofc.font, left, currentY, TRUE];
	IF ofc.start = ofc.end THEN
		BEGIN
		IF SetUpOtherField[ofc] THEN 
			BEGIN
			fieldLeading: Mica _ ofc.fieldLeading;
			IF diabloHardcopy THEN
				fieldLeading _ (fieldLeading / micasPerDiabloY) * micasPerDiabloY;
			currentY _ currentY - fieldLeading;
			ofc.newField _ TRUE;
			RETURN[TRUE, FALSE];
			END
		ELSE RETURN[TRUE, TRUE];
		END
	ELSE RETURN[TRUE, FALSE];
	END;  -- of PrintLineOfOtherFields --


PrintLineOfBody: PROCEDURE [column: POINTER TO body ColumnRec,
		firstLine: BOOLEAN] RETURNS [printed, finished: BOOLEAN] =
	BEGIN
	dummyString: STRING _ [0];
	IF firstLine THEN
		BEGIN
		-- find message start.
		charIndex _ 0;
		IF parsable THEN
			BEGIN
			pH: MailParse.ParseHandle = MailParse.InitializeParse[NextChar, BackupChar];
			DO
				IF ~MailParse.GetFieldName[pH, dummyString] THEN EXIT;
				MailParse.GetFieldBody[pH, dummyString];
				ENDLOOP;
			MailParse.FinalizeParse[pH];
			END;
		column.start _ charIndex;
		column.end _ messageLength;
		END;
	column.start _ GetLineOfText
		[column.start, column.end, column.left, column.right, column.font, FALSE];
	PrintString[lineBuffer, column.font, column.left, currentY, TRUE];
	RETURN[TRUE, (column.start >= column.end)];
	END;  -- of PrintLineOfBody --


PrintLineOfEverything: PROCEDURE [column: POINTER TO everything ColumnRec,
		firstLine: BOOLEAN] RETURNS [printed, finished: BOOLEAN] =
	BEGIN
	IF firstLine THEN {column.start _ 0; column.end _ messageLength};
	column.start _ GetLineOfText
		[column.start, column.end, column.left, column.right, column.font, FALSE];
	PrintString[lineBuffer, column.font, column.left, currentY, TRUE];
	RETURN[TRUE, (column.start >= column.end)];
	END;  -- of PrintLineOfEverything --


SetUpField: PROCEDURE [fieldName, aliasFieldName: STRING, searchStart: ovD.CharIndex]
		RETURNS [foundField: BOOLEAN, start, end: ovD.CharIndex] =
	-- Starting at column.start, search for fieldName or, if non-NIL, aliasFieldName.  If
	--   found, set column.start, column.end with range of CharIndexes covered by the field
	--   value.
	BEGIN
	messageField: STRING _ [MailParse.maxFieldNameSize];
	pH: MailParse.ParseHandle;
	charIndex _ searchStart;
	pH _ MailParse.InitializeParse[NextChar, BackupChar];
	foundField _ FALSE;
	start _ end _ 0;
	DO
		IF ~MailParse.GetFieldName[pH, messageField ! MailParse.ParseError => EXIT]
			THEN EXIT;
		IF String.EquivalentString[fieldName, messageField]
			OR (aliasFieldName # NIL
				AND String.EquivalentString[aliasFieldName, messageField])
			THEN BEGIN
			SkipWhiteSpace[];
			start _ charIndex;
			MailParse.GetFieldBody[pH, messageField
						! MailParse.ParseError => {start _ 0; EXIT}];
			end _ charIndex;
			foundField _ TRUE;
			EXIT;
			END
		ELSE MailParse.GetFieldBody[pH, messageField ! MailParse.ParseError => EXIT];
		ENDLOOP;
	MailParse.FinalizeParse[pH];
	END;  -- of SetUpField --


SetUpOtherField: PROCEDURE [column: Column] RETURNS [foundField: BOOLEAN] =
	-- Starting at column.start, search for a field name other than one listed in the field
	--   table.  If found, set column.start, column.end with range of CharIndexes covered
	--   by the field value.
	BEGIN
	pH: MailParse.ParseHandle;
	fieldIndex: CARDINAL;
	otherField: BOOLEAN;
	fieldBody: STRING _ [4];  -- Most chars will be thrown away; we are only interested
					--  in the field body's length.
	foundField _ FALSE;
	IF ~parsable THEN RETURN;
	charIndex _ column.start;
	pH _ MailParse.InitializeParse[NextChar, BackupChar];
	DO
		IF ~MailParse.GetFieldName[pH, otherFieldName ! MailParse.ParseError => EXIT]
			THEN EXIT;
		otherField _ TRUE;
		FOR fieldIndex IN [0 .. form.nFields) DO
			IF String.EquivalentString[@form[form[form.fieldTable][fieldIndex]],
												otherFieldName]
				THEN {otherField _ FALSE; EXIT};
			ENDLOOP;
		SkipWhiteSpace[];
		column.start _ charIndex;
		MailParse.GetFieldBody[pH, fieldBody ! MailParse.ParseError => EXIT];
		column.end _ charIndex;
		IF otherField THEN {foundField _ TRUE; EXIT};
		ENDLOOP;
	MailParse.FinalizeParse[pH];
	END;  -- of SetUpOtherField --


GetHardcopyForm: PROCEDURE RETURNS [HardcopyForm] =
	BEGIN
    pH: MailParse.ParseHandle;
	formName: STRING _ [25];
	dummy: STRING _ [0];
	fieldName: STRING _ [20];
	blank: STRING _ "Blank"L;
	override: STRING = intC.formBracketsHouse.text;

	FindFormSegment: PROCEDURE [formName: STRING] =
		BEGIN
		i: CARDINAL;
		table: HardcopyFormTable _ intC.hardcopyFormTable;
		FOR i IN [0 .. table.nForms) DO
			IF String.EquivalentString[table.formTable[i].name, formName] THEN
				{formSegment _ table.formTable[i].segment; RETURN};
			ENDLOOP;
		END;  -- of FindFormSegment --

	parsable _ TRUE;
	charIndex _ 0;
	pH _ MailParse.InitializeParse[NextChar, BackupChar];
	DO
		IF ~MailParse.GetFieldName[pH, fieldName
                ! MailParse.ParseError => GO TO NotParsable]
			THEN EXIT;
		IF String.EquivalentString[fieldName, "PrintForm"L] THEN
			BEGIN
			SkipWhiteSpace[];
			MailParse.GetFieldBody[pH, formName
                ! MailParse.ParseError => GO TO NotParsable];
			END
		ELSE MailParse.GetFieldBody[pH, dummy
                ! MailParse.ParseError => GO TO NotParsable];
		REPEAT
		NotParsable => parsable _ FALSE;
		ENDLOOP;
	MailParse.FinalizeParse[pH];
	IF diabloHardcopy THEN formName _ "HyType"L;
	IF ~parsable THEN formName _ blank;
	IF override # NIL AND override.length > 0 THEN FindFormSegment[override];
	IF formSegment = NIL AND formName.length > 0 THEN FindFormSegment[formName];
	IF formSegment = NIL THEN FindFormSegment[intC.defaultHardcopyFormName];
	IF formSegment = NIL THEN FindFormSegment[blank];  -- must be found --
	RETURN[lsD.SwapInStateSegment[formSegment]]
	END;  -- of GetHardcopyForm --


NextChar: PROCEDURE RETURNS [c: CHARACTER] =
	BEGIN
	c _ IF charIndex >= messageLength THEN 0C
			ELSE vmD.GetMessageChar[message, charIndex];
	charIndex _ charIndex + 1;
	END; -- of NextChar --


BackupChar: PROCEDURE =
	BEGIN
	charIndex _ charIndex - 1;
	END; -- of BackupChar --


FinishMessageProcessing: PROCEDURE =
	BEGIN
	lsD.ReleaseStateSegment[formSegment];
	formSegment _ NIL;
	END; -- of FinishMessageProcessing --


PrintOptions: PROCEDURE =
	BEGIN
	option: Option;
	optionRelPtr: OptionRelPtr;
	FOR optionRelPtr _ form.options, option.nextOption UNTIL optionRelPtr = OptionNIL DO
		option _ @form[optionRelPtr];
		WITH opt: option SELECT FROM
			heading => PrintHeadingOption[@opt];
			caption => PrintCaptionOption[@opt];
			pageNumber => PrintPageNumberOption[@opt];
			ENDCASE => exD.SysBug[];
		ENDLOOP;
	END; -- of PrintOptions --


PrintHeadingOption: PROCEDURE [option: POINTER TO heading OptionRec] =
	BEGIN
	IF ~parsable THEN RETURN;
	IF currentPage = 1 THEN
		[ , option.start, option.end] _ SetUpField[@form[option.fieldName], NIL, 0];
	IF (currentPage = 1) = option.onFirstPage THEN
		BEGIN
		[] _ GetLineOfText
			[option.start, option.end, option.x, option.right, option.font, FALSE];
		PrintString[lineBuffer, option.font, option.x, option.y, TRUE];
		END;
	END; -- of PrintHeadingOption --


PrintCaptionOption: PROCEDURE [option: POINTER TO caption OptionRec] =
	BEGIN
	IF (currentPage = 1) = option.onFirstPage THEN
		PrintString[@form[option.text], option.font, option.x, option.y, FALSE];
	END; -- of PrintCaptionOption --


PrintPageNumberOption: PROCEDURE [option: POINTER TO pageNumber OptionRec] =
	BEGIN
	pageNumberString: STRING _ [5];
	IF (currentPage = 1) = option.onFirstPage THEN
		BEGIN
		String.AppendDecimal[pageNumberString, currentPage];
		PrintString[pageNumberString, option.font,
					option.x - pageNumberString.length * widthTable[option.font]['0],
					option.y, FALSE];
		END;
	END; -- of PrintPageNumberOption --


PrintWidth: PROCEDURE [s: STRING, font: FontNumber] RETURNS [width: Mica] =
	BEGIN
	i: CARDINAL;
	charWidth: Mica;
	width _ 0;
	FOR i IN [0 .. s.length) DO
		IF (charWidth _ widthTable[font][s[i]])  # magicNonPrintingWidth THEN
			width _ width + charWidth;
		ENDLOOP;
	END;  -- of PrintWidth --


FlushPage: PROCEDURE[startNewPage: BOOLEAN _ TRUE] =
	BEGIN
	IF diabloHardcopy THEN FinishDiabloPage[] ELSE FinishPressPage[];
	havePageOpen _ FALSE;
	CheckForAbort[];
	IF ~diabloHardcopy AND (~intC.twoSidedPrinting OR totalPages MOD 2 = 0)
		AND TimeToSend[] THEN
		BEGIN
		FinishPressFile[nChunks _ nChunks + 1];
		SendPressFile[];
		CheckForAbort[];
		fileSent _ TRUE;
		exD.DisplayExceptionStringOnLine[formattingMessage, 1];
		END;
	IF startNewPage THEN {currentPage _ currentPage + 1; InitPage[]};
	END; -- of FlushPage --


SkipWhiteSpace: PROCEDURE =
	BEGIN
	c: CHARACTER;
	DO
		c _ NextChar[];
		IF c # Ascii.SP AND c # Ascii.TAB THEN EXIT;
		ENDLOOP;
	charIndex _ charIndex - 1;
	END; -- of SkipWhiteSpace --


GetLineOfText: PROCEDURE [start, end: ovD.CharIndex, left, right: Mica, font: FontNumber,
    breakOnComma: BOOLEAN] RETURNS [i: ovD.CharIndex] =
  BEGIN
  screenTabWidth: CARDINAL = 40;  -- in terms of Alto bitmap points.
  hardcopyTabWidth: Mica = widthTable[font]['0] * 15 / 2;
  si: CARDINAL _ 0;
  char: CHARACTER;
  curX: Mica _ left;
  screenX: dsD.ScreenXCoord _ inD.leftMargin;
  lineSegmentTableIndex: CARDINAL _ 0;
  charWidth, newPageX: Mica;
  lineBuffer.length _ 0;
  lineSegmentTable[0] _ [index: 0, x: left];
  FOR i _ start, i + 1 UNTIL i >= end DO
    IF (char _ vmD.GetMessageChar[message, i]) = Ascii.CR THEN {i _ i + 1; EXIT};
    IF breakOnComma AND char = ', THEN
      BEGIN
      i _ i + 1;
      UNTIL i >= end DO
        IF ~dsD.GetCharProperty[vmD.GetMessageChar[message, i], white] THEN EXIT;
        i _ i + 1;
        REPEAT
        FINISHED => i _ end;
        ENDLOOP;
      EXIT;
      END;
    charWidth _ widthTable[font][char];
    screenX _ dsD.GetCharRightX[char, screenX];
    IF char = Ascii.TAB THEN
      BEGIN
      newPageX
        _ form.left + hardcopyTabWidth * ((screenX - inD.leftMargin) / screenTabWidth);
      SELECT newPageX FROM
        > right => {i _ MIN[i + 1, end]; EXIT};
        > curX =>
          BEGIN
          lineSegmentTable[(lineSegmentTableIndex _ lineSegmentTableIndex + 1)]
            _ [index: si, x: (curX _ newPageX)];
          LOOP;
          END;
        ENDCASE => char _ Ascii.SP;
      END;
    curX _ curX + (IF charWidth = magicNonPrintingWidth THEN 0 ELSE charWidth);
    IF curX > right THEN
      BEGIN
      savedI: CARDINAL _ i;
      savedSi: CARDINAL _ si;
      FOR si DECREASING IN [lineSegmentTable[lineSegmentTableIndex].index .. si) DO
        IF lineBuffer[si] = Ascii.SP THEN EXIT;
        i _ i - 1;
        REPEAT
        FINISHED =>
          BEGIN
          IF lineSegmentTableIndex = 0 THEN {i _ savedI; si _ savedSi}
          ELSE si _ lineSegmentTable[lineSegmentTableIndex].index;
          EXIT;
          END;
        ENDLOOP;
      EXIT;
      END
    ELSE IF si < lineBuffer.maxlength THEN {lineBuffer[si] _ char; si _ si + 1};
    ENDLOOP;
  lineBuffer.length _ si;
  lineSegmentTable[lineSegmentTableIndex + 1] _ [index: si, x: 0];
  IF i = start THEN i _ end;  -- Flush this field if first character doesn't fit.
  END; -- of GetLineOfText --


PrintString: PROCEDURE [string: STRING, fontNumber: CARDINAL, x, y: Mica,
	useTable: BOOLEAN] =
	BEGIN
	IF string.length = 0 THEN RETURN;
	IF currentFont ~= fontNumber THEN SetCurrentFont[fontNumber];
	IF diabloHardcopy THEN PrintDiabloString
		[string, fontNumber, x, y, IF useTable THEN @lineSegmentTable ELSE NIL]
	ELSE PrintPressString
		[string, fontNumber, x, y, IF useTable THEN @lineSegmentTable ELSE NIL];
	END; -- of PrintString --


SetCurrentFont: PROCEDURE [font: FontNumber] =
	BEGIN
	currentFont _ font;
	IF ~diabloHardcopy THEN SetCurrentPressFont[font];
	END;  -- of SetCurrentFont --


-- ************************
-- Main Body of HardcopyOperation
-- ************************


formattingMessage: STRING = "Formatting page     ."L;
nChunks, totalPages: CARDINAL _ 0;
totalPagesString: STRING _ [4];
totalPagesRightX: ScreenXCoord _
	inD.leftMargin + dsD.GetStringWidth[formattingMessage, plainFace]
		- dsD.GetStaticCharWidth['.];
totalPagesLeftX: ScreenXCoord _ totalPagesRightX - dsD.GetStringWidth["     "L, plainFace];
totalPagesTopY: ScreenYCoord _ intC.exceptionsRegion.topY + dsD.lineHeight;
totalPagesBottomY: ScreenYCoord _ totalPagesTopY + dsD.lineHeight;
completedMessage: STRING _ [60];
summaryMessage: STRING _ [35];
fileSent: BOOLEAN _ TRUE;

error _ ovD.ok;
aborted _ no;
IF ~diabloHardcopy AND FindPrinter[] # ovD.ok THEN RETURN;

widthTable _ lsD.SwapInStateSegment[intC.hardcopyWidthTableSegment];

IF ~diabloHardcopy THEN OpenPressStreams[];
message _ vmD.AllocateDisplayMessageObject[];
exD.DisplayBothExceptionLines[formattingMessage, exD.nil, NIL, exD.cancelHardcopy,
	FALSE];

-- Main Loop --

FOR messageNumber _ tsD.FirstSelectedEntry[], tsD.NextSelectedEntry[messageNumber]
	UNTIL messageNumber = 0 DO
	vmD.GetTOCFixedPart[messageNumber, @fixedPart];
	IF ~fixedPart.deleted THEN
		BEGIN
		IF (error _ vmD.VirtualizeMessage[messageNumber, message]) ~= ovD.ok THEN EXIT;
		PrintMessage[ ! AbortHardcopy => EXIT];
		END;
	REPEAT
		FINISHED =>
			BEGIN
			IF havePageOpen THEN FlushPage[FALSE ! AbortHardcopy => CONTINUE];
			IF aborted = no AND ~diabloHardcopy AND ~fileSent THEN
				BEGIN
				FinishPressFile[nChunks _ nChunks + 1];
				SendPressFile[ ! AbortHardcopy => CONTINUE];
				END;
			END;
	ENDLOOP;

-- Cleanup

vmD.FreeVirtualMessageObject[message];
IF ~diabloHardcopy THEN ClosePressStreams[];
lsD.ReleaseStateSegment[intC.hardcopyWidthTableSegment];
IF formSegment # NIL THEN lsD.ReleaseStateSegment[formSegment];

SELECT error FROM
	ovD.ok =>
		SELECT aborted FROM
			no =>
				BEGIN
				OPEN String;
				IF diabloHardcopy THEN
					BEGIN
					exD.ClearExceptionsRegion[];
					exD.DisplayExceptionLine[exD.hardcopyCompleted, 1];
					RETURN;
					END;
				exD.GetExceptionString[exD.hardcopyTo, completedMessage];
				AppendString[completedMessage, intC.hardcopyHost];
				exD.AppendExceptionString[exD.completed, completedMessage];
				summaryMessage.length _ 0;
				IF totalPages = 1 THEN
					exD.GetExceptionString[exD.onePagePrinted, summaryMessage]
				ELSE BEGIN
					AppendString[summaryMessage, totalPagesString];
					exD.AppendExceptionString[exD.pagesPrinted, summaryMessage];
					END;
				IF nChunks > 1 THEN
					BEGIN
					AppendString[summaryMessage, " in "L];
					AppendDecimal[summaryMessage, nChunks];
					AppendString[summaryMessage, " parts"L];
					END;
				AppendChar[summaryMessage, '.];
				exD.DisplayBothExceptionLines[completedMessage, exD.nil, summaryMessage,
					exD.nil, FALSE];
				END;
			user => exD.DisplayBothExceptionLines[NIL, exD.hardcopyCanceled, NIL, exD.nil,
					FALSE];
			ENDCASE;
	ENDCASE => exD.DisplayBothExceptionLines[NIL, exD.internalError, NIL,
			exD.hardcopyCanceled];
END;  -- of HardcopyOperation --


CheckForAbort: PROCEDURE =
-- Checks keystream for cancel character (DEL or CANCEL).  Raises AbortHardcopy error if
--   cancel character is seen.  Flushes any other characters.
BEGIN
char: CHARACTER;
UNTIL intC.keystream.endof[intC.keystream] DO
	IF (char _ intC.keystream.get[intC.keystream]) = Ascii.DEL OR char = Editor.cancelCode
		THEN {aborted _ user; ERROR AbortHardcopy};
	ENDLOOP;
END; -- of CheckForAbort --


END.  -- of IntHardcopyCom --z20461x0(635)\f1