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