-- File: NutViewerMiscImpl.mesa
-- Contents: Implementation of most of Squirrel Viewers interface (NutViewer).
-- Last edited by:
--   Cattell on July 22, 1983 3:48 pm
--   Willie-Sue on January 21, 1983 8:48 am
--   Donahue, April 5, 1983 11:18 am

DIRECTORY
  Buttons,
  Containers USING [ChildXBound, ChildYBound],
  DB,
  IO,
  Labels USING [Create],
  MessageWindow,
  Menus,
  MBQueue,
  Nut,
  NutOps,
  NutViewer,
  Process USING [Detach],
  Rope,
  Rules USING [Create],
  SquirrelTool USING [squirrel],
  ViewerOps,
  ViewerClasses,
  ViewerTools USING [MakeNewTextViewer, SetContents],
  ViewerSpecs USING [openLeftTopY],
  VFonts USING[defaultFont, Font];

NutViewerMiscImpl: CEDAR PROGRAM
  IMPORTS
       Buttons, DB, IO, Nut, NutOps, MessageWindow,
		Containers, Labels, MBQueue, Menus, Process,
		Rope, Rules, SquirrelTool, ViewerOps, ViewerTools, VFonts
  EXPORTS NutViewer =

BEGIN OPEN NutViewer, DB;

-- Types and global variables

Queue: TYPE = MBQueue.Queue;

entryHeight: INTEGER = 14;

-- yTextFudge: INTEGER = 0;
xTextFudge: INTEGER = 8;
xFudge: INTEGER = 4;
-- yFudge: INTEGER = 0;

Viewer: TYPE = ViewerClasses.Viewer;
ViewerRec: TYPE = ViewerClasses.ViewerRec;
ROPE: TYPE = Rope.ROPE;

defaultDBQueue: Queue;
  
-- Exported procedures

DBQueue: PUBLIC PROC RETURNS[Queue] = 
 {RETURN[defaultDBQueue]};

Initialize: PUBLIC PROC[parent: Viewer] RETURNS [nV: Viewer] =
  --  Makes a label which is the first one in a viewer, at standard Y value
  BEGIN
  CheckAborted[parent];
  nV_ ViewerOps.CreateViewer[
      flavor: $Label, info: [parent: parent, ww: 0, wh: 0, wy: 1,
	    wx: IF parent.scrollable THEN 0 ELSE xFudge, border: FALSE]]
  END;

MakeTextViewer: PUBLIC PROC[
  sib: Viewer, w: INTEGER, fullLine: BOOL] RETURNS [nV: Viewer] =
  BEGIN
  IF fullLine THEN RETURN[NextTextViewer[sib]]
  ELSE RETURN[NextRightTextViewer[sib, w]];
  END; 

NextTextViewer: PUBLIC PROC[sib: Viewer] RETURNS [nV: Viewer] =
  -- Creates text viewer on line after sib, full width of parent
  BEGIN
   CheckAborted[sib];
   nV_ ViewerTools.MakeNewTextViewer[
     info: [parent: sib.parent, wy: sib.wy+sib.wh, ww: sib.parent.ww,
     		wh: ViewerSpecs.openLeftTopY]];
   Containers.ChildXBound[sib.parent, nV];
   Containers.ChildYBound[sib.parent, nV];
  END; 

NextRightTextViewer: PUBLIC PROC[sib: Viewer, w: INTEGER] RETURNS [nV: Viewer] =
  --  creates a text viewer, next right on the same line as v
  --  v must be a Viewer, not NIL
  BEGIN
   CheckAborted[sib];
   nV_ ViewerTools.MakeNewTextViewer[
   info: [parent: sib.parent, wx: sib.wx+sib.ww+xFudge, wy: sib.wy,
   ww: w, wh: entryHeight, border: FALSE]];
  END;

MakeLabel: PUBLIC PROC[
  name: ROPE, sib: Viewer_ NIL, newLine: BOOL_ FALSE] RETURNS [nV: Viewer] =
  BEGIN
   --   ly: INTEGER_ sib.wy;
   --   IF sib.class.flavor = $Text THEN ly_ ly - yTextFudge;
   info: ViewerRec_ [name: name, parent: sib.parent, wy: sib.wy, wh: entryHeight,
   		border: FALSE];
   CheckAborted[sib];
   IF newLine THEN
     { info.wx_ IF sib.parent.scrollable THEN 0 ELSE xFudge;
	   info.wy_ info.wy + sib.wh;
     }
    ELSE info.wx_ sib.wx+sib.ww;
   nV_ Labels.Create[info: info];
  END;  

