File: WalnutPrintImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Contents: Implementation of printing of Msgs, MsgSets, MsgSetTOC's (someday)
Status: mostly here functionally, but not yet completed.
Created by: Willie-Sue, June 29, 1983
Willie-Sue, March 20, 1985 9:22:18 am PST
Rick Beach, April 27, 1985 12:24:45 pm PST
Last edit by:
Willie-Sue on: February 2, 1984 1:58:52 pm PST
DIRECTORY
IO USING [Error],
Menus USING [AppendMenuEntry, CreateEntry, CreateMenu, Menu, MenuProc],
PrincOpsUtils USING [IsBound],
Process USING [Detach],
Rope,
PutGet USING [FromRope],
TextEdit USING [SetLooks],
TextLooks USING [Looks, noLooks],
TextNode USING [Ref],
TiogaFileOps USING [CreateRoot, Ref, SetContents, SetFormat],
TiogaOps USING [Ref, FirstChild, LastLocWithin, PutProp],
TSExtras USING [PrintSuppliedNodes, PrintTiogaViewer, NodeProc],
TSTranslate USING [FontNotFound],
ViewerOps USING [AddProp, FetchProp, SetMenu],
ViewerTools USING [TiogaContents],
UserProfile USING [Boolean],
DB
USING [Aborted, Failure,
GetF, GetP, NextRelship, Null, RelationSubset, ReleaseRelshipSet, V2E],
ViewerClasses USING [Viewer],
WalnutDB
USING [Msg, MsgSet, Relship, RelshipSet,
mCategory, mCategoryIs, mCategoryOf, mSubjectIs, mTOCEntryIs,
AcquireDBLock, GetName, NumInMsgSet, TiogaMsgFromLog, V2S],
WalnutExtras USING [ChangeWalnutMenu, LoadBcdForWalnut],
WalnutPrintOps,
WalnutWindow USING [walnut, workingMenu, Report, ReportRope];
WalnutPrintImpl:
CEDAR
MONITOR
IMPORTS
IO, PrincOpsUtils, Process, Rope,
PutGet, TextEdit, TiogaFileOps, TiogaOps, TSExtras, TSTranslate,
DB, WalnutDB, WalnutExtras, WalnutWindow,
Menus, ViewerOps, UserProfile
BEGIN OPEN WalnutDB, WalnutWindow;
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
blankMenu: PUBLIC Menus.Menu = Menus.CreateMenu[];
printingMenu: Menus.Menu ← Menus.CreateMenu[];
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
PrintCallReturned: CONDITION;
PrintingInfoObject: TYPE = RECORD[done: BOOL, abortRef: REF BOOL, allOK: BOOL← TRUE];
PrintingInfo: TYPE = REF PrintingInfoObject;
lastReportFromPrinter: ROPE← NIL;
prints msgset, using the msgset viewer
MsgSetPrintProc:
PUBLIC
ENTRY Menus.MenuProc =
BEGIN
ENABLE
UNWIND =>
NULL;
self: Viewer = NARROW[parent];
prevMenu: Menus.Menu← self.menu;
BEGIN
ENABLE
UNWIND =>
CONTINUE;
aborted: REF BOOL = NEW[BOOL← FALSE];
printInfo: PrintingInfo;
msgSet: MsgSet;
ra: REF ANY;
IF ~LoadTSetter[] THEN RETURN;
printInfo← NEW[PrintingInfoObject← [done: FALSE, abortRef: aborted]];
ViewerOps.AddProp[self, $PrintingInfo, printInfo];
self.inhibitDestroy ← TRUE;
ViewerOps.SetMenu[self, printingMenu];
ra← NARROW[ViewerOps.FetchProp[self, $WalnutEntity]];
msgSet← DB.V2E[ra];
TRUSTED {Process.Detach[FORK PrintMSProc[msgSet, GetName[msgSet], printInfo]]};
UNTIL printInfo.done DO WAIT PrintCallReturned; ENDLOOP;
END;
ViewerOps.SetMenu[self, prevMenu];
self.inhibitDestroy ← FALSE;
END;
MsgPrintProc:
PUBLIC
ENTRY Menus.MenuProc =
BEGIN
ENABLE
UNWIND =>
NULL;
self: Viewer = NARROW[parent];
prevMenu: Menus.Menu← self.menu;
BEGIN
ENABLE
UNWIND =>
CONTINUE;
aborted: REF BOOL = NEW[BOOL← FALSE];
printInfo: PrintingInfo;
IF ~LoadTSetter[] THEN RETURN;
printInfo← NEW[PrintingInfoObject← [done: FALSE, abortRef: aborted]];
ViewerOps.AddProp[self, $PrintingInfo, printInfo];
self.inhibitDestroy← TRUE;
ViewerOps.SetMenu[self, printingMenu];
Report["Printing the msg: ", self.name];
TRUSTED {Process.Detach[FORK PrintViewer[self, printInfo]]};
UNTIL printInfo.done DO WAIT PrintCallReturned; ENDLOOP;
END;
ViewerOps.SetMenu[self, prevMenu];
self.inhibitDestroy← FALSE;
END;
PrintMsgSet:
PUBLIC
ENTRY
PROC[msgSet: MsgSet, msName:
ROPE]
RETURNS[allOK:
BOOL] =
BEGIN ENABLE UNWIND => NULL;
printInfo: PrintingInfo;
BEGIN ENABLE UNWIND => CONTINUE;
aborted: REF BOOL = NEW[BOOL← FALSE];
IF ~LoadTSetter[] THEN RETURN;
printInfo← NEW[PrintingInfoObject← [done: FALSE, abortRef: aborted]];
ViewerOps.AddProp[walnut, $PrintingInfo, printInfo];
walnut.inhibitDestroy ← TRUE;
WalnutExtras.ChangeWalnutMenu[printingMenu];
TRUSTED {Process.Detach[FORK PrintMSProc[msgSet, msName, printInfo]]};
UNTIL printInfo.done DO WAIT PrintCallReturned; ENDLOOP;
END;
walnut.inhibitDestroy← FALSE;
RETURN[printInfo.allOK];
END;
PrintMsgList:
PUBLIC
ENTRY
PROC[mList:
LIST
OF Msg, msViewer: Viewer]
RETURNS[allOK: BOOL] =
BEGIN
ENABLE
UNWIND =>
NULL;
prevMenu: Menus.Menu← msViewer.menu;
printInfo: PrintingInfo;
BEGIN
ENABLE
UNWIND =>
CONTINUE;
aborted: REF BOOL = NEW[BOOL← FALSE];
IF ~LoadTSetter[] THEN RETURN;
printInfo← NEW[PrintingInfoObject← [done: FALSE, abortRef: aborted]];
ViewerOps.AddProp[msViewer, $PrintingInfo, printInfo];
msViewer.inhibitDestroy← TRUE;
ViewerOps.SetMenu[msViewer, printingMenu];
Report["Printing selected msgs from ", msViewer.name];
Report["Printing selected msg from ", msViewer.name];
TRUSTED {Process.Detach[FORK PrintML[mList, msViewer.name, printInfo]]};
UNTIL printInfo.done DO WAIT PrintCallReturned; ENDLOOP;
END;
ViewerOps.SetMenu[msViewer, prevMenu];
msViewer.inhibitDestroy← FALSE;
RETURN[printInfo.allOK];
END;
LoadTSetter:
INTERNAL
PROC
RETURNS[ok:
BOOL] =
BEGIN
TRUSTED { ok← PrincOpsUtils.IsBound[LOOPHOLE[TSExtras.PrintTiogaViewer]]};
IF ~ok
THEN
IF ~WalnutExtras.LoadBcdForWalnut["TSetter"]
THEN
{ Report[" Can't print without a TSetter"]; RETURN[FALSE]};
RETURN[TRUE];
END;
prints msg displayed in viewer
PrintViewer:
PROC [viewer: Viewer, printInfo: PrintingInfo] =
BEGIN
ENABLE
UNWIND => {SignalPrintDone[printInfo]};
lastReportFromPrinter← NIL;
TRUSTED {TSExtras.PrintTiogaViewer[viewer: viewer, nameForSeparatorPage: viewer.name,
aborted: printInfo.abortRef, messageProc: PrintReport !
TSTranslate.FontNotFound =>
{printInfo.abortRef^ ←
TRUE; ReportRope[fontName];
Report[" not found - aborting"]; CONTINUE}]};
SignalPrintDone[printInfo];
END;
prints msgset
lotaStars: ROPE = "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\n";
transAbort: ROPE = "Transaction abort";
failureRope: ROPE = "Failure signal";
logFailure: ROPE = "Failure from log stream";
PrintMSProc:
PROC [msgSet: MsgSet, msName:
ROPE, printInfo: PrintingInfo] =
BEGIN
ENABLE
BEGIN
DB.Aborted => { Failure[printInfo, transAbort]; CONTINUE};
DB.Failure => { Failure[printInfo, failureRope]; CONTINUE};
IO.Error => {IF ec = Failure THEN Failure[printInfo, logFailure]; CONTINUE};
UNWIND => SignalPrintDone[printInfo];
END;
rootName:
ROPE← Rope.Concat["Msgset: ", msName];
DoPrintMsgSet:
PROC =
BEGIN
rs: RelshipSet;
rel: Relship;
msg: Msg;
firstCall: BOOL← TRUE;
firstMsg: BOOL← TRUE;
newPage: BOOL← UserProfile.Boolean[key: "Walnut.NewPageEveryMsg", default: FALSE];
smallHeaders: BOOL← UserProfile.Boolean[key: "Walnut.PrintSmallHeaders", default: TRUE];
SupplyMsg: TSExtras.NodeProc =
BEGIN
IF firstCall
THEN
{ node← FirstNode[rootName];
firstCall← FALSE;
RETURN
};
IF DB.Null[rel← DB.NextRelship[rs]] THEN RETURN[NIL];
msg← DB.V2E[DB.GetF[rel, mCategoryOf]]; -- follow relship to the Msg
ReportProgress[firstMsg];
node← FormatMsg[msg, firstMsg, newPage, smallHeaders];
firstMsg← FALSE;
END;
BEGIN
ENABLE
BEGIN
DB.Aborted, DB.Failure, IO.Error => {printInfo.abortRef^ ← TRUE};
UNWIND => {IF rs#NIL THEN DB.ReleaseRelshipSet[rs]; printInfo.abortRef^ ← TRUE};
END;
Report["Printing msgs from ", rootName];
rs← DB.RelationSubset[mCategory, LIST[[mCategoryIs, msgSet]]];
TRUSTED
{ TSExtras.PrintSuppliedNodes[nodeProc: SupplyMsg,
nameForSeparatorPage: rootName,
aborted: printInfo.abortRef,
messageProc: PrintReport ! TSTranslate.FontNotFound =>
{printInfo.abortRef^ ←
TRUE; PrintReport[fontName];
PrintReport[" not found - aborting"]; CONTINUE}]};
DB.ReleaseRelshipSet[rs];
SignalPrintDone[printInfo];
END; -- for UNWIND
END;
IF NumInMsgSet[msgSet] = 0
THEN
{ Report[rootName, " contains no msgs"]; RETURN};
lastReportFromPrinter← NIL;
WalnutDB.AcquireDBLock[DoPrintMsgSet];
END;
PrintML:
PROC [mL:
LIST
OF WalnutDB.Msg, name:
ROPE, printInfo: PrintingInfo] =
BEGIN
ENABLE
BEGIN
DB.Aborted => { Failure[printInfo, transAbort]; CONTINUE};
DB.Failure => { Failure[printInfo, failureRope]; CONTINUE};
IO.Error => {IF ec = Failure THEN Failure[printInfo, logFailure]; CONTINUE};
UNWIND => SignalPrintDone[printInfo];
END;
DoPrintMsgList:
PROC =
BEGIN
msg: WalnutDB.Msg;
firstMsg: BOOL← TRUE;
firstCall: BOOL← TRUE;
newPage: BOOL← UserProfile.Boolean[key: "Walnut.NewPageEveryMsg", default: FALSE];
smallHeaders: BOOL← UserProfile.Boolean[key: "Walnut.PrintSmallHeaders", default: TRUE];
SupplyMsg: TSExtras.NodeProc =
BEGIN
IF firstCall
THEN
{ node← FirstNode[name];
firstCall← FALSE;
RETURN
};
IF mL =
NIL
THEN
RETURN[
NIL];
msg← mL.first;
mL← mL.rest;
ReportProgress[firstMsg];
node← FormatMsg[msg, firstMsg, newPage, smallHeaders];
firstMsg← FALSE;
END;
BEGIN
ENABLE
BEGIN
DB.Aborted, DB.Failure, IO.Error => {printInfo.abortRef^ ← TRUE};
END;
TRUSTED
{ TSExtras.PrintSuppliedNodes[nodeProc: SupplyMsg,
nameForSeparatorPage: name,
aborted: printInfo.abortRef,
messageProc: PrintReport ! TSTranslate.FontNotFound =>
{printInfo.abortRef^ ←
TRUE; PrintReport[fontName];
PrintReport[" not found - aborting"]; CONTINUE}]};
SignalPrintDone[printInfo];
END;
END;
lastReportFromPrinter← NIL;
WalnutDB.AcquireDBLock[DoPrintMsgList];
END;
ReportProgress:
PROC[first:
BOOL] =
{ IF first THEN ReportRope["\n."] ELSE ReportRope["."] };
PrintReport:
PROC[r:
ROPE] =
BEGIN
IF r = lastReportFromPrinter THEN RETURN;
ReportRope[lastReportFromPrinter← r];
ReportRope["\n"];
END;
SignalPrintDone:
ENTRY
PROC[printInfo: PrintingInfo] =
BEGIN
printInfo.done← TRUE;
BROADCAST PrintCallReturned;
END;
Failure:
ENTRY
PROC[printInfo: PrintingInfo, who:
ROPE] =
BEGIN
Report[who, "; printing NOT done"];
printInfo.done← TRUE;
printInfo.allOK← FALSE;
BROADCAST PrintCallReturned;
END;
AbortPrintProc:
PUBLIC
ENTRY Menus.MenuProc =
BEGIN
ENABLE
UNWIND =>
NULL;
self: Viewer← NARROW[parent];
printInfo: PrintingInfo← NARROW[ViewerOps.FetchProp[self, $PrintingInfo]];
IF printInfo = NIL THEN RETURN; -- perhaps an error??
IF printInfo.done THEN RETURN; -- too late??
printInfo.abortRef^ ← TRUE;
IF self = walnut
THEN WalnutExtras.ChangeWalnutMenu[workingMenu]
ELSE
ViewerOps.SetMenu[self, blankMenu];
END;
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
FirstNode:
PROC[rootName:
ROPE]
RETURNS[node: TextNode.Ref] =
BEGIN
root: TiogaFileOps.Ref← TiogaFileOps.CreateRoot[];
mark: ROPE = "outsideFooter"; -- kludge
prefix: ROPE = "(cedar) style (firstHeadersAfterPage) (0) .cvx .def"; -- magic
TRUSTED
{ TiogaOps.PutProp[
LOOPHOLE[root], $Mark, mark];
TiogaOps.PutProp[LOOPHOLE[root], $Prefix, prefix];
};
TiogaFileOps.SetContents[root, rootName];
TRUSTED {node← LOOPHOLE[root, TextNode.Ref]};
END;
FormatMsg:
PROC[msg: WalnutDB.Msg, firstMsg, newPage, smallHeaders:
BOOL]
RETURNS[node: TextNode.Ref] =
BEGIN
contents: ViewerTools.TiogaContents← WalnutDB.TiogaMsgFromLog[msg].contents;
endHeadersPos: INT← Rope.Find[contents.contents, "\n\n"];
tocAndSubject: ROPE;
node← PutGet.FromRope[Rope.Concat[contents.contents, contents.formatting]];
IF smallHeaders
THEN
IF endHeadersPos > 0
THEN
{ lastLoc:
INT;
first: TiogaOps.Ref;
TRUSTED {first← TiogaOps.FirstChild[LOOPHOLE[node]]};
lastLoc← TiogaOps.LastLocWithin[first].where;
IF lastLoc > endHeadersPos
THEN
-- no formatting already
{ looks: TextLooks.Looks← TextLooks.noLooks;
looks['s]← TRUE;
looks['p]← TRUE;
TRUSTED {TextEdit.SetLooks[
LOOPHOLE[node],
LOOPHOLE[first], looks, 0, endHeadersPos+1]};
};
};
tocAndSubject←
Rope.Cat[V2S[DB.GetP[msg, mTOCEntryIs]], " ", V2S[DB.GetP[msg, mSubjectIs]]];
IF tocAndSubject.Length[] > 75
THEN
tocAndSubject← Rope.Concat[tocAndSubject.Substr[0, 70], " . . ."];
IF ~newPage THEN tocAndSubject← Rope.Concat[lotaStars, tocAndSubject];
IF ~firstMsg THEN tocAndSubject← Rope.Concat["\n\n", tocAndSubject];
TRUSTED
{ TiogaFileOps.SetContents[
LOOPHOLE[node], tocAndSubject];
TiogaFileOps.SetFormat[LOOPHOLE[node], IF newPage THEN "head" ELSE "head2"]
};
END;
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
start code
need an immediate menu button here, can't wait on walnutQueue
Menus.AppendMenuEntry[printingMenu, Menus.CreateEntry["AbortPrint", AbortPrintProc]];
END.