MODULE DevMsgSpy;
(**

   project   = "BlackBox"
   organization   = "www.oberon.ch"
   contributors   = "Oberon microsystems"
   version   = "System/Rsrc/About"
   copyright   = "System/Rsrc/About"
   license   = "Docu/BB-License"
   changes   = ""
   issues   = ""

**)

   IMPORT SYSTEM,

      DevDebug, Dialog, Stores, Models, Views, Controllers, Properties, Kernel,
      Ports, TextModels, TextViews, TextMappers, StdDialog,
      Files, Converters, FormViews, FormModels, Windows, Containers, Services;
   CONST

      refViewSize = 9 * Ports.point;
   TYPE

      View = POINTER TO RECORD (Views.View)
         inner: Views.View
      END;
      
      RefView = POINTER TO RECORD (Views.View)
         msg: ANYPTR
      END;
      Msgs = POINTER TO RECORD

         left, right: Msgs;
         mod, ident: Kernel.Name;
         index: INTEGER;
      END;
      
   VAR
      para* : RECORD
         sel*: Dialog.Selection;
         selectNewMessages*: BOOLEAN;
         showMessages*: BOOLEAN
      END;
      text*: TextModels.Model;
      
      msgs: Msgs;
      size: INTEGER;
      path: ARRAY 4 OF Ports.Point;
   (* -------------------
Selection------------------- *)
   PROCEDURE Find(mod, ident: Kernel.Name): Msgs;

      VAR m: Msgs;
   BEGIN m := msgs;
      WHILE m # NIL DO
         IF mod < m.mod THEN m := m.left
         ELSIF mod > m.mod THEN m := m.right
         ELSIF ident < m.ident THEN m := m.left
         ELSIF ident > m.ident THEN m := m.right
         ELSE RETURN m
         END
      END;
      RETURN NIL
   END Find;
   
   PROCEDURE Insert(mod, ident: Kernel.Name);
      PROCEDURE InsertTree(VAR m: Msgs);
         VAR name: ARRAY 64 OF CHAR;
      BEGIN
         IF m = NIL THEN
            NEW(m); m.mod := mod; m.ident := ident; m.index := size-1;
            name := m.mod + "." + m.ident;
            para.sel.SetItem(m.index, name);
            IF para.selectNewMessages THEN para.sel.Incl(m.index, m.index) END
         ELSE
            IF mod < m.mod THEN InsertTree(m.left)
            ELSIF mod > m.mod THEN InsertTree(m.right)
            ELSIF ident < m.ident THEN InsertTree(m.left)
            ELSIF ident > m.ident THEN InsertTree(m.right)
            END
         END
      END InsertTree;
   BEGIN
      INC(size);para.sel.SetLen(size);   (* increase size and reset all items *)
      InsertTree(msgs);                  (* insert the new item *)
      Dialog.UpdateList(para.sel)
   END Insert;
   (* -------------------
RefView ------------------- *)
   
   PROCEDURE (v: RefView) Internalize (VAR rd: Stores.Reader);
      VAR thisVersion: INTEGER;
   BEGIN
      v.Internalize^(rd); IF rd.cancelled THEN RETURN END;
      rd.ReadVersion(0, 0, thisVersion); IF rd.cancelled THEN RETURN END;
   END Internalize;
   PROCEDURE (v: RefView) Externalize (VAR wr: Stores.Writer);

   BEGIN
      v.Externalize^(wr);
      wr.WriteVersion(0);
   END Externalize;
   PROCEDURE (v: RefView) CopyFromSimpleView (source: Views.View);

   BEGIN
      (* v.CopyFrom^(source); *)
      v.msg := source(RefView).msg
   END CopyFromSimpleView;
   PROCEDURE (v: RefView) Restore (f: Views.Frame; l, t, r, b: INTEGER);

   BEGIN
      f.DrawPath(path, 4, Ports.fill, Ports.blue, Ports.closedPoly)
   END Restore;
   
   PROCEDURE (v: RefView) HandleCtrlMsg (
      f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View
   );
      TYPE ControllersMessage = POINTER TO Controllers.Message;
         ViewsMessage = POINTER TO Views.Message;
         ModelsMessage = POINTER TO Models.Message;
         PropMessage = POINTER TO Properties.Message;
      VAR x, y: INTEGER; isDown: BOOLEAN; mo: SET;name: ARRAY 32 OF CHAR;
   BEGIN
      WITH msg: Controllers.TrackMsg DO
         IF v.msg # NIL THEN
            REPEAT
               f.MarkRect(0, 0, refViewSize, refViewSize, Ports.fill, Ports.hilite, Ports.show);
               REPEAT
                  f.Input(x, y, mo, isDown)
               UNTIL (x < 0) OR (x > refViewSize) OR (y < 0) OR (y > refViewSize) OR ~isDown;
               f.MarkRect(0, 0, refViewSize, refViewSize, Ports.fill, Ports.hilite, Ports.hide);
               WHILE isDown & ((x < 0) OR (x > refViewSize) OR (y < 0) OR (y > refViewSize)) DO
                  f.Input(x, y, mo, isDown)
               END
            UNTIL ~isDown;
            IF (x >= 0) & (x <= refViewSize) & (y >= 0) & (y <= refViewSize) THEN
               IF v.msg IS ControllersMessage THEN name := "Controllers.Message"
               ELSIF v.msg IS PropMessage THEN name := "Properties.Message"
               ELSIF v.msg IS ViewsMessage THEN name := "Views.Message"
               ELSIF v.msg IS ModelsMessage THEN name := "Models.Message"
               ELSE name := "Message Record"
               END;
               DevDebug.ShowHeapObject(SYSTEM.ADR(v.msg^), name)
            END
         END
      | msg: Controllers.PollCursorMsg DO
         msg.cursor := Ports.refCursor
      ELSE
      END
   END HandleCtrlMsg;
   
   PROCEDURE (v: RefView) HandlePropMsg (VAR msg: Properties.Message);
   BEGIN
      WITH msg: Properties.Preference DO
         WITH msg: Properties.ResizePref DO msg.fixed := TRUE
         | msg: Properties.SizePref DO msg.w := refViewSize; msg.h := refViewSize
         | msg: Properties.FocusPref DO msg.hotFocus := TRUE
         ELSE
         END
      ELSE
      END
   END HandlePropMsg;
   
   (* -------------------Wrapper------------------- *)
   
   PROCEDURE (v: View) CopyFromModelView (source: Views.View; model: Models.Model);
   BEGIN
      WITH source: View DO
         IF model = NIL THEN v.inner := Views.CopyOf(source.inner, Views.shallow)
         ELSE v.inner := Views.CopyWithNewModel(source.inner, model)
         END;
         Stores.Join(v, v.inner)
      END
   END CopyFromModelView;
   
   PROCEDURE (v: View) ThisModel (): Models.Model;
   BEGIN
      RETURN v.inner.ThisModel()
   END ThisModel;
   PROCEDURE (v: View) InitContext (context: Models.Context);

   BEGIN
      v.InitContext^(context);
      v.inner.InitContext(context)   (* wrapper and wrapped view share the same context *)
   END InitContext;
   