MakeButton: PUBLIC PROC[q: Queue, name: ROPE, proc: Buttons.ButtonProc,
	sib: Viewer, data: REF ANY_ NIL, border: BOOL_ FALSE, width: INTEGER_ 0,
	guarded: BOOL_ FALSE, font: VFonts.Font _ VFonts.defaultFont, newLine: BOOL_ FALSE]
	RETURNS [nV: Viewer] =
  --  The sib is a viewer to the left or above the button to be made.
  --  If q#NIL THEN button will be serialized with other buttons/menus on q,
  --  otherwise it uses defaultDBQueue
  --  Makes a button which is the first one on line if newLine=TRUE.
  BEGIN
  info: ViewerRec_ [name: name, wy: sib.wy, ww: width, wh: entryHeight,
  		parent: sib.parent, border: border];
  CheckAborted[sib];
  IF newLine THEN  -- first button on new line
    { info.wy_ sib.wy + sib.wh + (IF border THEN 1 ELSE 0);	-- extra bit
      info.wx_ IF sib.parent.scrollable THEN 0 ELSE xFudge;
	 }
  ELSE -- next button right on same line as previous 
    info.wx_ sib.wx+sib.ww;
  IF q=NIL THEN 
RETURN[Buttons.Create[
    info: info, proc: proc, clientData: data, fork: FALSE, font: font, guarded: guarded]]
  ELSE RETURN[ MBQueue.CreateButton[
    q: q, info: info, proc: proc, clientData: data, font: font, guarded: guarded]]
  END;

MakeMenuEntry: PUBLIC PROC[q: Queue, name: ROPE, proc: Menus.MenuProc,
  clientData: REF ANY_ NIL, documentation: REF ANY_ NIL, fork: BOOL_ TRUE,
  guarded: BOOL_ FALSE] RETURNS[Menus.MenuEntry] = {
  IF q=NIL THEN RETURN[
    Menus.CreateEntry[name, proc, clientData, documentation, fork, guarded]]
   ELSE RETURN[
     MBQueue.CreateMenuEntry[q, name, proc, clientData, documentation, fork, guarded]]
   };

MakeTypescript: PUBLIC PROC[sib: Viewer] RETURNS [ts: Viewer] =
  BEGIN
  y: INTEGER_ sib.wy+sib.wh+xFudge;
  CheckAborted[sib];
  ts_ ViewerOps.CreateViewer[flavor: $Typescript,
    info:  [parent: sib.parent, ww: sib.cw, wy: y, wh: sib.parent.ch - y, border: FALSE] ];
  Containers.ChildYBound[sib.parent, ts];
  Containers.ChildXBound[sib.parent, ts];
  END;

MakeBigTextBox: PUBLIC PROC[sib: Viewer, contents: ROPE] RETURNS [nV: Viewer]=
   -- Makes editable text viewer taking rest of sib.parent's viewer,
   -- suitable for msg body or whatever.
   BEGIN
   y: INTEGER_ 0;
   oldV: Viewer_ sib.parent;
   h: INTEGER;
   CheckAborted[sib];
   IF oldV = NIL THEN oldV_ sib ELSE y_ sib.wy+sib.wh+xFudge;
   h_ oldV.ch - y;
   nV _ ViewerTools.MakeNewTextViewer[
	    info: [parent: oldV, wy: y, border: FALSE, ww: oldV.ww, wh: h],
	    paint: FALSE];
  ViewerTools.SetContents[nV, contents];
  Containers.ChildYBound[oldV, nV];
  Containers.ChildXBound[oldV, nV];
  END;

MakeRuler: PUBLIC PROC[sib: Viewer, h: INTEGER_ 1] RETURNS [nV: Viewer] =
  --  Make a one-bit wide line after sib
  BEGIN
  CheckAborted[sib];
  nV_ Rules.Create[
     info: [parent: sib.parent, wy: sib.wy+sib.wh+1, ww: sib.parent.ww, wh: h]];
  Containers.ChildXBound[sib.parent, nV];
  END;

