(**************************************************************************

:Program.    EdMenu.mod
:Contents.   Menu-Handline for Amok-Editor
:Author.     Hartmut Goebel
:Copyright.  Copyright © 1987 by Matthew Dillon
:Copyright.  Oberon implementation Copyright © 1991 by Hartmut Goebel
:Language.   Oberon
:Translator. Amiga Oberon Compiler V2.13
:History.    V1.0, 25 Feb 1991 Hartmut Goebel [hG]
:History.    V1.1, 24 Apr 1991 [hG] +memoryFail; Code opitmiert
:History.    V1.1b 24 May 1991 [hG] optimiert wg. Oberon V2.00
:History.    V1.1c 15 Oct 1991 [hG] ^AddItem (+Dummy-Loop)
:History.    V1.2  25 Dec 1991 [hG] +MenuAddCheck, MenuSeperator,CheckItem
:Support.    Menu.mod (fbs, Amok #59)
:Date.       24 Jan 1992 17:58:50

**************************************************************************)

MODULE EdMenu;

IMPORT
  e  : Exec,
  edE: EdErrors,
  edG: EdGlobalVars,
  edL: EdLowLevel,
  g  : Graphics,
  I  : Intuition,
  lst: EdLists,
  ol : OberonLib,
  str: Strings,
  s  : SYSTEM;

CONST
  seperator * = 0;
  checkIt * = 1;

  m2mAction * = 0;  (* MenuToMacro führt was aus *)
  set * = 1;
  reset * = 2;

  SeperatorImage = I.Image(1,1,0,2,0,NIL,SHORTSET{},SHORTSET{},NIL);

TYPE
  XItemPtr = POINTER TO XItem;
  XItem = STRUCT  (item: I.MenuItem)
    com: edG.StringPtr;
  END;

VAR
  Menu: I.MenuPtr;
  MenuoffCnt: INTEGER;
  DoMenuoffCnt: INTEGER;
  dMenuDelReturn: BOOLEAN;
  ItemPicked*: XItemPtr;

PROCEDURE MenuStrip*(win: I.WindowPtr);
BEGIN
  IF (MenuoffCnt=0) AND (Menu#NIL) AND I.SetMenuStrip(win,Menu^) THEN
    e.Forbid();
    EXCL(win.flags,I.rmbTrap);
    e.Permit();
  END;
END MenuStrip;


PROCEDURE Fixmenu;
VAR
  item: I.MenuItemPtr;
  menu: I.MenuPtr;
  it: I.IntuiTextPtr;
  row,col,maxc,scr: INTEGER;
  rp: g.RastPortPtr;
  img: I.ImagePtr;
BEGIN
(* $IFNOT ClearVars THEN *)
  col := 0;
(* $END *)
  rp := s.ADR(edG.Screen.rastPort);
  menu := Menu;
  WHILE menu#NIL DO
    maxc := 0; row := 0;
    item := menu.firstItem;
    WHILE item#NIL DO
      item.topEdge := row;
      IF I.itemText IN item.flags THEN
        it := item.itemFill;
        scr := g.TextLength(rp,it.iText^,edL.Length(it.iText^));
      END;
      IF I.checkIt IN item.flags THEN
        INC(scr,I.checkWidth); END;
      IF scr > maxc THEN maxc := scr END;
      INC(row,item.height);
      item := item.nextItem;
    END;
    item := menu.firstItem;
    WHILE item#NIL DO
      item.width := maxc;
      IF NOT (I.itemText IN item.flags) THEN
        img := item.itemFill;
        img.width := maxc-4;
      END;
      item := item.nextItem;
    END;
    menu.width := g.TextLength(rp,menu.menuName^,edL.Length(menu.menuName^))+12;
    menu.leftEdge := col;
    menu.height := row;
    INC(col,menu.width);
    menu := menu.nextMenu;
  END; (* WHILE menu#NIL *)
END Fixmenu;


PROCEDURE MenuOff;
VAR
  txt: edG.TextHeaderPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  IF MenuoffCnt = 0 THEN
    txt := edG.EditList.head(edG.TextHeader);
    WHILE txt#NIL DO
      I.ClearMenuStrip(txt.win);
      e.Forbid();
      INCL(txt.win.flags,I.rmbTrap);
      e.Permit();
      txt := txt.node.next(edG.TextHeader);
    END;
  END;
  INC(MenuoffCnt);
END MenuOff;


PROCEDURE MenuOn;
VAR
  txt: edG.TextHeaderPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  IF (Menu#NIL) AND (MenuoffCnt=1) THEN
    Fixmenu;
    txt := edG.EditList.head(edG.TextHeader);
    WHILE txt#NIL DO
      IF I.SetMenuStrip(txt.win,Menu^) THEN
        e.Forbid();
        EXCL(txt.win.flags,I.rmbTrap);
        e.Permit();
      END;
      txt := txt.node.next(edG.TextHeader);
    END;
  END;
  DEC(MenuoffCnt);
END MenuOn;


PROCEDURE FindMenu(string: edG.StringPtr): XItemPtr;
VAR
  xitem: XItemPtr;
  item: edG.StringPtr;
  it: I.IntuiTextPtr;
  menu: I.MenuPtr;
  i: INTEGER;
BEGIN
(* $IFNOT ClearVars THEN *)
  i := 0;
(* $END *)
  WHILE (string[i]#0X) AND (string[i]#"-") DO
    INC(i); END;
  IF string[i] = "-" THEN
    string[i] := 0X;
    item := s.ADR(string[i+1]);
    menu := Menu;
    WHILE menu # NIL DO
      IF string^ = menu.menuName^ THEN
        xitem := menu.firstItem(XItemPtr);
        WHILE xitem # NIL DO
          IF I.itemText IN xitem.item.flags THEN
            it := xitem.item.itemFill;
            IF item^ = it.iText^ THEN
              string[i] := "-";
              RETURN xitem;
            END;
          END;
          xitem := xitem.item.nextItem;
        END;
      END;
      menu := menu.nextMenu;
    END;
    string[i] := "-";
  END;
  RETURN NIL;
END FindMenu;


PROCEDURE MenuToMacro*(string: edG.StringPtr): edG.StringPtr;
VAR
  xi: XItemPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  xi := FindMenu(string);
  IF xi # NIL THEN RETURN xi.com; END;
  RETURN NIL;
END MenuToMacro;


PROCEDURE GetMenuCmd*(im: I.IntuiMessagePtr): edG.StringPtr;
BEGIN
  ItemPicked := I.ItemAddress(Menu^,im.code);
  IF ItemPicked # NIL THEN RETURN ItemPicked.com;
                      ELSE RETURN NIL; END;
END GetMenuCmd;


(* gibt TRUE zurück, falls noch Items vorhanden sind *)
PROCEDURE DelItem(menu: I.MenuPtr; item: XItemPtr): BOOLEAN;
VAR
  it: I.MenuItemPtr;
  iptr: POINTER TO I.MenuItemPtr;
  itxt: I.IntuiTextPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  iptr := s.ADR(menu.firstItem); (* dahin gehört der Nachfolger *)
  it := menu.firstItem;
  WHILE it # NIL DO
    IF item = it THEN
      iptr^ := it.nextItem;
      IF I.itemText IN it.flags THEN
        itxt := it.itemFill;
        DISPOSE(itxt.iText);
      END;
      DISPOSE(item.com);  (* testet selbst IF item.com # NIL !! *)
      DISPOSE(item);      (* zugehörtige Daten sind dabei!! *)
      IF menu.firstItem = NIL THEN RETURN FALSE;
                              ELSE RETURN TRUE; END;
    END;
    iptr := s.ADR(it.nextItem);
    it := iptr^;
  END;
  RETURN FALSE;
END DelItem;

(*-------------------------------------------------------------------------*)

(*
 *  menuclear
 *  menuadd     header  item    command
 *  menudel     header  item
 *  menudelhdr  header
 *)

PROCEDURE dMenuOff*;
BEGIN
  MenuOff;
  INC(DoMenuoffCnt);
END dMenuOff;


PROCEDURE dMenuOn*;
BEGIN
  IF DoMenuoffCnt#0 THEN
    DEC(DoMenuoffCnt);
    MenuOn;
  END;
END dMenuOn;


PROCEDURE dMenuAdd*;
VAR
  it: I.IntuiTextPtr;
  menu: I.MenuPtr;
  item: I.MenuItemPtr;
  mpr: POINTER TO I.MenuPtr;
  ipr: POINTER TO I.MenuItemPtr;
  img: I.ImagePtr;

  PROCEDURE NewName(xitem: XItemPtr);    (*  create new name *)
  VAR
    it: I.IntuiTextPtr;
  BEGIN
    it := xitem.item.itemFill;
    IF checkIt IN edG.ArgSet THEN
      xitem.item.flags := {I.itemText,I.itemEnabled,I.highComp,
                           I.checkIt,I.menuToggle};
      it.leftEdge := I.checkWidth;
    ELSE
      xitem.item.flags := {I.itemText,I.itemEnabled,I.highComp};
      it.leftEdge := 0;
    END;
    DISPOSE(xitem.com);
    xitem.com := edL.CopyString(edG.Arg[2]);
  END NewName;

BEGIN
  MenuOff;
  IF seperator IN edG.ArgSet THEN
    edG.Arg[2] := NIL; (* einfachste Weg *)
  END;
  LOOP (* Dummy *)
    mpr := s.ADR(Menu);
    menu := Menu;
    WHILE menu # NIL DO
      IF edG.Arg[0]^ = menu.menuName^ THEN
        ipr := s.ADR(menu.firstItem);
        item := ipr^;
        WHILE item # NIL DO
          (* bei <seperator> wird einfach das letzte item genommem
           *)
          IF NOT (seperator IN edG.ArgSet) AND (I.itemText IN item.flags) THEN
            it := item.itemFill;
            IF edG.Arg[1]^ = it.iText^ THEN
               NewName(item(XItem));
               MenuOn;
               RETURN;
            END;
          END;
          ipr := s.ADR(item.nextItem);
          item := ipr^;
        END;
        EXIT;
      END;
      mpr := s.ADR(menu.nextMenu);
      menu := mpr^;
    END;
    (*
     * Create new Menu
     *)
    ol.New(menu,s.SIZE(I.Menu));
    IF menu = NIL THEN
      INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
      MenuOn;
      RETURN;
    END;
    menu.nextMenu := mpr^;
    mpr^ := menu;
    menu.flags := {I.menuEnabled};
    menu.menuName := s.VAL(e.STRPTR,edL.CopyString(edG.Arg[0]));
    ipr := s.ADR(menu.firstItem);
    ipr^ := NIL;
    EXIT;
  END; (* Dummy-Loop *)
  (*
   * Create New Item
   *)
  IF NOT (seperator IN edG.ArgSet) THEN
    ol.New(item,s.SIZE(XItem)+SIZE(I.IntuiText));
  ELSE
    ol.New(item,s.SIZE(XItem)+SIZE(I.Image));
  END;
  IF item = NIL THEN
    INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
    MenuOn;
    RETURN;
  END;
  item.nextItem := ipr^; ipr^ := item; (* verketten *)
  item.itemFill := s.VAL(s.ADDRESS,s.VAL(LONGINT,item)+SIZE(XItem));
  IF NOT (seperator IN edG.ArgSet) THEN
    it := item.itemFill;
    it.iText := edL.CopyString(edG.Arg[1]);
    it.backPen := 1;
    it.drawMode := g.jam2;
    item.height := edG.Screen.rastPort.font.ySize+2;
    NewName(item(XItem));
  ELSE
    img := item.itemFill;
    img^ := SeperatorImage;
    item.flags := I.highNone;
    item.leftEdge := 2;
    item.height  := 5;
  END;
  MenuOn;
END dMenuAdd;


PROCEDURE dMenuDelHdr*;
VAR
  menu: I.MenuPtr;
  mpr: POINTER TO I.MenuPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  MenuOff;
  mpr := s.ADR(Menu);
  menu := mpr^;
  WHILE menu # NIL DO
    IF edG.Arg[0]^ = menu.menuName^ THEN
      WHILE (menu.firstItem # NIL)
      AND DelItem(menu,menu.firstItem(XItem)) DO
      END;
      mpr^ := menu.nextMenu;
      DISPOSE(menu.menuName);
      DISPOSE(menu);
      MenuOn;
      RETURN;
    END; (* IF edG.Arg[0]^ = menu.menuName^ *)
    mpr := s.ADR(menu.nextMenu);
    menu := mpr^;
  END;
  MenuOn;
END dMenuDelHdr;


PROCEDURE dMenuDel*;
VAR
  menu: I.MenuPtr;
  item: I.MenuItemPtr;
  ipr: POINTER TO I.MenuItemPtr;
  it: I.IntuiTextPtr;
  xitem: XItemPtr;
BEGIN
  MenuOff;
  menu := Menu;
  WHILE menu# NIL DO
    IF edG.Arg[0]^ = menu.menuName^ THEN
      ipr := s.ADR(menu.firstItem); (* dahin gehört der Nachfolger *)
      item := ipr^;
      WHILE item # NIL DO
        it := item.itemFill;
        IF edG.Arg[1]^ = it.iText^ THEN
          IF NOT DelItem(menu,item(XItem)) THEN
            dMenuDelHdr; END;
          MenuOn;
          RETURN;
        END;
        ipr := s.ADR(item.nextItem);
        item := ipr^;
      END;
    END;
    menu := menu.nextMenu;
  END;
  MenuOn;
END dMenuDel;


PROCEDURE dMenuClear*;
BEGIN
  MenuOff;
  WHILE Menu # NIL DO
    edG.Arg[0] := s.VAL(e.ADDRESS,Menu.menuName);
    dMenuDelHdr;
  END;
  MenuOn;
END dMenuClear;


PROCEDURE dCheckItem*;
VAR
 xi: XItemPtr;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  xi := FindMenu(edG.Arg[0]);
  IF xi = NIL THEN
    edG.Rc := edE.cmdFailed; RETURN; END;
  IF xi = ItemPicked THEN
    edG.Rc := edE.cmdValid1; RETURN; END;
  IF set IN edG.ArgSet THEN
    INCL(xi.item.flags,I.checked);
  ELSIF reset IN edG.ArgSet THEN
    EXCL(xi.item.flags,I.checked);
  ELSE
    xi.item.flags := xi.item.flags / {I.checked};
  END;
END dCheckItem;


BEGIN
  Menu := NIL; MenuoffCnt := 0; DoMenuoffCnt := 0;
CLOSE
  MenuOff;
  (*dMenuClear;   DISPOSE macht Laufzeitsystem selbst *)
END EdMenu.