-- 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: February 2, 1984 1:58:52 pm PST 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 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 = "(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.