CheckAborted: PROCEDURE[sib: Viewer]  =
  BEGIN
  state: ATOM;
  IF sib = NIL THEN RETURN;
  IF sib.parent # NIL THEN sib _ sib.parent;
  state _ NARROW[ViewerOps.FetchProp[sib, $NutViewerState]];
  IF state = $beingDestroyed THEN ERROR ABORTED; -- caught by NutImpl.Display
  END;

ProcessSelection: PUBLIC Buttons.ButtonProc =
  -- A standard ButtonProc that assumes the button's REF ANY data is the FieldHandle above.
  -- Insures attribute of tuple is entity-valued and non-NIL, then calls Nut.Display on it.
  BEGIN OPEN DB;
  otherEntity: Entity;
  fd: FieldHandle_ NARROW[clientData];
  viewer: Viewer_ NARROW[parent];
  IF fd.attribute=NIL THEN -- it was the relation itself
    { otherEntity _ RelationOf[fd.tuple];
      []_ Nut.Display[e: otherEntity, parent: viewer.parent, seg: SegmentOf[otherEntity]] }
  ELSE IF NutOps.EntityValued[fd.attribute] THEN -- attribute refs another entity
    IF Null[fd.tuple] THEN
      Message[viewer, "That relationship has been deleted!"]
    ELSE IF Null[otherEntity_V2E[GetF[fd.tuple, fd.attribute]]] THEN
      Message[viewer, "That entity has been deleted!"]
    ELSE
      { otherEntity _ V2E[GetF[fd.tuple, fd.attribute]];
        []_ Nut.Display[e: otherEntity, parent: viewer.parent, seg: SegmentOf[otherEntity]] }
  ELSE -- attribute is a string or number
    Message[viewer, "Not an entity-valued field"];
  END;

DefaultFreezeProc: PUBLIC Menus.MenuProc =
  BEGIN
	self: Viewer = NARROW[parent];
	frozen: Menus.MenuEntry = Menus.FindEntry[self.menu, "Freeze"];
	IF frozen = NIL THEN RETURN;
	Menus.ReplaceMenuEntry[self.menu, frozen];
	ViewerOps.PaintViewer[self, menu];
	ViewerOps.AddProp[self, $Frozen, self];
  END;
  
DBNotifier: PUBLIC PROC [q: MBQueue.Queue] = {
  -- Just like Notifier provided by MBQueue, except catches generic database errors
  success: BOOL; -- set if operations succeeds;
  x1: MBQueue.Action.user;
  x2: MBQueue.Action.client;
  Do1: PROC[ REF ANY ] = {x1.proc[x1.parent, x1.clientData, x1.mouseButton, x1.shift, x1.control]};
  Do2: PROC[ REF ANY ] = {x2.proc[x2.data]};
  DO -- forever
    ENABLE ABORTED => {MBQueue.Flush[q]; LOOP};
     event: MBQueue.Action_ MBQueue.DequeueAction[q];
    WITH event SELECT FROM
      e1: MBQueue.Action.user => {
        x1_ e1; success_ NutOps.Do[proc: Do1, msgViewer: NARROW[e1.parent]] };
      e2: MBQueue.Action.client => {
        x2_ e2; success_ NutOps.Do[proc: e2.proc]};
      ENDCASE => ERROR;
    IF NOT success THEN MBQueue.Flush[q];
    ENDLOOP;
  };

Message: PUBLIC PROC[v: Viewer, msg1, msg2, msg3, msg4: ROPE_ NIL] =
  -- Print msgs in v's typescript if there is one, else in Squirrel window if there is one,
  -- else in message window.
  BEGIN out: IO.STREAM = GetTypescript[v];
  IF out=NIL THEN
    {MessageWindow.Clear[]; MessageWindow.Append[Rope.Cat[msg1, msg2, msg3, msg4]]}
  ELSE {
    out.Put[IO.rope[msg1], IO.rope[msg2], IO.rope[Rope.Concat[msg3,msg4]]]; out.PutChar[IO.CR]};
  END;

MessageRope: PUBLIC PROC[v: Viewer, msg: ROPE_ NIL] =
  BEGIN out: IO.STREAM = GetTypescript[v];
  IF out=NIL THEN {MessageWindow.Append[msg]}
  ELSE {out.Put[IO.rope[msg]]};
  END;

