-- File: WalnutPrintImpl.mesa
-- 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
-- Last edit by:
-- Willie-Sue on: November 30, 1983 4:59 pm
DIRECTORY
Atom USING [GetPropFromList],
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
Atom, IO, PrincOpsUtils, Process, Rope,
PutGet, TextEdit, TiogaFileOps, TiogaOps, TSExtras, TSTranslate,
DB, WalnutDB, WalnutExtras, WalnutWindow,
Menus, ViewerOps, UserProfile
EXPORTS
WalnutPrintOps =
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[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
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;
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;
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 = "(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.