-- 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.

Ęv˜JšĨĪcå
œ4œ
Īk	œžœžœ
žœžœMžœžœžœžœžœžœžœ6žœ7žœAžœžœ.žœ žœžœ
žœqžœžœģ
žœHžœ/Īnœžœ
žœžœžœˇ
žœžœ
žœžœžœžœ
žœ%žœļ
ž	œžœžœžœžœ
žœ	žœžœžœžœ,žœžœ+Ÿœžœžœ
žœ
žœžœžœ.žœ
žœ
žœžœ
žœ
žœžœ
žœžœ6žœ
žœžœžœ
žœžœžœdžœ1žœ6žœžœžœ5žœžœ
žœžœžœ>žœžœŸœžœžœ
žœ
žœžœžœ.žœ
žœ
žœžœ
žœ
žœžœ
žœžœžœžœ
žœžœžœcžœWžœžœ"žœžœ
žœžœžœ=žœžœŸ
œ
žœ
žœ
žœžœžœžœžœ
žœ
žœžœžœ
žœ
žœžœžœ
žœžœ
žœžœžœžœ
žœžœžœfžœ1žœžœ,žœžœ
žœžœžœžœžœžœŸœžœ
žœžœ
žœžœžœžœ
žœ
žœžœDžœ
žœ
žœžœ
žœ
žœžœ
žœžœžœžœ
žœžœžœkžœŖ
žœžœ.žœžœ
žœžœžœEžœžœžœŸœžœ
žœ
žœžœžœžœž
œ8žœžœ+žœ1žœ
žœžœ
žœžœŸ
"Ÿœžœ/žœ
žœ
žœ:žœžœĖ
žœAžœ%žœŸ
ŸœžœCŸ
œŸ
žœŸ
œ
žœŸ
œŸ
žœŸ
œžœžœžœ
žœžœžœ.žœžœ/žœž
œžœžœžœ!žœžœ#žœžœ$Ÿ
œžœžœDžœžœžœžœžœ>žœžœ@žœŸ	œžœžœžœ3žœžœžœ
žœžœžœ
žœ
žœžœžœœfžœžœžœžœžœ
žœ
žœ!žœžœžœžœ
žœ
žœ.žœžœ3žœžœžœŲ
žœGžœžœ:žœ
œžœžœžœ-žœžœ,žœŸœžœžœ
žœžœžœ
žœžœžœ.žœžœ/žœž
œžœžœžœ!žœžœ#žœŸœžœžœ$žœžœžœžœžœ>žœžœ@žœŸ	œžœžœžœ/žœžœ
žœžœ
žœ
žœ
žœ‰
žœžœžœžœžœ
žœ
žœ!žœžœžœÕ
žœGžœ(žœžœžœ-žœŸœžœžœžœžœ,Ÿœžœžœžœžœžœ
žœ>žœŸœžœ
žœžœžœž	œžœŸœžœ
žœžœžœ7žœžœž	œžœŸœžœžœ
žœ
žœžœžœ$žœ-žœ
žœ
žœ
žœœžœžœ
žœœžœžœžœ,žœ)žœUŸ	œžœžœžœžœ<žœ	œ
žœ-œžœžœ)žœLžœžœžœŸ	œžœ5žœžœžœ

œ

œžœ_žœ8žœPžœžœ
žœžœžœžœžœ;ž
œžœžœœBžœžœžœžœžœRžœ%žœžœžœIžœ
žœ8žœžœ5žœžœ3žœžœ	žœžœžœ
œQQœWžœ˜Ģd—…—2.9Ē