Error: PUBLIC PROC[v: Viewer, msg1, msg2, msg3, msg4: ROPE_ NIL] = 
  -- Same as Message, but blinks to get user's attention.
  {MessageWindow.Blink[]; Message[v, msg1, msg2, msg3, msg4]};

GetTypescript: PROC [v: Viewer] RETURNS [out: IO.STREAM] = {
  IF v=NIL THEN
    IF (v_ SquirrelTool.squirrel)=NIL THEN RETURN[NIL]
    ELSE IF v.iconic THEN ViewerOps.BlinkIcon[v]
     ELSE v_ GetTopLevel[v];
  RETURN[NARROW[ViewerOps.FetchProp[GetTopLevel[v], $Typescript]]];
  };

GetTopLevel: PROC [v: Viewer] RETURNS [top: Viewer] =
  {FOR top_ v, top.parent UNTIL top.parent=NIL DO ENDLOOP};

StartTrap: PROC = TRUSTED {
  defaultDBQueue_ MBQueue.Create[pushModel: FALSE];
  Process.Detach[FORK DBNotifier[defaultDBQueue]]};


StartTrap[];

END.

-- Change log

WS 23-Feb-82 16:37:41:  took out paint: FALSE on all viewer creations
			made all Buttons have border: FALSE

Rick 1March or so: fixed bug in ProcessSelection: check that tuple is not null (deleted).

Rick March 25, 1982 4:01 pm: Moved CommitEditableTuple here since it was only proc in NutEditorImpl.

Rick August 3, 1982 4:11 pm: catch AttributeValueTypeMismatch in CommitEditableTuple & recover.

Cattell June 3, 1983 11:27 am:  Added fancy Message stuff here, completely reorganized NextXViewer stuff to simplify.

Cattell June 6, 1983 3:24 pm: Attempt to recover from aborted transactions in DBNotifier.

   
Ęđ˜JšāĪcų
œ
Īk	œžœ2žœWžœžœžœ9žœ1žœžœ)žœ
žœžœĸ
žœžœ
žœœ,žœœžœžœœ	žœ$žœžœžœžœœ
Īnœžœ
žœ
žœ
Ÿžœ
žœžœLœžœ‚
žœžœžœžœžœŸœžœžœžœžœžœžœ
žœ
žœžœ
žœ!žœŸœžœžœAœžœ‚žœŸœžœžœžœ`œžœ¤
žœžœŸ	œžœ
žœ
žœžœžœžœžœžœœ;œ_žœžœ	žœžœžœžœ3žœ=žœŸ
œžœ
žœžœ0žœ
žœžœ
žœžœ	žœžœžœ3žœžœžœ˙
œžœ‰
žœ	žœœ"žœžœžœ
œžœžœžœžœ
/œžœžœkž
œmžœŸ
œžœ
žœžœ&žœ
žœžœžœ
žœžœžœžœ
žœžœ
žœžœ
žœNžœHž
œŸœžœ
žœžœžœžœą
žœ[žœŸœžœ
žœžœžœlœžœžœ(žœžœžœ
žœžœ}žœ#žœvžœŸ	œžœ
žœžœžœ'œžœ§
žœŸœž	œžœ
žœžœžœ
žœ
žœžœžœ
žœžœ/žœžœ
žœ
žœœžœĪbœžœZœZœžœ
žœ
žœ,žœ žœžœžœ
žœ
œˆ
žœ
žœ#žœ
!œžœžœBžœ
žœ5žœ<žœš
žœ
#œ5žœ œžœžœžœLžœ
žœ
žœ
žœ}žœ 
œžœwžœ`žœžœ
žœWžœžœ
žœžœžœžœžœ5žœžœ
žœ]žœožœžœžœ
žœžœžœ œžœ$ž	œžœ&žœžœ
žœWžœežœ œžœž	œžœ&žœžœ
žœžœžœ œžœ$ž	œ~ œžœ
žœžœžœžœžœ
žœ
žœžœ
žœ
žœžœžœžœ
žœ: œžœ
žœžœžœžœ
žœ
žœ 	œžœžœ/žœžœ+žœœ
žœ&žœ:žœ÷ž 
˜“R—…—).