visualobliq/src/DialogMenu.m3


 Copyright (C) 1993, Digital Equipment Corporation 
 All rights reserved. 
 See the file COPYRIGHT for a full description. 
 
 Last modified on Wed Feb  1 09:45:44 PST 1995 by kalsow 
      modified on Tue Sep  6 16:20:21 PDT 1994 by bharat 
      modified on Sat Oct 23 23:43:23 PDT 1993 by mhb    
<* PRAGMA LL *>

MODULE DialogMenu;

IMPORT Attributes, Dialog, Fmt, FormsVBT, GenerateObliq, ListVBT,
       NodeVBT, Rd, Rsrc, Text, VBT, ZHandleVBT;

<* FATAL FormsVBT.Error,FormsVBT.Unimplemented *>

VAR
  M : ARRAY [0 .. 100] OF T;     (* working copy of menu structure *)
  MC: CARDINAL;                  (* counter for M *)
  ParentForm: NodeVBT.FormNode;
  MenuTemplate: TEXT;            (* read from menuTEMPLATE.fv on
                                    initialization *)

PROCEDURE LoadAttributes (n: ZHandleVBT.T) =
  VAR nv := NARROW(n, NodeVBT.FormNode);
  BEGIN
    ParentForm := nv;

    (* we don't check the HasMenu field here *)
    FormsVBT.PutText(Attributes.afv, "mbgctypein", nv.MenuBgColor, FALSE);
    FormsVBT.PutText(Attributes.afv, "mfgctypein", nv.MenuFgColor, FALSE);
    FormsVBT.PutText(Attributes.afv, "mfonttypein", nv.MenuFont, FALSE);

    (* clean up *)
    FormsVBT.PutText(Attributes.afv, "mlabel", "", FALSE);
    FormsVBT.PutText(Attributes.afv, "mname", "", FALSE);
    FormsVBT.MakeDormant(Attributes.afv, "mItemFilter");
    FormsVBT.PutBoolean(Attributes.afv, "mActive", TRUE);
    FormsVBT.PutText(Attributes.afv, "menucallback", "", FALSE);
    FormsVBT.PutChoice(Attributes.afv, "mexechow", "mForeground");
    FormsVBT.PutChoice(Attributes.afv, "mexecwhere", "mLocal");
    FormsVBT.MakeDormant(Attributes.afv, "mremFilter");
    FormsVBT.PutText(Attributes.afv, "mLocation", "", FALSE);
    FormsVBT.PutText(Attributes.afv, "menucallback", "", FALSE);
    WITH brow = NARROW(FormsVBT.GetVBT(Attributes.afv, "menubrowser"),
                       ListVBT.T) DO
      Attributes.LVFlush(brow);
      MC := 0;
      IF nv.Menu # NIL THEN
        (* copy to working storage *)
        FOR i := FIRST(nv.Menu^) TO LAST(nv.Menu^) DO
          M[MC] := nv.Menu[i];
          InsertInBrowser(MC, M[MC]); (* insert into the browser *)
          INC(MC);
        END;
        IF MC > 0 THEN
          FormsVBT.MakeActive(Attributes.afv, "mItemFilter")
        END
      END;
    END
  END LoadAttributes;

PROCEDURE ComputeMenuObjDefs (n: ZHandleVBT.T): TEXT =
  (* no state information needs to be recorded so we dont need the
     template *)
  VAR
    menudef := "";
    fn      := NARROW(n, NodeVBT.FormNode);
    menu    := fn.Menu;
  BEGIN
    IF menu # NIL THEN
      FOR i := FIRST(menu^) TO LAST(menu^) DO
        IF menu[i].Level < 2 AND NOT Text.Equal(menu[i].Name, "RIDGE") THEN
          menudef := menudef & menu[i].Name
                         & " => ( let temp = LOCAL.menuItemNew( \""
                         & menu[i].Label & "\", \""
                         & menu[i].Name & "\", " &
                         Fmt.Int(menu[i].Level) & ", \"" &
                         menu[i].initialState  & "\");\n" &
                         "\ttemp.form := meth(s) SELF.FORM end;\ntemp),\n";

        END
      END (* FOR *);
      menudef := menudef & "RIDGE => LOCAL.menuItemNew(" &
                     "\"RIDGE\", \"RIDGE\", 1, \"\"),\n";
    END;
    RETURN menudef
  END ComputeMenuObjDefs;

PROCEDURE ComputeMenuCallbacks (n: ZHandleVBT.T): TEXT =
  VAR
    menucbacks       := "";
    fn               := NARROW(n, NodeVBT.FormNode);
    menu             := fn.Menu;
    micb      : TEXT;
  BEGIN
    IF menu # NIL THEN
      FOR i := FIRST(menu^) TO LAST(menu^) DO
        IF menu[i].Level < 2 AND NOT Text.Equal(menu[i].Name, "RIDGE")
          AND NOT NodeVBT.AllWhitespace(menu[i].callback) THEN
          micb := GenerateObliq.callbackTemplate;
          micb := NodeVBT.FindAndReplace(micb, "objname", menu[i].Name);

          IF menu[i].inForeGround THEN
            micb := NodeVBT.FindAndReplace(micb, "bgHeader", "");
            micb := NodeVBT.FindAndReplace(micb, "bgFooter", "")
          ELSE
            micb := NodeVBT.FindAndReplace(
                      micb, "bgHeader", "thread_fork(proc()\n");
            micb :=
              NodeVBT.FindAndReplace(micb, "bgFooter", "\nend, 10000)\n")
          END;

          IF menu[i].isLocal THEN
            micb := NodeVBT.FindAndReplace(micb, "remoteHeader", "");
            micb := NodeVBT.FindAndReplace(micb, "remoteFooter", "")
          ELSE
            micb :=
              NodeVBT.FindAndReplace(
                micb, "remoteHeader",
                "let VODest = \n(*----------------------------------------*)\n"
                  & menu[i].executeAt & ";\n"
                  & "(*----------------------------------------*)\n"
                  & "VODest.VOCompute( proc(REMOTE) \n");

            micb := NodeVBT.FindAndReplace(
                      micb, "remoteFooter", "\n ok \n end )\n");
          END;
         menucbacks := menucbacks &  NodeVBT.FindAndReplace
                           (micb, "usercode", "(* Menu Callback for "
                           & menu[i].Name  & "*)\n" & menu[i].callback)
                           & "\n";
        END
      END
    END;
    RETURN menucbacks;
  END ComputeMenuCallbacks;

PROCEDURE ComputeMenuAttachments (n: ZHandleVBT.T): TEXT =
  VAR
    mats       := "";
    fn               := NARROW(n, NodeVBT.FormNode);
    menu             := fn.Menu;

  BEGIN
    IF menu # NIL THEN
      FOR i := FIRST(menu^) TO LAST(menu^) DO
        IF menu[i].Level < 2 AND NOT Text.Equal(menu[i].Name, "RIDGE")
          AND NOT NodeVBT.AllWhitespace(menu[i].callback) THEN
          mats := mats & "form_attach(SELF.FORM,  SELF." &
                      menu[i].Name & ".name, SELF." & menu[i].Name &
                      "Proc);\n";
        END
      END
    END;
    RETURN mats;
  END ComputeMenuAttachments;

PROCEDURE ComputeMenuSX (n: ZHandleVBT.T): TEXT =
  (* modify MenuTemplate using current state information *)
  VAR
    currentSX           : TEXT;
    fn                            := NARROW(n, NodeVBT.FormNode);
    menuDef, pulldownDef: TEXT;
    i, ix, ctr          : INTEGER;
    menu                          := fn.Menu;
  BEGIN
    IF menu = NIL THEN
      RETURN ""
    ELSE
      currentSX := MenuTemplate;
      currentSX :=
        NodeVBT.FindAndReplace(currentSX, "MenuBgColor", fn.MenuBgColor);
      currentSX :=
        NodeVBT.FindAndReplace(currentSX, "MenuFgColor", fn.MenuFgColor);
      currentSX :=
        NodeVBT.FindAndReplace(currentSX, "MenuFont", fn.MenuFont);
      menuDef := "";

      i := FIRST(menu^);
      WHILE i <= LAST(menu^) DO  (* i counts menu items *)
        IF menu[i].Level = 0 AND NOT Text.Equal(menu[i].Name, "RIDGE") THEN
          ctr := 0;
          ix := i + 1;           (* See if it is a pulldownmenuitem *)
          pulldownDef := "(VBox \n"; (* start creation of pulldown *)
          IF ix <= LAST(menu^) THEN (* if this is the end then it cant be a
                                       pulldown *)

            WHILE ix <= LAST(menu^) AND menu[ix].Level > 0 DO (* until next
                                                                 level 0
                                                                 item *)
              IF menu[ix].Level = 1 THEN (* only 2 levels in this
                                            implementation *)
                IF Text.Equal(menu[ix].Name, "RIDGE") THEN
                  pulldownDef := pulldownDef & "Ridge\n";
                ELSE
                  pulldownDef :=
                    pulldownDef & "(MenuButton " & menu[ix].Name
                      & "Filter " & menu[ix].initialState & " "
                      & menu[ix].Name & " " & menu[ix].Name & "Label "
                      & "\"" & menu[ix].Label & "\")\n"
                END;
                INC(ctr);
              END;
              INC(ix)
            END;
            pulldownDef := pulldownDef & ")\n"; (* close VBox *)
          END;                   (* of IF ix <= LAST(menu^) *)

          (* that should have computed pulldownDef *)

          IF (ctr > 0) THEN      (* this is indeed a pulldown *)
            menuDef :=
              menuDef & "(PullDownMenuItem " & menu[i].Name & "Filter "
                & menu[i].initialState & " " & menu[i].Name & " "
                & menu[i].Name & "Label " & "\"" & menu[i].Label & "\"\n"
                & pulldownDef & ")\n";
          ELSE
            menuDef :=
              menuDef & "(MenuItem " & menu[i].Name & "Filter "
                & menu[i].initialState & " " & menu[i].Name & " "
                & menu[i].Name & "Label " & "\"" & menu[i].Label & "\")\n";
          END;

          (* assert : ix is either beyond the end of the list or points to
             next level 0 item *)
          (* now we can move i forward *)
          i := ix - 1;           (* it will be incremented in any case *)

        END;                     (* of IF menu[i].Level = 0... *)
        INC(i)
      END;                       (* of WHILE i... *)
      currentSX := NodeVBT.FindAndReplace(currentSX, "MenuItems", menuDef);
      RETURN currentSX;
    END
  END ComputeMenuSX;

PROCEDURE InsertInBrowser (at: CARDINAL; item: T) =
  VAR
    offset       := "";
    text  : TEXT;
  BEGIN
    FOR i := 1 TO item.Level DO offset := offset & "..." END;
    IF Text.Equal(item.Name, "RIDGE") THEN
      text := offset & "-------------------------"
    ELSE
      text := offset & item.Label;
    END;
    WITH brow = NARROW(FormsVBT.GetVBT(Attributes.afv, "menubrowser"),
                       ListVBT.T) DO
      brow.insertCells(at, 1);
      brow.setValue(at, text);
      brow.selectOnly(at);
    END;
  END InsertInBrowser;

PROCEDURE ApplyProc (<* UNUSED *> cl  : FormsVBT.Closure;
                                  afv : FormsVBT.T;
                     <* UNUSED *> name: TEXT;
                     <* UNUSED *> time: VBT.TimeStamp     ) =
  VAR
    noo := NEW(REF ARRAY OF T, MC);
    ctr := 0;
  BEGIN
    (* make the changes happen on the parent form *)
    FOR i := FIRST(noo^) TO LAST(noo^) DO noo[i] := M[ctr]; INC(ctr) END;
    ParentForm.Menu := noo;
    WITH bgc  = FormsVBT.GetText(afv, "mbgctypein"),
         fgc  = FormsVBT.GetText(afv, "mfgctypein"),
         font = FormsVBT.GetText(afv, "mfonttypein") DO
      IF Text.Equal(bgc, "Inherit") THEN
        FormsVBT.PutText(afv, "mbgctypein", ParentForm.BgColor, FALSE);
        ParentForm.MenuBgColor := ParentForm.BgColor
      ELSE
        ParentForm.MenuBgColor := bgc
      END;
      IF Text.Equal(fgc, "Inherit") THEN
        FormsVBT.PutText(afv, "mfgctypein", ParentForm.FgColor, FALSE);
        ParentForm.MenuFgColor := ParentForm.FgColor
      ELSE
        ParentForm.MenuFgColor := fgc
      END;
      IF Text.Equal(font, "Inherit") THEN
        FormsVBT.PutText(afv, "mfonttypein", ParentForm.Font, FALSE);
        ParentForm.MenuFont := ParentForm.Font
      ELSE
        ParentForm.MenuFont := font
      END
    END;

    (* now make these changes happen on the actual menu bar *)
    (* note - the visibility of the menubar is controlled by the form attr
       sheet *)

    (* RenderMenuBar(ParentForm); *)

  END ApplyProc;

PROCEDURE LoadProc (<* UNUSED *> cl  : FormsVBT.Closure;
                                 afv : FormsVBT.T;
                                 name: TEXT;
                    <* UNUSED *> time: VBT.TimeStamp     ) =
  BEGIN
    (* if a doubleclick was involved *)
    IF Text.Equal(name, "menubrowser") THEN
      WITH sel = FormsVBT.GetInteger(afv, "menubrowser") DO
        FormsVBT.PutText(afv, "mlabel", M[sel].Label, FALSE);
        FormsVBT.PutText(afv, "mname", M[sel].Name, FALSE);
        FormsVBT.PutChoice(afv, "mInitialState", "m" & M[sel].initialState);
        IF M[sel].inForeGround THEN
          FormsVBT.PutChoice(afv, "mexechow", "mForeground")
        ELSE
          FormsVBT.PutChoice(afv, "mexechow", "mBackground")
        END;
        FormsVBT.PutText(afv, "menucallback", M[sel].callback, FALSE);
        FormsVBT.PutText(afv, "mLocation", M[sel].executeAt, FALSE);
        IF M[sel].isLocal THEN
          FormsVBT.PutChoice(afv, "mexecwhere", "mLocal");
          FormsVBT.MakeDormant(afv, "mremFilter");
        ELSE
          FormsVBT.PutChoice(afv, "mexecwhere", "mRemote");
          FormsVBT.MakeActive(afv, "mremFilter");
        END
      END
    ELSE
      (* must be ridge button *)
      FormsVBT.PutText(afv, "mlabel", "------------------------", FALSE);
      FormsVBT.PutText(afv, "mname", "RIDGE", FALSE);
      FormsVBT.PutChoice(afv, "mInitialState", "mActive");
      FormsVBT.PutChoice(afv, "mexechow", "mForeground");
      FormsVBT.PutText(afv, "menucallback", "", FALSE);
      FormsVBT.PutText(afv, "mLocation", "", FALSE);
      FormsVBT.PutChoice(afv, "mexecwhere", "mLocal");
      FormsVBT.MakeDormant(afv, "mremFilter");
    END
  END LoadProc;

PROCEDURE AddProc (<* UNUSED *> cl  : FormsVBT.Closure;
                                afv : FormsVBT.T;
                                name: TEXT;
                   <* UNUSED *> time: VBT.TimeStamp     ) =
  VAR
    level, pos: CARDINAL;
    sel       : INTEGER;
  BEGIN
    WITH label        = FormsVBT.GetText(afv, "mlabel"),
         nom          = FormsVBT.GetText(afv, "mname"),
         choice       = FormsVBT.GetChoice(afv, "mInitialState"),
         initialState = Text.Sub(choice, 1),
         infg = Text.Equal(
                  FormsVBT.GetChoice(afv, "mexechow"), "mForeground"),
         isloc = Text.Equal(
                   FormsVBT.GetChoice(afv, "mexecwhere"), "mLocal"),
         location = FormsVBT.GetText(afv, "mLocation"),
         callback = FormsVBT.GetText(afv, "menucallback"),
         brow     = NARROW(FormsVBT.GetVBT(afv, "menubrowser"), ListVBT.T) DO
      IF Text.Equal(name, "maddfirst") THEN
        level := 0;
        pos := 0;
        FormsVBT.MakeActive(afv, "mItemFilter");
      ELSIF brow.getFirstSelected(sel) THEN
        IF Text.Equal(name, "maddafter") OR Text.Equal(name, "mlabel") THEN
          level := M[sel].Level;
          (* pos = MIN(MC, next occurrence of a level <= this level) *)
          pos := sel + 1;
          WHILE pos < MC AND M[pos].Level > level DO INC(pos) END;
        ELSE
          (* "maddunder" *)
          level := M[sel].Level + 1;
          pos := sel + 1;
        END
      ELSE
        level := 0;              (* hitting enter without selection = add
                                    first *)
        pos := 0;
        FormsVBT.MakeActive(afv, "mItemFilter");
      END;
      (* insert cell in M at pos *)
      FOR ix := MC TO pos + 1 BY -1 DO M[ix] := M[ix - 1]; END;
      INC(MC);
      M[pos].Level := level;
      M[pos].Label := label;
      IF Text.Equal(nom, "") THEN
        M[pos].Name := label & "MenuItem";
        FormsVBT.PutText(afv, "mname", M[pos].Name, FALSE);
      ELSE
        M[pos].Name := nom
      END;
      M[pos].inForeGround := infg;
      M[pos].isLocal := isloc;
      M[pos].initialState := initialState;
      M[pos].executeAt := location;
      M[pos].callback := callback;
      InsertInBrowser(pos, M[pos]);
    END
  END AddProc;

PROCEDURE DelProc (             cl  : FormsVBT.Closure;
                                afv : FormsVBT.T;
                   <* UNUSED *> name: TEXT;
                                time: VBT.TimeStamp     ) =
  VAR
    sel := FormsVBT.GetInteger(afv, "menubrowser");
    start, finplusone, nentries: CARDINAL;
  BEGIN
    (* load attributes into form fields before deleting - so that the user
       gets feedback on what was deleted *)
    LoadProc(cl, afv, "menubrowser", time);

    (* compute how many entries need to be deleted as a result of this *)
    WITH level = M[sel].Level DO
      start := sel;
      finplusone := sel + 1;
      WHILE finplusone < MC AND M[finplusone].Level > level DO
        INC(finplusone)
      END
    END;
    nentries := finplusone - start;
    (* delete selection and update working store *)
    FOR i := finplusone TO MC - 1 DO M[i - nentries] := M[i]; END;
    MC := MC - nentries;
    WITH brow = NARROW(FormsVBT.GetVBT(afv, "menubrowser"), ListVBT.T) DO
      brow.removeCells(start, nentries);
      IF MC = 0 THEN
        FormsVBT.MakeDormant(afv, "mItemFilter")
      ELSIF MC > sel THEN
        brow.selectOnly(sel)
      ELSE
        brow.selectOnly(MC - 1)
      END
    END;
  END DelProc;

PROCEDURE ReplaceProc (<* UNUSED *> cl  : FormsVBT.Closure;
                                    afv : FormsVBT.T;
                       <* UNUSED *> name: TEXT;
                       <* UNUSED *> time: VBT.TimeStamp     ) =
  VAR pos: INTEGER;
  BEGIN
    WITH label        = FormsVBT.GetText(afv, "mlabel"),
         nom          = FormsVBT.GetText(afv, "mname"),
         choice       = FormsVBT.GetChoice(afv, "mInitialState"),
         initialState = Text.Sub(choice, 1),
         infg = Text.Equal(
                  FormsVBT.GetChoice(afv, "mexechow"), "mForeground"),
         isloc = Text.Equal(
                   FormsVBT.GetChoice(afv, "mexecwhere"), "mLocal"),
         location = FormsVBT.GetText(afv, "mLocation"),
         callback = FormsVBT.GetText(afv, "menucallback"),
         brow     = NARROW(FormsVBT.GetVBT(afv, "menubrowser"), ListVBT.T) DO
      EVAL brow.getFirstSelected(pos);
      M[pos].Label := label;
      IF Text.Equal(nom, "") THEN
        M[pos].Name := label & "MenuItem";
        FormsVBT.PutText(afv, "mname", M[pos].Name, FALSE);
      ELSE
        M[pos].Name := nom
      END;
      M[pos].inForeGround := infg;
      M[pos].isLocal := isloc;
      M[pos].initialState := initialState;
      M[pos].executeAt := location;
      M[pos].callback := callback;
    END
  END ReplaceProc;

PROCEDURE LRProc (<* UNUSED *> cl  : FormsVBT.Closure;
                               afv : FormsVBT.T;
                               name: TEXT;
                  <* UNUSED *> time: VBT.TimeStamp     ) =
  BEGIN
    IF Text.Equal(name, "Local") THEN
      FormsVBT.MakeDormant(afv, "mremFilter")
    ELSE
      FormsVBT.MakeActive(afv, "mremFilter")
    END
  END LRProc;

PROCEDURE Initialize () =
  BEGIN

    WITH colorclosure = NEW(
                          FormsVBT.Closure, apply := Attributes.ColorProc),
         fontclosure = NEW(FormsVBT.Closure, apply := Attributes.FontProc) DO
      (* attach menu-attribute sheet color-popup-helper-buttons and
         font-helper-popup-buttons *)
      FormsVBT.Attach(Attributes.afv, "mbgc", colorclosure);
      FormsVBT.Attach(Attributes.afv, "mfgc", colorclosure);
      FormsVBT.Attach(Attributes.afv, "mfont", fontclosure);
    END;

    (* Attach the apply button *)
    WITH applyclosure = NEW(FormsVBT.Closure, apply := ApplyProc) DO
      (* attach apply button *)
      FormsVBT.Attach(Attributes.afv, "mapply", applyclosure);
    END;

    WITH loadclosure = NEW(FormsVBT.Closure, apply := LoadProc) DO
      (* attach browser dbl clk and ridge button - load stuff *)
      FormsVBT.Attach(Attributes.afv, "menubrowser", loadclosure);
      FormsVBT.Attach(Attributes.afv, "mridge", loadclosure);
    END;

    WITH addclosure = NEW(FormsVBT.Closure, apply := AddProc) DO
      (* attach addfirst, addafter, addunder buttons *)
      FormsVBT.Attach(Attributes.afv, "maddfirst", addclosure);
      FormsVBT.Attach(Attributes.afv, "maddafter", addclosure);
      FormsVBT.Attach(Attributes.afv, "maddunder", addclosure);
      FormsVBT.Attach(Attributes.afv, "mlabel", addclosure);
    END;

    WITH delclosure = NEW(FormsVBT.Closure, apply := DelProc) DO
      (* attach delete button *)
      FormsVBT.Attach(Attributes.afv, "mdelete", delclosure);
    END;

    WITH replaceclosure = NEW(FormsVBT.Closure, apply := ReplaceProc) DO
      (* attach delete button *)
      FormsVBT.Attach(Attributes.afv, "mreplace", replaceclosure);
    END;

    WITH lrclosure = NEW(FormsVBT.Closure, apply := LRProc) DO
      (* attach local and remote choices *)
      FormsVBT.Attach(Attributes.afv, "mLocal", lrclosure);
      FormsVBT.Attach(Attributes.afv, "mRemote", lrclosure);
    END;
    TRY
      WITH reader = Rsrc.Open("menuTEMPLATE.fv", Dialog.rsrcPath) DO
        MenuTemplate := Rd.GetText(reader, LAST(CARDINAL));
        Rd.Close(reader);
      END
    EXCEPT
    ELSE
      Dialog.message(Dialog.screen[1], "Error Loading : menuTEMPLATE.fv");
    END;
  END Initialize;

BEGIN
END DialogMenu.