(*
   PROCEDURE (v: View) PropagateDomain;
   BEGIN
      Stores.InitDomain(v.inner, v.domain)
   END PropagateDomain;
*)
   PROCEDURE (v: View) Neutralize;

   BEGIN
      v.inner.Neutralize
   END Neutralize;
   (* NewFrame: wrapper uses standard frame *)

   (* Background: wrapper has no intrinsic background color *)
   PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: INTEGER);

   BEGIN
      Views.InstallFrame(f, v.inner, 0, 0, 0, TRUE)
   END Restore;
   (* RestoreMarks: wrapper has no intrinsic marks, wrapped view's RestoreMarks is called by framework *)

   
   PROCEDURE DescOfMsg (VAR x: ANYREC): Kernel.Type;
      VAR desc: Kernel.Type;
   BEGIN
      desc := SYSTEM.VAL(Kernel.Type, SYSTEM.TYP(x));   (* tdesc of x *)
      RETURN desc
   END DescOfMsg;
   
   PROCEDURE WriteLog(t: Kernel.Type; VAR msg: ANYREC; name: ARRAY OF SHORTCHAR);
      VAR link: RefView; p: ANYPTR; name2 : ARRAY 256 OF CHAR; f: TextMappers.Formatter;
   BEGIN
      Kernel.NewObj(p, t);
      SYSTEM.MOVE(SYSTEM.ADR(msg), p, t.size);
      NEW(link); link.msg := p;
      name2 := t.mod.name$ + "." + name$;
      
      f.ConnectTo(text);
      f.WriteString(name2 + " ");
      f.WriteView(link);
      f.WriteLn;
      TextViews.ShowRange(text, text.Length(), text.Length(), ~TextViews.focusOnly)
   END WriteLog;
   
   PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Controllers.Message; VAR focus: Views.View);
      VAR name: Kernel.Name; t: Kernel.Type; m: Msgs;
   BEGIN
      t := DescOfMsg(msg);
      Kernel.GetTypeName (t, name);
      m := Find(t.mod.name, name);
      IF m = NIL THEN Insert(t.mod.name, name)
      ELSIF para.sel.In(m.index) & para.showMessages THEN WriteLog(t, msg, name);
      END;
      focus := v.inner   (* forward all controller messages to wrapped view *)
   END HandleCtrlMsg;
   
   PROCEDURE (v: View) ExternalizeAs (VAR s: Stores.Store);
   BEGIN
      s := v.inner
   END ExternalizeAs;
   
   PROCEDURE (v: View) HandlePropMsg (VAR msg: Properties.Message);
      VAR name: Kernel.Name; t: Kernel.Type; m: Msgs;
   BEGIN
      t := DescOfMsg(msg);
      Kernel.GetTypeName (t, name);
      m := Find(t.mod.name, name);
      IF m = NIL THEN Insert(t.mod.name, name)
      ELSIF para.sel.In(m.index) & para.showMessages THEN WriteLog(t, msg, name);
      END;         
      Views.HandlePropMsg(v.inner, msg)
   END HandlePropMsg;
   
   PROCEDURE (v: View) HandleViewMsg (f: Views.Frame; VAR msg: Views.Message);
      VAR name: Kernel.Name; t: Kernel.Type; m: Msgs;
   BEGIN
      t := DescOfMsg(msg);
      Kernel.GetTypeName (t, name);
      m := Find(t.mod.name, name);
      IF m = NIL THEN Insert(t.mod.name, name)
      ELSIF para.sel.In(m.index) & para.showMessages THEN WriteLog(t, msg, name);
      END;
      WITH msg: Views.ScrollClassMsg DO

         msg.allowBitmapScrolling := TRUE
      ELSE
      END
      (* framework performs message propagation *)
   END HandleViewMsg;
   PROCEDURE (v: View) HandleModelMsg (VAR msg: Models.Message);

      VAR name: Kernel.Name; t: Kernel.Type; m: Msgs;
   BEGIN
      t := DescOfMsg(msg);
      Kernel.GetTypeName (t, name);
      m := Find(t.mod.name, name);
      IF m = NIL THEN Insert(t.mod.name, name)
      ELSIF para.sel.In(m.index) & para.showMessages THEN WriteLog(t, msg, name);
      END;
      (* framework performs message propagation *)
   END HandleModelMsg;
   

   PROCEDURE Toggle*;
      VAR v: Views.View; w: View; replace: Controllers.ReplaceViewMsg;
   BEGIN
      Controllers.SetCurrentPath(Controllers.targetPath);
      v := Containers.FocusSingleton();
      Controllers.ResetCurrentPath();
      IF v # NIL THEN
         WITH v: View DO
            replace.old := v; replace.new := v.inner;
         ELSE
            NEW(w); w.inner := v;
            replace.old := v; replace.new := w;
         END;
         Controllers.Forward(replace)
      ELSE Dialog.Beep
      END
   END Toggle;
   
   PROCEDURE ToggleGuard* (VAR par: Dialog.Par);
      VAR v : Views.View;
   BEGIN
      Controllers.SetCurrentPath(Controllers.targetPath);
      v := Containers.FocusSingleton();
      Controllers.ResetCurrentPath();
      IF (v = NIL) OR ~(v IS View) THEN
         par.label := "#Dev:AddView";
         par.disabled := v = NIL
      ELSE
         par.label := "#Dev:RemoveView"
      END
   END ToggleGuard;
   
   PROCEDURE Reset*;
   BEGIN
      msgs := NIL; size := 0; para.sel.SetLen(size);
      Dialog.UpdateList(para.sel)
   END Reset;
   
   PROCEDURE Clear*;
   BEGIN
      text.Delete(0, text.Length())
   END Clear;
   
   PROCEDURE PathToSpec (VAR path: ARRAY OF CHAR; VAR loc: Files.Locator; VAR name: Files.Name);
      VAR i, j: INTEGER; ch: CHAR;
   BEGIN
      i := 0; j := 0; loc := Files.dir.This("");
      WHILE (loc.res = 0) & (i < LEN(path) - 1) & (j < LEN(name) - 1) & (path[i] # 0X) DO
         ch := path[i]; INC(i);
         IF (j > 0) & ((ch = "/") OR (ch = "\")) THEN
            name[j] := 0X; j := 0; loc := loc.This(name)
         ELSE
            name[j] := ch; INC(j)
         END
      END;
      IF path[i] = 0X THEN name[j] := 0X
      ELSE loc.res := 1; name := ""
      END
   END PathToSpec;
   PROCEDURE OpenDialog*(file, title: ARRAY OF CHAR);

      VAR loc: Files.Locator; fname: Files.Name; conv: Converters.Converter; view, v, t: Views.View;
         r: FormModels.Reader; t0: Views.Title; done: BOOLEAN; c: Containers.Controller;
   BEGIN
      Dialog.MapString(title, t0);
      Windows.SelectByTitle(NIL, {Windows.isTool}, t0, done);
      IF ~ done THEN
         PathToSpec(file, loc, fname);
         IF loc.res = 0 THEN
            conv := NIL;
            view := Views.Old(Views.dontAsk, loc, fname, conv);
            IF view IS FormViews.View THEN t := NIL;
               r := view(FormViews.View).ThisModel().NewReader(NIL);
               r.ReadView(v);
               WHILE (v # NIL) & (t = NIL) DO
                  t := Properties.ThisType(v, "TextViews.View");
                  r.ReadView(v)
               END;
               IF t # NIL THEN
                  text := t(TextViews.View).ThisModel();
                  text.Delete(0, text.Length())
               END;
            END;
            IF view # NIL THEN
               WITH view: Containers.View DO
                  c := view.ThisController();
                  IF c # NIL THEN
                     c.SetOpts(c.opts - {Containers.noFocus} + {Containers.noCaret, Containers.noSelection})
                  ELSE Dialog.ShowMsg("#System:NotEditable")
                  END
               ELSE Dialog.ShowMsg("#System:ContainerExpected")
               END;
               IF text # NIL THEN
                  StdDialog.Open(view, title, NIL, "", NIL, TRUE, FALSE, TRUE, FALSE, TRUE)
               ELSE
                  Dialog.ShowMsg("#Dev:TextInDialogExpected")
               END
            END
         ELSE Dialog.ShowParamMsg("#System:FileNotFound", file, "", "")
         END;
      END
   END OpenDialog;
BEGIN

(*NEW(action); action.Do; *)
   para.showMessages := TRUE;
   size := 0;
   path[0].x := refViewSize DIV 2; path[0].y := 0;
   path[1].x := refViewSize; path[1].y := refViewSize DIV 2;
   path[2].x := refViewSize DIV 2; path[2].y := refViewSize;
   path[3].x := 0; path[3].y := refViewSize DIV 2;
END DevMsgSpy.
"DevMsgSpy.OpenDialog('Dev/Rsrc/MsgSpy', 'Message Spy')"

Menu:

"Message Spy..."   ""   "DevMsgSpy.OpenDialog('Dev/Rsrc/MsgSpy', 'Message Spy')"   ""

Strings: (Dev)
AddView   Add View
RemoveView   Remove View
TextInDialogExpected   Text in Dialog expected
Dialog:

StdCoder.Decode ..,, ..qX....3Qw7uP5PRPPNR9Rbf9b8R79FTvMf1uZlbcjRAktYcjRgp,
xW1xhiZiVBhihgmRiioedhgrp9XjJHPNjvQRdJHXS7wb8RTfQ9vQRtIdvPZHjU..D.JA06.Css
HorC4sQqorGqmmKjAST1.PuP.PuP7PNCLLq2o9ZD,6.ciDU7Umy.0E.0.3IXyKtqKfaqmQCb8R
7fJHPNjfL4TXyKt.bHfEjIy0.,.s,cMD.,6.5IXyKtgdjZACbHlayKmKaSNwB0UnNHEjIy4.,U
uq.e.8P16.,6.cUCoruamxhgRiiQeZZhZRgoBhjph0xhsp9XzE.QcjphoVSdw5.0.Z00.p,0E0
GYZdRqYntNCZkNSuWkNM8bVd9CbZ7P6..k.E.0ke59,BXgevQ4,TCbE,5zV.C5FPN5vO3uPlfL
8z4U.EEF.E2F.Y....05.C5MNCaodHKarNHKantQ4abNNCb.MH4amtO0WC,0WBNNsQ.66aai76
mYdtQGb.6...YiVA.1hBFlSzs9gh6Z33gwRE.6.YF0E.Eu0.,E0Uq,S4.05MMsQWajtRq2sQ.6
.CZc,0WB,C5.0WddPUjtN0E.0E...2cNA.fCKNl2Ts9Aoe343Qw.6IfvQFfEf9RdvPRfL8z4U.
EjU.EXU.Y..sNC3U17PKaVV.2U17P.00U.E...AYJ51f9APldCmGghh443gwT.0.,X.2.272.7
.O5UH,cIKanNNG5C2MM.aan7R6...A2guy23bu69lajvJIkmz,6.o96.o66.7sIGbYtEqaYtQu
W1VjtQKa2NO4agtPSa.sEm4C50.,.U,E.Yyvp2188PFHeQNAbZ443Qwb8R7vI5fQT9PNPNZvQR
dJ.5.,6.Yo0k1E49.,E.8cIhgsZiKBhZtQC3h0xmsHpmW5sQO3uZmL.0U..w.oa0.,sUGpmWbB
xhYltQeoNHEjAyI,ktg7cL8T1U.kk2.T.n0,6.Eb2.86.QC18RdfQHfMf9R9vQxGtH.0..c4E.
k.UesFnQ.E.0t.U,UzjV0CyIhACoruKuEqUHZC58RZ9Pxms,.U1xB.uZlT6AA.cQ...b1.o9ZD
,6.636.M00U.2..AU0CyIVGhighgmRCbWGhigFjAyI,ktIepVSdw5.,6.IIw.IH2U.sU.ktQ8C
JuaLqKKjAyI,.AjgVmz.2U..2,w86.IE.U,ZC..2..EGE.4E.E.EECOhU.wcNC.zwPA.A.2U.E
,9z8U...p.0.4.I3E.6.VQ.E..2eHJ.6...Z1Jsp0E9mr72YKQ4hO8BF,9z5U.E41.,.d1,E0G
2O5sNC3a5GZjtNSagNN0U,7NGaUMHC5C36.GYZdR..u0Ub7PsFKbVdQG40..EulEPHIoY8L4nw
gLF.3U..8ssP2Coru4UntIGqVyKr.o9XjF..Cb1,USdwl.,..A,,E.0U06.,6.,c.16QBaywPW
.0.161lbA2TmNeHXGBnmcUXDF.sET1.4zVkk.Um,..QC.Ej2yHZCQCwBu32..W.0..0F6Cb.yy
W8Utj00My7Yb6OQzL0yl1...
--- end of encoding ---