IPrint.mesa
Edited by:
Michael Plass, March 6, 1984 9:27:41 am PST
Doug Wyatt, March 12, 1984 1:28:23 pm PST
Improvements that would be nice:
1. allow several files to be printed with a single command.
2. recognize node formats that have extra lead in front (e.g. unit in Cedar.style), and insert a blank line.
3. Some form of synchronization with Tioga Save button (like the Compile command).
DIRECTORY
Ascii USING [Lower],
Commander USING [CommandProc, Handle, Register],
CommandTool USING [ArgumentVector, Failed, Parse],
Convert USING [AppendInt, Error, IntFromRope],
FS USING [Close, ComponentPositions, Create, Delete, ExpandName, Error, ErrorDesc, ErrorFromStream, FileInfo, GetInfo, GetName, nullOpenFile, Open, OpenFile, StreamFromOpenFile],
IPOutput USING [BeginMasterFromStream, BeginPage, BeginPreamble, Concat, ConcatT, EndMaster, EndPage, EndPreamble, FGet, FSet, Master, Rotate, ScaleT, SetFont, SetupFont, SetXY, Show, Translate],
IO USING [Backup, Close, CR, EndOfStream, Error, FF, GetChar, GetLength, int, PutChar, PutF, PutFR, PutRope, rope, SP, STREAM, TAB, time],
IOClasses USING [CreatePipe],
PutGet USING [FromFileC, FromFileError],
PutGetExtras USING [WritePlain],
RefText USING [AppendChar, AppendRope, New, TrustTextAsRope],
Rope USING [Cat, Concat, Fetch, Find, IsEmpty, Length, ROPE, Substr],
TEditInput USING [FreeTree],
TEditProfile USING [sourceExtensions],
TextNode USING [Ref],
UserProfile USING [Token];
IPrint:
CEDAR
PROGRAM
IMPORTS Ascii, Commander, CommandTool, Convert, FS, IPOutput, IO, IOClasses, PutGet, PutGetExtras, RefText, Rope, TEditInput, TEditProfile, UserProfile
= BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Master: TYPE ~ IPOutput.Master;
WritePreamble:
PROC[master: Master] ~ {
master.BeginPreamble[];
master.SetupFont[n: 0, name: "Xerox/PressFonts/Gacha/MRR", scale: 282]; -- 8 point Gacha
master.SetupFont[n: 1, name: "Xerox/PressFonts/Gacha/MRR", scale: 212]; -- 6 point Gacha
master.Translate[-110*254/2, -85*254/2];
master.Rotate[90];
master.Concat[];
master.Translate[85*254/2, 110*254/2];
master.Concat[];
master.FSet[11]; -- transformation to rotate the page by 90 degrees
master.EndPreamble[];
};
SetGacha:
PROC[master: Master, size:
NAT] ~ {
master.SetFont[SELECT size FROM 8 => 0, 6 => 1 ENDCASE => ERROR];
};
WritePageBeginning:
PROC[master: Master] ~ {
master.BeginPage[]; master.ScaleT[0.00001];
};
WriteLandscapeTransformation:
PROC[master: Master] ~ {
master.FGet[11]; master.ConcatT[];
};
WritePageEnding:
PROC[master: Master] ~ {
master.EndPage[];
};
InterpressFromText:
PROC [text:
--input--
STREAM, interpress:
--output--
STREAM, landscape:
BOOL,
fileNameForLeaderPage: --only first 49 chars will show-- ROPE,
fileNameForHeading: --approximately first 90 chars will show-- ROPE]
RETURNS [interpressPages: INT] = {
-- ! IO.Error [$Failure] (FS errors)
-- Does not close text or interpress streams.
columnsPerPage: [1 .. 2];
maxCharsPerLine, maxLinesPerColumn: NAT;
xCoordinateOfLeftEdge, columnOffset, yCoordinateOfHeadingBaseline, yCoordinateOfFirstBaseline, deltaYCoordinateBetweenLines: Micas;
pageStarted: BOOLEAN ← FALSE;
ipMaster: Master ~ IPOutput.BeginMasterFromStream[interpress];
WritePreamble[ipMaster];
{
-- Initialize parameters that depend upon the landscape switch
ComputeColumnParms:
PROC [topMargin, bottomMargin, leftMargin,
pageHeight, columnWidthForText, charWidth, deltaYCoordinateBetweenLines: Micas]
RETURNS [maxCharsPerLine, maxLinesPerColumn: NAT,
xCoordinateOfLeftEdge, yCoordinateOfFirstBaseline: Micas] = {
xCoordinateOfLeftEdge ← leftMargin;
yCoordinateOfFirstBaseline ← pageHeight - topMargin;
maxLinesPerColumn ←
(yCoordinateOfFirstBaseline-bottomMargin) / deltaYCoordinateBetweenLines;
maxCharsPerLine ← columnWidthForText / charWidth;
};
IF landscape
THEN {
columnsPerPage ← 2;
columnOffset ← 13335;
deltaYCoordinateBetweenLines ← 254;
[maxCharsPerLine, maxLinesPerColumn,
xCoordinateOfLeftEdge, yCoordinateOfFirstBaseline] ←
ComputeColumnParms[
topMargin: 1905, bottomMargin: 1905, leftMargin: 1270,
pageHeight: 21590, columnWidthForText: 12065,
charWidth: 129, deltaYCoordinateBetweenLines: deltaYCoordinateBetweenLines];
yCoordinateOfHeadingBaseline ← 952;
}
ELSE {
columnsPerPage ← 1;
columnOffset ← 0;
deltaYCoordinateBetweenLines ← 338;
[maxCharsPerLine, maxLinesPerColumn,
xCoordinateOfLeftEdge, yCoordinateOfFirstBaseline] ←
ComputeColumnParms[
topMargin: 2581, bottomMargin: 1270, leftMargin: 1905,
pageHeight: 27940, columnWidthForText: 18415,
charWidth: 173, deltaYCoordinateBetweenLines: deltaYCoordinateBetweenLines];
yCoordinateOfHeadingBaseline ← 26035;
}
};
{
column: INT;
xCoordinateOfColumnLeftEdge: Micas;
headingBuffer: REF TEXT ← RefText.New[maxCharsPerLine];
PrintHeading:
PROC [] = {
-- Uses headingBuffer, column, columnsPerPage, fileNameForHeading, xCoordinateOfColumnLeftEdge, yCoordinateOfHeadingBaseline, and ipMaster.
headingBuffer.length ← 0;
IF (column-1)
MOD columnsPerPage = 0
THEN {
-- First column of page
start: INT ← fileNameForHeading.Length[] - (maxCharsPerLine-11);
IF start > 0
THEN {
headingBuffer ← RefText.AppendRope[to: headingBuffer, from: "..."];
start ← start + 3;
}
ELSE start ← 0;
headingBuffer ← RefText.AppendRope[to: headingBuffer, from: fileNameForHeading, start: start];
};
FOR i:
NAT
IN [headingBuffer.length .. maxCharsPerLine-11)
DO
headingBuffer ← RefText.AppendChar[to: headingBuffer, from: IO.SP];
ENDLOOP;
headingBuffer ← RefText.AppendRope[to: headingBuffer, from: " Page "];
headingBuffer ← Convert.AppendInt[to: headingBuffer, from: column];
ipMaster.SetXY[xCoordinateOfColumnLeftEdge, yCoordinateOfHeadingBaseline];
ipMaster.Show[RefText.TrustTextAsRope[headingBuffer]];
};
indent: BOOL ← FALSE;
indentChars: NAT ← 0;
lineBuffer: REF TEXT = RefText.New[maxCharsPerLine+1];
PrintColumn:
PROC []
RETURNS [eof:
BOOL] = {
-- Uses indent, indentChars, text, ipMaster, PrintHeading, maxCharsPerLine, maxLinesPerColumn, xCoordinateOfColumnLeftEdge, yCoordinateOfFirstBaseline, deltaYCoordinateBetweenLines, pageStarted, landscape, and lineBuffer.
-- Returns eof = TRUE iff end of stream from text and no printing has occurred to ipMaster.
ff: BOOL;
FOR linesPrinted:
INT ← 0
, linesPrinted.
SUCC UNTIL linesPrinted
= maxLinesPerColumn
DO
[eof, ff, indent, indentChars] ←
FillLineBuffer[lineBuffer, maxCharsPerLine, indent, indentChars, text];
IF linesPrinted = 0
THEN {
IF eof THEN RETURN [TRUE];
IF ff THEN LOOP;
IF
NOT
pageStarted
THEN {
WritePageBeginning[ipMaster];
IF landscape THEN WriteLandscapeTransformation[ipMaster];
pageStarted ← TRUE;
SetGacha[ipMaster, IF landscape THEN 6 ELSE 8];
};
PrintHeading[];
};
IF eof OR ff THEN RETURN [FALSE];
ipMaster.SetXY[xCoordinateOfColumnLeftEdge,
yCoordinateOfFirstBaseline - linesPrinted*deltaYCoordinateBetweenLines];
ipMaster.Show[RefText.TrustTextAsRope[lineBuffer]];
ENDLOOP;
RETURN [FALSE];
};
FOR column ← 1
, column ← column.
SUCC DO
xCoordinateOfColumnLeftEdge ← xCoordinateOfLeftEdge +
((column-1) MOD columnsPerPage)*columnOffset;
IF PrintColumn[].eof THEN EXIT;
IF column
MOD columnsPerPage = 0
THEN {
IF pageStarted THEN WritePageEnding[ipMaster];
pageStarted ← FALSE;
};
ENDLOOP;
IF pageStarted THEN {WritePageEnding[ipMaster]; pageStarted ← FALSE};
ipMaster.EndMaster[];
RETURN [(column-1+columnsPerPage-1)/columnsPerPage]
};
};--InterpressFromText
FillLineBuffer:
PROC [lineBuffer:
REF
TEXT, maxCharsPerLine:
NAT,
indent: BOOL, indentChars: NAT, text: --input-- STREAM]
RETURNS [eof, ff: BOOL ← FALSE, nextIndent: BOOL ← FALSE, nextIndentChars: NAT ← 0] = {
-- lineBuffer is garbage on entry. lineBuffer.maxLength >= maxCharsPerLine.
-- Returns eof = TRUE iff end of stream from text and lineBuffer is empty.
-- Returns ff = TRUE iff form-feed char read from text and lineBuffer is empty.
spacesPerTab: NAT = 4;
extraIndentForFollowingLines: NAT = 2;
lineLength, maxLineLength: NAT;
OpenLine:
PROC [] = {
lineLength ← 0;
maxLineLength ← IF indent THEN maxCharsPerLine-indentChars ELSE maxCharsPerLine;
};
Append:
PROC [c:
CHAR] = {
lineBuffer[lineLength] ← c; lineLength ← lineLength + 1
};
UnAppend:
PROC [n:
NAT] = {
FOR i:
NAT
DECREASING
IN [lineLength-n .. lineLength-1]
DO
text.Backup[lineBuffer[i]];
ENDLOOP;
lineLength ← lineLength - n;
};
IsTabStop:
PROC []
RETURNS [
BOOL] = {
RETURN [
(IF indent THEN lineLength+indentChars ELSE lineLength) MOD spacesPerTab = 0];
};
IndexOfLastWhiteSpace:
PROC []
RETURNS [n:
NAT] = {
FOR i:
NAT
DECREASING
IN [1 .. lineLength)
DO
-- don't look at first char in line
IF lineBuffer[i].ORD <= (IO.SP).ORD THEN RETURN [i];
ENDLOOP;
-- here only if breaking an all-nonwhite line (unlikely)
RETURN [NAT.LAST]
};
IndexOfFirstNonwhiteSpace:
PROC []
RETURNS [n:
NAT] = {
FOR i:
NAT
IN [0 .. lineLength)
DO
IF lineBuffer[i].ORD > (IO.SP).ORD THEN RETURN [i];
ENDLOOP;
-- here only if breaking an all-white line (very unlikely)
RETURN [0];
};
CloseLine:
PROC []
RETURNS [] = {
IF indent
THEN {
FOR i:
NAT
DECREASING
IN [0 .. lineLength)
DO
lineBuffer[i + indentChars] ← lineBuffer[i];
ENDLOOP;
lineLength ← lineLength + indentChars;
FOR i: NAT IN [0 .. indentChars) DO lineBuffer[i] ← IO.SP ENDLOOP;
};
lineBuffer.length ← lineLength;
};
OpenLine[];
DO {
-- Assert 0 <= lineLength <= maxLineLength
char: CHAR;
{
char ← text.GetChar[ ! IO.EndOfStream => GOTO endOfStream];
EXITS endOfStream => { char ← IO.CR; eof ← TRUE }
};
IF eof AND lineLength = 0 THEN GOTO done;
IF char =
IO.
FF
THEN {
IF lineLength = 0 THEN { ff ← TRUE; GOTO done };
text.Backup[char];
char ← IO.CR;
};
IF char = IO.CR THEN GOTO done;
IF char =
IO.
TAB
THEN {
THROUGH [0 .. spacesPerTab)
DO
Append[IO.SP];
IF IsTabStop[] THEN EXIT;
IF lineLength > maxLineLength THEN EXIT;
ENDLOOP;
}
ELSE Append[char];
-- Assert 0 < lineLength <= maxLineLength+1
IF lineLength > maxLineLength
THEN {
-- line won't fit in buffer; must insert extra line break
i: NAT ← IndexOfLastWhiteSpace[];
IF i =
NAT.
LAST
THEN {
-- line won't break at white space; break at end and insert "~~"
UnAppend[3]; Append['~]; Append['~];
}
ELSE {
-- put back chars following the last white space; then discard the last white space
UnAppend[lineLength - (i+1)];
lineLength ← lineLength - 1;
};
-- Assert 0 < lineLength <= maxLineLength
nextIndentChars ←
IF indent
THEN indentChars
ELSE MIN[
IndexOfFirstNonwhiteSpace[] + extraIndentForFollowingLines, maxCharsPerLine/2];
nextIndent ← TRUE;
GOTO done;
};
EXITS done => { CloseLine[]; RETURN }
} ENDLOOP;
};--FillLineBuffer
PlainTextStreamFromNode:
PROC [from: TextNode.Ref, to:
STREAM]
= {
-- Writes a plain text representation of from and its descendants onto to, then Closes to.
PutGetExtras.WritePlain[h: to, root: from, restoreDashes: TRUE];
to.Close[];
RETURN;
};
InterpressFileFromFile:
PROC [from, to:
FS.OpenFile,
landscape: BOOL, ignoreNodes: BOOL, cmd: Commander.Handle]
RETURNS [ok: BOOL] = {
-- Writes a plain text representation of file onto a interpress file named interpressFileName.
-- Avoids producing internal Tioga document format if ignoreNodes and for plain text files.
-- ! IO.Error[$Failure] (FS errors)
fromStream:
STREAM = from.StreamFromOpenFile[
accessRights: $read, streamOptions: [tiogaRead: TRUE, commitAndReopenTransOnFlush: TRUE, truncatePagesOnClose: TRUE, finishTransOnClose: TRUE, closeFSOpenFileOnClose: FALSE]];
toStream:
STREAM = to.StreamFromOpenFile[
accessRights: $write, streamOptions: [commitAndReopenTransOnFlush: TRUE, truncatePagesOnClose: TRUE, finishTransOnClose: TRUE, closeFSOpenFileOnClose: FALSE]];
fromName, fromAttachedToName, toName: ROPE;
fileNameForLeaderPage, fileNameForHeading: ROPE;
[fromName, fromAttachedToName] ← from.GetName[];
[toName, ] ← to.GetName[];
fileNameForLeaderPage ← fromName;
fileNameForHeading ←
IO.PutFR["%g of %g", IO.rope[IF fromAttachedToName.IsEmpty[] THEN fromName ELSE fromAttachedToName], IO.time[from.GetInfo[].created]];
{
interpressPages: INT;
IF ignoreNodes
OR fromStream.GetLength[] = from.GetInfo[].bytes
THEN {
-- Read plain text directly from from.
cmd.out.PutF["Reading text file %g, writing Interpress file %g ... ", IO.rope[fromName], IO.rope[toName]];
interpressPages ← InterpressFromText[
fromStream, toStream, landscape, fileNameForLeaderPage, fileNameForHeading];
}
ELSE {
-- Built Tioga tree structure from from, then fork a process to produce a plain text version.
rootNode: TextNode.Ref;
pushStream, pullStream: STREAM;
producer: PROCESS ← NIL;
cmd.out.PutF["Reading Tioga file %g, creating tree structure... ", IO.rope[fromName]];
rootNode ← PutGet.FromFileC[from ! PutGet.FromFileError =>
{ cmd.out.PutRope["Tioga error reading file\n"]; GOTO fail }];
cmd.out.PutF["Reading tree structure, writing Interpress file %g ... ", IO.rope[toName]];
[push: pushStream, pull: pullStream] ← IOClasses.CreatePipe[bufferByteCount: 1000];
producer ← FORK PlainTextStreamFromNode[from: rootNode, to: pushStream];
interpressPages ← InterpressFromText[
pullStream, toStream, landscape, fileNameForLeaderPage, fileNameForHeading];
TRUSTED { JOIN producer; producer ← NIL };
TEditInput.FreeTree[rootNode];
pullStream.Close[];
};
fromStream.Close[];
toStream.Close[];
cmd.out.PutF[" %g Interpress pages written.\n", IO.int[interpressPages]];
RETURN [ok: TRUE]
EXITS fail => { RETURN [ok: FALSE] }
}
};
SendPressFile: PROC [fileName, server: ROPE, copies: INT, cmd: Commander.Handle]
RETURNS [result: REF ← NIL, msg: ROPE ← NIL] = {
-- Sends press file, giving feedback on its progress to cmd and checking for process abort.
-- "For:" name on break page will be that of the logged-in user.
lastState: PressPrinter.State ← $aborted;
aborted: BOOL ← FALSE;
SendPressFileProgress: PROC [handle: PressPrinter.Handle] = {
state: PressPrinter.State = handle.CurrentState[];
IF state = lastState THEN cmd.out.PutChar['.]
ELSE {
cmd.out.PutRope[handle.CurrentStateMessage[]];
IF state IN [$queued .. $serverTrouble] THEN cmd.out.PutRope["... "];
};
lastState ← state;
{
ProcessExtras.CheckForAbort[ ! ABORTED => GOTO abortTransmission];
EXITS abortTransmission => {
aborted ← TRUE;
PressPrinter.Abort[handle]
-- this proc is called again with state = $aborted; then ABORTED is raised by SendPressFile
};
};
};--SendPressFileProgress
printerHandle: PressPrinter.Handle ← NIL;
printerHandle ← PressPrinter.SendPressFile[
fileName: fileName, server: server, copies: copies,
userName: UserCredentials.Get[].name,
progressProc: SendPressFileProgress ! ABORTED => CONTINUE];
IF printerHandle = NIL OR printerHandle.CurrentState[] # $done THEN aborted ← TRUE;
IF aborted THEN {
cmd.out.PutRope["Aborting press file send... "];
RETURN [$Failure, NIL];
};
cmd.out.PutRope[".\n"];
};
FileCheck:
PROC [fileName:
ROPE]
RETURNS [exists:
BOOL, fullFName:
ROPE] = {
-- Returns exists: TRUE iff file exists. If exists then fullFName is filled in to make later lookup faster.
[fullFName: fullFName] ←
FS.FileInfo[name: fileName ! FS.Error => IF error.group = $user THEN GOTO doesNotExist];
RETURN [exists: TRUE, fullFName: fullFName]
EXITS doesNotExist => RETURN [exists: FALSE, fullFName: NIL];
};
CompleteFileName:
PROC [fileName:
ROPE]
RETURNS [fullFName:
ROPE] = {
-- Returns NIL if can't find a completion that corresponds to an existing file
exists: BOOL;
[exists, fullFName] ← FileCheck[fileName];
IF exists OR fileName.Find["!"] >= 0 OR fileName.Find["."] >= 0 THEN RETURN;
FOR extList:
LIST
OF
ROPE ← TEditProfile.sourceExtensions, extList.rest
UNTIL extList =
NIL
DO
f: ROPE = fileName.Concat[extList.first];
[exists, fullFName] ← FileCheck[f];
IF exists THEN RETURN;
ENDLOOP;
};
InterpressFileName:
PROC [fileName:
ROPE, newDir:
ROPE]
RETURNS [
ROPE] = {
cp: FS.ComponentPositions;
base: ROPE;
[fullFName: fileName, cp: cp] ← FS.ExpandName[name: fileName];
base ← fileName.Substr[cp.base.start, cp.base.length];
RETURN [Rope.Cat[newDir, base, ".interpress"]];
};
DoPrint: Commander.CommandProc = {
PROC [cmd: Commander.Handle] RETURNS [result: REF ← NIL, msg: Rope.ROPE ← NIL]
argv: CommandTool.ArgumentVector ← NIL;
i: NAT;
fileName: ROPE;
landscape: BOOL ← TRUE;
ignoreNodes: BOOL ← FALSE;
nCopies: INT ← 1;
host: ROPE ← UserProfile.Token[key: "Hardcopy.InterpressPrinter", default: NIL];
hostSpecified: BOOL ← NOT host.IsEmpty[];
interpressFileName: ROPE ← NIL;
retainInterpressFile: BOOL ← FALSE;
{
-- interpret the command line, modifying fileName
, ... , retainInterpressFile
.
IsParm:
PROC [i:
NAT]
RETURNS [
BOOL] = {
RETURN [i # argv.argc-1 AND NOT argv[i].IsEmpty[] AND argv[i].Fetch[0] # '-];
};
argv ← CommandTool.Parse[cmd ! CommandTool.Failed => { msg ← errorMsg; CONTINUE; }];
IF argv = NIL THEN RETURN[$Failure, msg];
IF argv.argc < 2 THEN RETURN[$Failure, printHelpText];
FOR i ← 1, i.
SUCC
UNTIL i = argv.argc-1
DO
IF argv[i].Length[] # 2 OR argv[i].Fetch[0] # '- THEN GOTO switchSyntaxError;
SELECT Ascii.Lower[argv[i].Fetch[1]]
FROM
'p => landscape ← FALSE;
't => ignoreNodes ← TRUE;
'c => {
i ← i.SUCC;
nCopies ← Convert.IntFromRope[argv[i] ! Convert.Error => GOTO numberSyntaxError];
};
'h => {
hostSpecified ← TRUE;
IF IsParm[i.SUCC] THEN { i ← i.SUCC; host ← argv[i] }
ELSE host ← NIL;
};
'r => {
retainInterpressFile ← TRUE;
IF IsParm[i.SUCC] THEN { i ← i.SUCC; interpressFileName ← argv[i] }
ELSE interpressFileName ← NIL;
};
ENDCASE => GOTO switchSyntaxError;
ENDLOOP;
fileName ← argv[i];
EXITS
switchSyntaxError =>
RETURN[
$Failure, IO.PutFR["Unrecognized switch: \"%g\"\n", IO.rope[argv[i]]]];
numberSyntaxError =>
RETURN[
$Failure, IO.PutFR["Unrecognized number: \"%g\"\n", IO.rope[argv[i]]]];
};
{
-- Validate fileName
(add file extension if not specified) and check hostSpecified
completeFileName: ROPE ← CompleteFileName[fileName];
IF completeFileName.IsEmpty[]
THEN
RETURN[$Failure, IO.PutFR["Could not find file: \"%g\"\n", IO.rope[fileName]]];
fileName ← completeFileName;
IF NOT hostSpecified THEN
RETURN[$Failure, "No print server specified in user profile or with \"-h\"\n"];
IF host.IsEmpty THEN retainInterpressFile ← TRUE;
};
{
-- do the real work
-- File error handing is done at this level
inputFile, interpressFile: FS.OpenFile ← FS.nullOpenFile;
{
ENABLE {
IO.Error => {
error: FS.ErrorDesc;
IF ec # $Failure THEN GOTO cantHandle;
error ← FS.ErrorFromStream[stream ! IO.Error => GOTO cantHandle];
cmd.out.PutF["FS error: %g\n", IO.rope[error.explanation]];
GOTO cleanupAfterError;
EXITS cantHandle => REJECT
};
FS.Error => {
cmd.out.PutF["FS error: %g\n", IO.rope[error.explanation]];
GOTO cleanupAfterError;
};
ABORTED => {
GOTO cleanupAfterError;
};
};
IF --PressPrinter.IsAPressFile[fileName]--FALSE
THEN {
cmd.out.PutF["File %g is already in press format\n", IO.rope[fileName]];
interpressFileName ← fileName;
retainInterpressFile ← TRUE;
}
ELSE {
inputFile, interpressFile: FS.OpenFile;
IF interpressFileName.IsEmpty[]
THEN interpressFileName ← InterpressFileName[
fileName, IF retainInterpressFile THEN "" ELSE "[]<>Temp>"];
inputFile ← FS.Open[fileName, $read];
interpressFile ← FS.Create[name: interpressFileName, setKeep: retainInterpressFile, keep: IF retainInterpressFile THEN 2 ELSE 1];
IF NOT InterpressFileFromFile[from: inputFile, to: interpressFile, landscape: landscape, ignoreNodes: ignoreNodes, cmd: cmd] THEN GOTO cleanupAfterError;
inputFile.Close[]; inputFile ← FS.nullOpenFile;
interpressFile.Close[]; interpressFile ← FS.nullOpenFile;
};
IF NOT host.IsEmpty[] THEN
[result, msg] ← SendPressFile[interpressFileName, host, nCopies, cmd];
IF result # NIL THEN GOTO cleanupAfterError;
IF
NOT retainInterpressFile
THEN {
cmd.out.PutF["Deleting file %g ... ", IO.rope[interpressFileName]];
FS.Delete[interpressFileName];
cmd.out.PutChar['\n];
};
cmd.out.PutRope["Finished Print.\n"];
RETURN [result: NIL, msg: NIL];
EXITS
cleanupAfterError => {
IF inputFile # FS.nullOpenFile THEN inputFile.Close[];
IF interpressFile # FS.nullOpenFile THEN interpressFile.Close[];
cmd.out.PutRope["Aborted Print.\n"];
RETURN [result: $Failure, msg: NIL];
};
};
};
};--DoPrint
printHelpText: ROPE = "Usage: IPrint {-p} {-h {hostName}} {-r {pfName}} {-c nCopies} {-t} file\n\t-p portrait mode, single column Gacha 8 (default is landscape, two columns Gacha 6)\n\t-h {hostName} name of printer, empty sends to no printer (default is Hardcopy.InterpressPrinter entry of user profile)\n\t-r {pfName} retain interpress file, naming it pfName if specified\n\t-c nCopies number of copies to print\n\t-t print text only, without indenting to show Tioga nodes\n\n\tThe file extension defaults according to the SourceFileExtensions entry of user profile, like the Open command. If the file is already in interpress format, it is simply sent to a printer.\n";
Commander.Register["IPrint", DoPrint, printHelpText];
END.
March 6, 1984 9:26:38 am PST: Adapted from Print.Mesa by MBrown.