{$R-,S-,I-}

{*********************************************************}
{*		     MAKEMENU.PAS 4.03			 *}
{*	       Menu building utility for MIK		 *}
{*     An example program for Turbo Professional 4.0	 *}
{*	  Copyright (c) TurboPower Software 1987.	 *}
{*		 Updated by Jara-Biry 1989.		 *}
{* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
{*     and used under license to TurboPower Software	 *}
{*		   All rights reserved. 		 *}
{*********************************************************}

program MakeMenu;
  {-Utility to build Turbo Professional menu systems}

uses
  Util,
  TPCrt,
  TPString,
  TPEdit,
  TPMenu;

const
  {Descriptors for the make menu}
  {FrameColor, HeaderColor, BodyColor, SelectColor, HiliteColor, HelpColor}
  Colors : MenuColorArray = ($17, $4E, $1B, $71, $1E, $0E);
  Frame1 : FrameArray = 'ÜÛÜÛÜÛ';
  Frame2 : FrameArray = 'ÜÛÜÛÜÛ';
  PromptAttr : Byte = $0E;
  EditKeys : MenuCharSet = [#32, #$BB..#$C4]; {space, F1..F10}
  AcceptSet : MenuCharSet = [#13, #27, #32];
  HotKeySet : MenuCharSet = [^A, ^c, ^S, ^I, ^N, ^R, ^W, ^G, ^Q, ^D, ^E, ^P];

  {Defaults for user menu}
  UserStartRow : Byte = 2;
  UserFrame : FrameArray = 'ÜÛÜÛÜÛ';
  UserColors : MenuColorArray = ($0E, $2E, $03, $1E, $0B, $0E);
  UserOrient : Orientation = Vertical;
  UserHelpRow : Byte = 1;

  Frames : array[0..6] of FrameArray =
  ('ÜÛÜÛÜÛ',
   'ÉÈ×ØÍÇ',
   'ÚÀÏÙÄÓ',
   'ÂÀÂÙÄÓ',
   '.:.:.:',
   '++++-|',
   LotusFrame
   );

  {.F-}
type
  MakeCommands =	     {codes returned by each menu selection}
  (Mnone,		     {no command}
   Mmenu,		     {main menu root}
     MmenuChoose,	       {select item to edit}
     MmenuNew,		       {make a new menu}
     MmenuSettings,	       {choose base settings for menu}
       MmenuColors,		 {set base colors for menu}
	 MmenuColorFrame,	   {set base color for frame}
	 MmenuColorHeader,	   {set base color for header}
	 MmenuColorBody,	   {set base color for body}
	 MmenuColorSelect,	   {set base color for selected item}
	 MmenuColorHilite,	   {set base color for hilite character}
	 MmenuColorHelp,	   {set base color for help line}
       MmenuFrame,		 {set base frame type for menu}
	 MmenuFrame1,		   {choose base frame type 1}
	 MmenuFrame2,		   {choose base frame type 2}
	 MmenuFrame3,		   {choose base frame type 3}
	 MmenuFrame4,		   {choose base frame type 4}
	 MmenuFrame5,		   {choose base frame type 5}
	 MmenuFrame6,		   {choose base frame type 6}
	 MmenuFrame7,		   {choose base frame type 7}
       MmenuHelpRow,		 {set base help row}
       MmenuOrient,		 {set orientation for submenu}
	 MmenuHoriz,		   {set horizontal orientation}
	 MmenuVert,		   {set vertical orientation}
     MmenuRedraw,	       {redraw menu system}
   Msubmenu,		     {sub menu root}
     MsubAdd,		       {add a new submenu}
     MsubDrag,		       {move existing submenu and its children}
     MsubMove,		       {move an existing submenu}
     MsubSettings,	       {change settings for a submenu}
       MsubColors,		 {set colors for submenu}
	 MsubColorFrame,	   {set color for frame}
	 MsubColorHeader,	   {set color for header}
	 MsubColorBody, 	   {set color for body}
	 MsubColorSelect,	   {set color for selected item}
	 MsubColorHilite,	   {set color for hilite character}
	 MsubColorHelp, 	   {set color for help line}
       MsubFrame,		 {set frame type for submenu}
	 MsubFrame1,		   {choose frame type 1}
	 MsubFrame2,		   {choose frame type 2}
	 MsubFrame3,		   {choose frame type 3}
	 MsubFrame4,		   {choose frame type 4}
	 MsubFrame5,		   {choose frame type 5}
	 MsubFrame6,		   {choose base frame type 6}
	 MsubFrame7,		   {choose base frame type 7}
       MsubHelpRow,		 {set row for help information}
       MsubOrient,		 {set orientation for submenu}
	 MsubHoriz,		   {set horizontal orientation}
	 MsubVert,		   {set vertical orientation}
       MsubHeader,		 {set header for submenu}
     MsubRemove,	       {remove a submenu}
   Mitem,		     {item root}
     MitemAdd,		       {add item to submenu}
     MitemEdit, 	       {edit the name of the item}
     MitemKey,		       {set key for item}
     MitemMove, 	       {move the position of the item}
     MitemHelp, 	       {edit help text for item}
     MitemSelectChar,	       {set selectchar for item}
     MitemRemove,	       {remove item from submenu}
   Mfile,		     {file root}
     MfileRead, 	       {read library file for current menu}
     MfileWrite,	       {write library file for current menu}
     MfileGenerate,	       {write source code for current menu}
     MfilePack, 	       {pack a menu library}
     MfileQuit		       {quit the menu maker}
  );
{.F+}

var
  Make : Menu;		     {menu for make commands}
  User : Menu;		     {menu being made by the user}
  Key : MenuKey;	     {key returned by make command selection}
  Ch : Char;		     {character returned by selection of make command}
  Saved : Boolean;	     {true when user menu has been saved to disk}
  MakeStack : MenuStackP;    {path to current selection on make menu}
  UserStack : MenuStackP;    {path to current selection on user menu}
  Done : Boolean;	     {true when menu editing is complete}
  InitXY : Word;	     {cursor x,y position on entry to program}
  InitSL : Word;	     {cursor scan lines on entry to program}
  LastRead : string;	     {last file name read from}
  LastWrote : string;	     {last file name written to}
  LastId : string;	     {last id string specified}
  Covers : Pointer;	     {line buffer for prompts}

const
  MakeHR = 25;		     {help row for make menu}
  HexChar : array[0..$F] of Char = '0123456789ABCDEF';

  function HexIfA(c : MenuColorType) : string;
    {-Return hex color code if available}
  begin
    if User = nil then
      HexIfA := ''
    else if User^.Active = nil then
      HexIfA := ''
    else
      HexIfA := HexB(User^.Active^.Colors[c]);
  end;

  {$F+}
  function DisplayFunc(S : string; K : MenuKey) : string;
    {-Customizes the display string for each make menu item}
  const
    HorVert : array[Orientation] of Char = ('V', 'H', #0);
  var
    SS : string;
  begin
    case MakeCommands(K) of
      MmenuColorFrame : SS := HexB(UserColors[FrameColor]);
      MmenuColorHeader : SS := HexB(UserColors[HeaderColor]);
      MmenuColorBody : SS := HexB(UserColors[BodyColor]);
      MmenuColorSelect : SS := HexB(UserColors[SelectColor]);
      MmenuColorHilite : SS := HexB(UserColors[HiliteColor]);
      MmenuColorHelp : SS := HexB(UserColors[HelpColor]);
      MsubColorFrame : SS := HexIfA(FrameColor);
      MsubColorHeader : SS := HexIfA(HeaderColor);
      MsubColorBody : SS := HexIfA(BodyColor);
      MsubColorSelect : SS := HexIfA(SelectColor);
      MsubColorHilite : SS := HexIfA(HiliteColor);
      MsubColorHelp : SS := HexIfA(HelpColor);
      MmenuHelpRow : SS := Long2Str(UserHelpRow);
      MmenuOrient : SS := HorVert[UserOrient];
      MitemKey : if User = nil then
		   SS := ''
		 else if User^.Active = nil then
		   SS := ''
		 else if User^.Active^.Items.Current = nil then
		   SS := ''
		 else
		   SS := Long2Str(Integer(User^.Active^.Items.Current^.Key));
    else
      DisplayFunc := S;
      Exit;
    end;
    Move(SS[1], S[Length(S)-Length(SS)], Length(SS));
    DisplayFunc := S;
  end;
  {$F-}

  procedure BuildMakeMenu;
    {-Build the menu system for for MakeMenu}
  begin
    {start a new menu system}
    Make := NewMenu(HotKeySet, @DisplayFunc);

    {add structure to the menu}
    {.F-}
    SubMenu(7, 9, MakeHR, Horizontal, Frame1, Colors, ' TP Menu Maker for MIK character set ');
      MenuItem(' Main menu ', 2, 2, Ord(Mmenu), ' Create a new menu, choose item to edit, or select base settings');
      SubMenu(8, 11, MakeHR, Vertical, Frame2, Colors, '');
	MenuItem('Choose ^C', 1, 1, Ord(MmenuChoose), ' Browse the menu and select the current item to edit');
	MenuItem('New    ^N', 2, 1, Ord(MmenuNew), ' Create a new menu. Be sure to save any existing menu first');
	MenuItem('Settings', 3, 1, Ord(MmenuSettings), ' Select base colors, frame, orientation and help row for this menu');
	SubMenu(14, 15, MakeHR, Vertical, Frame1, Colors, '');
	  MenuItem('Colors', 1, 1, Ord(MmenuColors), ' Choose base colors for frame, title, body, select, hilite, help');
	  SubMenu(22, 17, MakeHR, Vertical, Frame1, Colors, '');
	    MenuItem('Frame', 1, 1, Ord(MmenuColorFrame), ' Choose base color for menu frames');
	    MenuItem('Title', 2, 1, Ord(MmenuColorHeader), ' Choose base color for menu title strings');
	    MenuItem('Body', 3, 1, Ord(MmenuColorBody), ' Choose base color for unselected menu items');
	    MenuItem('Selected   ', 4, 1, Ord(MmenuColorSelect), ' Choose base color for selected menu items');
	    MenuItem('Pick', 5, 1, Ord(MmenuColorHilite), ' Choose base color for character highlighted to pick item');
	    MenuItem('Help', 6, 1, Ord(MmenuColorHelp), ' Choose base color for help lines');
	    PopSubLevel;
	  MenuItem('Frame', 2, 1, Ord(MmenuFrame), ' Choose base type of frame for submenus');
	  SubMenu(22, 16, MakeHR, Vertical, Frame1, Colors, '');
	    MenuItem('1 ÜÛÜÛÜÛ', 1, 1, Ord(MmenuFrame1), ' Select bold bar border');
	    MenuItem('2 ÉÈ×ØÍÇ', 2, 1, Ord(MmenuFrame2), ' Select double bar border');
	    MenuItem('3 ÚÀÏÙÄÓ', 3, 1, Ord(MmenuFrame3), ' Select single bar border');
	    MenuItem('4 ÂÀÂÙÄÓ', 4, 1, Ord(MmenuFrame4), ' Select single bar border to attach to pulldown menu');
	    MenuItem('5 .:.:.:', 5, 1, Ord(MmenuFrame5), ' Select dot bar border');
	    MenuItem('6 ++++-|', 6, 1, Ord(MmenuFrame6), ' Select dash bar border');
	    MenuItem('7 None  ', 7, 1, Ord(MmenuFrame7), ' Select no border (Lotus style menus)');
	    PopSubLevel;
	  MenuItem('Help row', 3, 1, Ord(MmenuHelpRow), ' Select base row to display help');
	  MenuItem('Orientation  ', 4, 1, Ord(MmenuOrient), ' Select base orientation - horizontal or vertical');
	  SubMenu(22, 20, MakeHR, Vertical, Frame1, Colors, '');
	    MenuItem('Horizontal', 1, 1, Ord(MmenuHoriz), ' Menus scroll horizontally');
	    MenuItem('Vertical', 2, 1, Ord(MmenuVert), ' Menus scroll vertically');
	    PopSubLevel;
	  PopSubLevel;
	MenuItem('Redraw', 4, 1, Ord(MmenuRedraw), ' Redraw screen if it becomes corrupted');
	PopSubLevel;
      MenuItem(' Sub menu ', 21, 2, Ord(Msubmenu), ' Add, move or remove a submenu, or change current submenu settings');
      SubMenu(27, 11, MakeHR, Vertical, Frame2, Colors, '');
	MenuItem('Add   ^S', 1, 1, Ord(MsubAdd), ' Add a new submenu to the current item');
	MenuItem('Drag  ^D', 2, 1, ord(MsubDrag), ' Change screen position of submenu and all descendents');
	MenuItem('Settings', 3, 1, Ord(MsubSettings), ' Change the color, frame, orientation, header, or help row');
	SubMenu(34, 15, MakeHR, Vertical, Frame1, Colors, '');
	  MenuItem('Colors', 1, 1, Ord(MsubColors), ' Change colors for frame, title, body, select, hilite, or help');
	  SubMenu(42, 17, MakeHR, Vertical, Frame1, Colors, '');
	    MenuItem('Frame', 1, 1, Ord(MsubColorFrame), ' Change color of menu frame');
	    MenuItem('Title', 2, 1, Ord(MsubColorHeader), ' Change color of menu title string');
	    MenuItem('Body', 3, 1, Ord(MsubColorBody), ' Change color of unselected menu item');
	    MenuItem('Selected   ', 4, 1, Ord(MsubColorSelect), ' Change color of selected menu item');
	    MenuItem('Pick', 5, 1, Ord(MsubColorHilite), ' Change color of character highlighted to pick item');
	    MenuItem('Help', 6, 1, Ord(MsubColorHelp), ' Change color of help lines');
	    PopSubLevel;
	  MenuItem('Frame', 2, 1, Ord(MsubFrame), ' Choose type of frame for this submenu');
	  SubMenu(42, 16, MakeHR, Vertical, Frame1, Colors, '');
	    MenuItem('1 ÜÛÜÛÜÛ', 1, 1, Ord(MsubFrame1), ' Select bold bar border');
	    MenuItem('2 ÉÈ×ØÍÇ', 2, 1, Ord(MsubFrame2), ' Select double bar border');
	    MenuItem('3 ÚÀÏÙÄÓ', 3, 1, Ord(MsubFrame3), ' Select single bar border');
	    MenuItem('4 ÂÀÂÙÄÓ', 4, 1, Ord(MsubFrame4), ' Select single bar border to attach to pulldown menu');
	    MenuItem('5 .:.:.:', 5, 1, Ord(MsubFrame5), ' Select dot bar border');
	    MenuItem('6 ++++-|', 6, 1, Ord(MsubFrame6), ' Select dash bar border');
	    MenuItem('7 None  ', 7, 1, Ord(MsubFrame7), ' Select no border (Lotus style menus)');
	    PopSubLevel;
	  MenuItem('Help row', 3, 1, Ord(MsubHelpRow), ' Select row to display help');
	  MenuItem('Orientation', 4, 1, Ord(MsubOrient), ' Select orientation of menu - horizontal or vertical');
	  SubMenu(42, 20, MakeHR, Vertical, Frame1, Colors, '');
	    MenuItem('Horizontal', 1, 1, Ord(MsubHoriz), ' Menus scroll horizontally');
	    MenuItem('Vertical', 2, 1, Ord(MsubVert), ' Menus scroll vertically');
	    PopSubLevel;
	  MenuItem('Title', 5, 1, Ord(MsubHeader), ' Edit title string for menu');
	  PopSubLevel;
	MenuItem('Move', 4, 1, Ord(MsubMove), ' Change the screen position of a single submenu');
	MenuItem('Remove', 5, 1, Ord(MsubRemove), ' Delete all descendents of the current item');
	PopSubLevel;
      MenuItem(' Item ', 41, 2, Ord(Mitem), ' Add, move, edit or remove a menu item');
      SubMenu(43, 11, MakeHR, Vertical, Frame2, Colors, '');
	MenuItem('Add      ^I', 1, 1, Ord(MitemAdd), ' Add a new item to the current submenu');
	MenuItem('Edit     ^E', 2, 1, Ord(MitemEdit), ' Edit the name of the current item');
	MenuItem('Move     ^A', 3, 1, Ord(MitemMove), ' Adjust the position of the current item');
	MenuItem('Key', 4, 1, Ord(MitemKey), ' Enter a numeric key value returned when item is selected');
	MenuItem('Help', 5, 1, Ord(MitemHelp), ' Edit the help line for the current item');
	MenuItem('Select char', 6, 1, Ord(MitemSelectChar), ' Change the selection character for the current item');
	MenuItem('Remove', 7, 1, Ord(MitemRemove), ' Remove the current item');
	PopSubLevel;
      MenuItem(' File ', 61, 2, Ord(Mfile), ' Read or write menus to disk, or quit the menu maker');
      SubMenu(53, 11, MakeHR, Vertical, Frame2, Colors, '');
	MenuItem('Read lib        ^R', 1, 1, Ord(MfileRead), ' Read a menu from a menu library');
	MenuItem('Write lib       ^W', 2, 1, Ord(MfileWrite), ' Write the current menu to a menu library');
	MenuItem('Generate source ^G', 3, 1, Ord(MfileGenerate), ' Generate Pascal source code to generate the current menu');
	MenuItem('Pack lib        ^P', 4, 1, Ord(MfilePack), ' Pack an existing menu library, removing obsolete menus');
	MenuItem('Quit            ^Q', 5, 1, Ord(MfileQuit), ' Quit the Turbo Professional menu maker');
	PopSubLevel;
      PopSubLevel;
    {.F+}
    ResetMenu(Make);
  end;

  procedure Initialize;
    {-Initialize globals and screen}
  begin
    User := nil;
    UserStack := nil;
    MakeStack := nil;
    Saved := True;
    LastRead := '';
    LastWrote := '';
    LastId := '';
    TrimBlanks := False;

    {Line buffer for prompts}
    GetMem(Covers, 160);

    ClrScr;
    GetCursorState(InitXY, InitSL);
    if HideCursor then
      HiddenCursor;
  end;

  function ReadChar(var Scan : Char) : Char;
    {-Read a character and scan code if any}
  var
    Ch : Char;
  begin
    Ch := ReadKey;
    if Ch = #0 then
      Scan := ReadKey
    else
      Scan := #0;
    ReadChar := Ch;
  end;

  function Confirm(msg : string) : Boolean;
    {-Write a message to confirm an operation}
  var
    XY : Word;
    ScanLines : Word;
  begin
    {Store contents of screen underneath where we'll write}
    if SaveWindow(1, 25, 80, 25, False, Covers) then
      {Won't fail} ;
    GetCursorState(XY,ScanLines);
    ClearWindow(1, 25, 80, 25, PromptAttr);
    Confirm := YesOrNo(msg, 25, 1, PromptAttr, 'N');
    RestoreWindow(1, 25, 80, 25, False, Covers);
    RestoreCursorState(XY,ScanLines);
  end;

  function NoSave : Boolean;
    {-Check for unsaved menu, prompt whether to save}
  begin
    if Saved then
      NoSave := True
    else
      NoSave := Confirm('Current menu not saved. Abandon changes?');
  end;

  procedure PressEsc(msg : string);
    {-Display a message and wait for <Esc> to continue}
  var
    Ch : Char;
    XY : Word;
    ScanLines : Word;
  begin
    {Store contents of screen underneath where we'll write}
    if SaveWindow(1, 25, 80, 25, False, Covers) then
      {Won't fail} ;
    GetCursorState(XY,ScanLines);
    ClearWindow(1, 25, 80, 25, PromptAttr);
    ReadCharacter(msg+' Press <Esc> to continue', 25, 1, PromptAttr, [#27], Ch);
    RestoreWindow(1, 25, 80, 25, False, Covers);
    RestoreCursorState(XY,ScanLines);
  end;

  function PromptString(Prompt, Default : string) : string;
    {-Prompt for and return a string}
  var
    S : string;
    Escaped : Boolean;
  begin
    {Store contents of screen underneath where we'll write}
    if SaveWindow(1, 25, 80, 25, False, Covers) then
      {Won't fail} ;
    S := Default;
    ReadString(Prompt+' ', 25, 1, 77-Length(Prompt), PromptAttr, PromptAttr,
      PromptAttr, Escaped, S);
    PromptString := S;
    RestoreWindow(1, 25, 80, 25, False, Covers);
  end;

  function PromptInteger(Prompt : string; Default : Integer) : Integer;
    {-Prompt for and return integer}
  var
    I : Integer;
    Escaped : Boolean;
  begin
    {Store contents of screen underneath where we'll write}
    if SaveWindow(1, 25, 80, 25, False, Covers) then
      {Won't fail} ;
    I := Default;
    ReadInteger(Prompt+' ', 25, 1, 77-Length(Prompt), PromptAttr, PromptAttr,
		0, 32767, Escaped, I);
    if Escaped then
      PromptInteger := Default
    else
      PromptInteger := I;
    RestoreWindow(1, 25, 80, 25, False, Covers);
  end;

  procedure Help(msg : string);
    {-Write a help message on the prompt row}
  begin
    FastWrite(msg, 25, 1, PromptAttr);
  end;

  function HaveActive : Boolean;
    {-Assure active menu exists. Otherwise report error and return false}
  begin
    HaveActive := False;
    if User = nil then
      PressEsc('Create new menu first.')
    else if User^.Active = nil then
      PressEsc('Create a submenu first.')
    else
      HaveActive := True;
  end;

  function FirstNonBlank(S : string) : Byte;
    {-Return position of first non-blank character in s, 1 if none}
  var
    I : Word;
  begin
    for I := 1 to Length(S) do
      if S[I] > ' ' then begin
	FirstNonBlank := I;
	Exit;
      end;
    FirstNonBlank := 1;
  end;

  procedure Undraw;
    {-Undo the screen, storing the state of both menus}
  begin
    EraseMenuOntoStack(Make, MakeStack);
    if User <> nil then
      EraseMenuOntoStack(User, UserStack)
    else
      UserStack := nil;
  end;

  procedure Redraw;
    {-Redraw the screen, restoring the state of both menus}
  begin
    if UserStack <> nil then
      DrawMenuFromStack(User, UserStack);
    DrawMenuFromStack(Make, MakeStack);
  end;

  procedure ClearUserStack;
    {-Dispose of space for user stack}
  var
    P : MenuStackP;
  begin
    while UserStack <> nil do begin
      P := UserStack^.Next;
      FreeMem(UserStack, SizeOf(MenuStackRec));
      UserStack := P;
    end;
  end;

  procedure PushRootMenuOntoStack;
    {-Put the root menu onto the user display stack}
  begin
    {Put root menu onto temporary stack}
    GetMem(UserStack, SizeOf(MenuStackRec));
    UserStack^.Top := User^.Root;
    UserStack^.Next := nil;
    {Put root menu onto active stack}
    PushSubMenu(User, User^.Root);
  end;

  procedure AdjustXY(SubMnu : SubMenuP; SetDisp : Boolean);
    {-Adjust the dimensions and items of a menu after changes}
  var
    Item : ItemP;
    MinH : Byte;
    Disp : Byte;
  begin
    with SubMnu^ do begin
      XH := XL+3*FrameDelta[LotusStyle];

      if Orient = Vertical then begin
	{Space for two horizontal bars}
	YH := Pred(YL)+(FrameDelta[LotusStyle] shl 1);
	Disp := 1;
      end else begin
	{Space for two horizontal bars plus one row of items}
	YH := YL+(FrameDelta[LotusStyle] shl 1);
	Disp := 2;
      end;

      Item := Items.First;
      while Item <> nil do begin
	{Handle automatic window sizing}
	with Item^ do
	  case Orient of
	    Horizontal :
	      begin
		if SetDisp then
		  DisplayPos := Disp;
		MinH := FrameDelta[LotusStyle]+XL+DisplayPos+Byte(Name^);
		Inc(Disp, Byte(Name^)+2);
	      end;
	    Vertical :
	      begin
		{Add a row for the new item}
		Inc(YH);
		MinH := Pred(XL)+Byte(Name^)+4*FrameDelta[LotusStyle];
		if SetDisp then
		  DisplayPos := Disp;
		Inc(Disp);
	      end;
	  end;
	if XH < MinH then
	  XH := MinH;

	Item := Item^.Next;
      end;
    end;
  end;

  procedure SetActiveFrame(F : FrameArray; SubMnu : SubMenuP);
    {-Change the frame type of the specified submenu}
  begin
    Undraw;
    with SubMnu^ do begin
      LotusStyle := (F = LotusFrame);
      Frame := F;
      AdjustXY(SubMnu, True);
    end;
    Redraw;
  end;

  procedure SetFrameSubMenu(SubMnu : SubMenuP);
    {-Change the frame type of specified menu and its children}
  var
    P : ItemP;
  begin
    with SubMnu^ do begin
      LotusStyle := (UserFrame = LotusFrame);
      Frame := UserFrame;
      AdjustXY(SubMnu, True);
      {Scan the list of items}
      P := Items.First;
      while P <> nil do begin
	with P^ do
	  if Sub <> nil then
	    {Recolor this item's submenu}
	    SetFrameSubMenu(Sub);
	{Get next item}
	P := P^.Next;
      end;
    end;
  end;

  procedure UpdateFrames;
    {-Update the frames of active menu and children}
  var
    SubMnu : SubMenuP;
  begin
    SubMnu := User^.Active;
    Undraw;
    {Update frames of current menu and all children}
    SetFrameSubMenu(SubMnu);
    Redraw;
    Saved := False;
  end;

  procedure SetHelpRowSubMenu(SubMnu : SubMenuP; HRow : Integer);
    {-Set the help row for submnu and its children}
  var
    P : ItemP;
  begin
    with SubMnu^ do begin
      YHelp := HRow;
      {Scan the list of items}
      P := Items.First;
      while P <> nil do begin
	with P^ do
	  if Sub <> nil then
	    {Recolor this item's submenu}
	    SetHelpRowSubMenu(Sub, HRow);
	{Get next item}
	P := P^.Next;
      end;
    end;
  end;

  procedure ShiftXY(SubMnu : SubMenuP; DX, DY : Integer; recursive : Boolean);
    {-Change coordinates of a menu and its children by DX,DY}
  var
    P : ItemP;
  begin
    with SubMnu^ do begin

      {Change the menu borders}
      Inc(XL, DX);
      Inc(XH, DX);
      Inc(YL, DY);
      Inc(YH, DY);

      if recursive then begin
	{Scan its items for submenus}
	P := Items.First;
	while P <> nil do begin
	  if P^.Sub <> nil then
	    ShiftXY(P^.Sub, DX, DY, recursive);
	  P := P^.Next;
	end;
      end;
    end;
  end;

  procedure DragMenu(SubMnu : SubMenuP; recursive : Boolean);
    {-Interactively move a submenu}
  var
    Ch : Char;
    Scan : Char;
  begin

    {Erase the Make menu}
    EraseMenuOntoStack(Make, MakeStack);

    {Write some help}
    Help('Use cursor keys to move. Press <Enter> or <Space> to accept');
    {Update cursor}
    DrawItem(SubMnu, SubMnu^.Items.Current, nil);

    repeat

      Ch := ReadChar(Scan);

      with SubMnu^ do
	case Scan of
	  #75 : 	     {left}
	    if XL > 1 then begin
	      EraseSubMenu(SubMnu);
	      ShiftXY(SubMnu, -1, 0, recursive);
	      DrawSubMenu(SubMnu, nil);
	    end;

	  #77 : 	     {right}
	    if XH < CurrentWidth then begin
	      EraseSubMenu(SubMnu);
	      ShiftXY(SubMnu, 1, 0, recursive);
	      DrawSubMenu(SubMnu, nil);
	    end;

	  #72 : 	     {up}
	    if YL > FrameDelta[LotusStyle] then begin
	      EraseSubMenu(SubMnu);
	      ShiftXY(SubMnu, 0, -1, recursive);
	      DrawSubMenu(SubMnu, nil);
	    end;

	  #80 : 	     {down}
	    if YH <= CurrentHeight then begin
	      EraseSubMenu(SubMnu);
	      ShiftXY(SubMnu, 0, 1, recursive);
	      DrawSubMenu(SubMnu, nil);
	    end;

	end;
    until (Ch in AcceptSet);

    DrawMenuFromStack(Make, MakeStack);

  end;

  procedure MoveItem(SubMnu : SubMenuP);
    {-Interactively move an item in a menu}
  var
    Ch : Char;
    Scan : Char;
  begin

    {Erase the Make menu}
    EraseMenuOntoStack(Make, MakeStack);

    {Write some help}
    Help('Use cursor keys to move. Press <Enter> or <Space> to accept');

    with SubMnu^, Items.Current^ do
      repeat

	Ch := ReadChar(Scan);

	with SubMnu^ do
	  case Scan of
	    #75 :	     {left}
	      if Orient = Horizontal then
		if DisplayPos > 1 then begin
		  EraseSubMenu(SubMnu);
		  Dec(DisplayPos);
		  AdjustXY(SubMnu, False);
		  DrawSubMenu(SubMnu, nil);
		end;

	    #77 :	     {right}
	      if Orient = Horizontal then
		if XL+DisplayPos+Byte(Name^)+2*FrameDelta[LotusStyle] < CurrentWidth then begin
		  EraseSubMenu(SubMnu);
		  Inc(DisplayPos);
		  AdjustXY(SubMnu, False);
		  DrawSubMenu(SubMnu, nil);
		end;
	  end;
      until (Ch in AcceptSet);

    DrawMenuFromStack(Make, MakeStack);

  end;

  procedure MoveSelect(SubMnu : SubMenuP);
    {-Interactively move the select char of an item in a menu}
  var
    Ch : Char;
    Scan : Char;
    ItemC : ItemP;
    X : byte;
    Y : byte;
  begin

    {Erase the Make menu}
    EraseMenuOntoStack(Make, MakeStack);

    {Save the current item, and force current item to nil}
    ItemC := SubMnu^.Items.Current;
    DrawItem(SubMnu, ItemC, nil);
    X := WhereXAbs;
    Y := WhereYAbs;
    SubMnu^.Items.Current := nil;
    DrawItem(SubMnu, ItemC, nil);
    Help('Use cursor keys to move. Press <Enter> or <Space> to accept');

    with ItemC^ do
      repeat

	GotoXYAbs(X+SelectPos, WhereYAbs);
	Ch := ReadChar(Scan);
	case Scan of
	  #75 : 	     {left}
	    if SelectPos > 0 then begin
	      Dec(SelectPos);
	      DrawItem(SubMnu, ItemC, nil);
	    end;

	  #77 : 	     {right}
	    if SelectPos < Byte(Name^) then begin
	      Inc(SelectPos);
	      DrawItem(SubMnu, ItemC, nil);
	    end;
	end;
      until (Ch in AcceptSet);

    SubMnu^.Items.Current := ItemC;
    DrawItem(SubMnu, ItemC, nil);
    Help(Pad('', CurrentWidth));
    DrawMenuFromStack(Make, MakeStack);
  end;

  procedure AddItem(SubMnu : SubMenuP; var S, T : string);
    {-Add a new item to a submenu}
  var
    P : ItemP;
    X : Byte;
    XLast : Byte;

    function EndOf(P : ItemP) : Byte;
      {-Return the x displacement of the end of the item}
    begin
      EndOf := P^.DisplayPos+Byte(P^.Name^)+2;
    end;

  begin
    with SubMnu^ do begin
      {Determine a reasonable display offset for the item}
      with Items do
	if Current = nil then
	  {First item in submenu}
	  X := 1

	else if Orient = Horizontal then begin
	  {Get end of current item}
	  X := EndOf(Current);
	  {Shift any other items as needed}
	  XLast := X+Length(S)+4;
	  P := Current^.Next;
	  while P <> nil do begin
	    if P^.DisplayPos < XLast then
	      P^.DisplayPos := XLast;
	    XLast := EndOf(P);
	    P := P^.Next;
	  end;

	end else begin
	  {Insert after the current item}
	  X := Succ(Current^.DisplayPos);
	  {Shift any other items down}
	  P := Current^.Next;
	  while P <> nil do begin
	    Inc(P^.DisplayPos);
	    P := P^.Next;
	  end;
	end;

      Undraw;
      MenuItem(S, X, FirstNonBlank(S), 0, t);
      if MenuStatus <> MenuSuccess then
	PressEsc('Unable to add new item.')
      else begin
	Saved := False;
	User^.Visible := True;
      end;
      Redraw;

    end;
  end;

  procedure RemoveSubMenu(SubMnu : SubMenuP);
    {-Remove a submenu and its children from the user menu}
  begin
    with SubMnu^.Items do
      if Current <> nil then
	if Current^.Sub <> nil then
	  DisposeSubMenu(Current^.Sub);
  end;

  procedure RemoveItem(SubMnu : SubMenuP);
    {-Remove the current item from a submenu}
  var
    P : ItemP;
  begin
    Undraw;
    with SubMnu^ do begin
      P := Items.Current;
      if P <> nil then begin

	{Dispose of the item}
	with P^ do begin
	  if OnHeap then begin
	    {Dispose heap space for item name and help}
	    DisposeString(Name);
	    DisposeString(Help);
	  end;
	  if Sub <> nil then begin
	    {Dispose of this item's submenu}
	    DisposeSubMenu(Sub);
	    Sub := nil;
	  end;
	end;

	{Link around the deleted item}
	if P^.Next <> nil then
	  P^.Next^.Prev := P^.Prev;
	if P^.Prev <> nil then
	  P^.Prev^.Next := P^.Next;
	if P = Items.First then
	  Items.First := P^.Next;
	if P = Items.Last then
	  Items.Last := P^.Prev;
	if P^.Next <> nil then
	  Items.Current := P^.Next
	else
	  Items.Current := P^.Prev;

	{Dispose of this item}
	FreeMem(P, SizeOf(ItemRec));

	{Adjust the menu for the loss of the item}
	AdjustXY(SubMnu, True);
      end;
    end;
    Redraw;
  end;

  procedure SetColorSubMenu(SubMnu : SubMenuP);
    {-Set colors for submenu and children to UserColor set}
  var
    P : ItemP;
  begin
    with SubMnu^ do begin
      Colors := UserColors;
      {Scan the list of items}
      P := Items.First;
      while P <> nil do begin
	with P^ do
	  if Sub <> nil then
	    {Recolor this item's submenu}
	    SetColorSubMenu(Sub);
	{Get next item}
	P := P^.Next;
      end;
    end;
  end;

  procedure PromptForColor(var Color : Byte);
    {-Choose a color from a menu, using initial Color as default}
  const
    Xw = 60;
    Yw = 15;
    Unsel = #4;
    Sel = #8;
    Def = #254;
  var
    F : Byte;
    b : Byte;
    Fdef : Byte;
    Bdef : Byte;
    Covers : Pointer;
    Ch : Char;
    Scan : Char;
    XY : Word;
    ScanLines : Word;

    procedure DrawColor(F, b : Byte; Ch : Char);
      {-Draw one entry of the color map}
    begin
      FastWrite(Ch, Succ(Yw+b), Succ(Xw+F), (b shl 4) or F);
    end;

    procedure DrawMap;
      {-Draw the complete color map}
    var
      F : Byte;
      b : Byte;
    begin
      for F := 0 to 15 do
	for b := 0 to 7 do
	  DrawColor(F, b, Unsel);
    end;

  begin

    {Initialize the window}
    if not(SaveWindow(Xw, Yw, Xw+17, Yw+9, True, Covers)) then begin
      PressEsc('Insufficient memory');
      Exit;
    end;
    GetCursorState(XY,ScanLines);
    ClearWindow(Xw, Yw, Xw+17, Yw+9, Colors[BodyColor]);
    DrawFrame(Xw, Yw, Xw+17, Yw+9, Colors[FrameColor], Frame1);

    {Draw the initial color map}
    DrawMap;

    {Save default color}
    Fdef := Color and $F;
    Bdef := Color shr 4;
    F := Fdef;
    b := Bdef;

    repeat

      {Pass back currently selected color and mark current position}
      Color := (b shl 4) or F;
      DrawColor(F, b, Sel);
      GotoXYAbs(Succ(Xw+F), Succ(Yw+b));

      Ch := ReadChar(Scan);

      {Clear the previous selection}
      if (F = Fdef) and (b = Bdef) then
	DrawColor(F, b, Def)
      else
	DrawColor(F, b, Unsel);

      case Scan of
	#75 :		     {left}
	  if F > 0 then
	    Dec(F)
	  else
	    F := 15;
	#77 :		     {right}
	  if F < 15 then
	    Inc(F)
	  else
	    F := 0;
	#72 :		     {up}
	  if b > 0 then
	    Dec(b)
	  else
	    b := 7;
	#80 :		     {down}
	  if b < 7 then
	    Inc(b)
	  else
	    b := 0;
	#0 :
	  if Ch = #27 then
	    {Restore to default}
	    Color := (Bdef shl 4) or Fdef;
      end;

    until (Ch in AcceptSet);

    {Restore the screen}
    RestoreWindow(Xw, Yw, Xw+17, Yw+9, True, Covers);
    RestoreCursorState(XY,ScanLines);
  end;

  function MenuGenerate(Fname : string) : Boolean;
    {-Generate source code for the current user menu}
  const
    MaxFrames = 10;
    MaxColors = 40;
    Quote = #39;
  var
    F : Text;
    I : Word;
    NumFrames : Integer;
    OFrames : array[1..MaxFrames] of FrameArray;
    NumColors : Integer;
    OColors : array[1..MaxColors] of MenuColorArray;
    c : MenuColorType;
    Fr : FrameCharType;
    NestLevel : Integer;

    function MatchesFrame(var Frame : FrameArray; var num : Integer) : Boolean;
      {-Return true and frame number if frame matches a frame already stored}
    var
      I : Integer;
    begin
      for I := 1 to NumFrames do
	if Frame = OFrames[I] then begin
	  num := I;
	  MatchesFrame := True;
	  Exit;
	end;
      MatchesFrame := False;
    end;

    function MatchesColors(var Colors : MenuColorArray; var num : Integer) : Boolean;
      {-Return true and Colors number if Colors matches any Color already stored}
    var
      I : Integer;
      c : MenuColorType;
      matches : Boolean;
    begin
      for I := 1 to NumColors do begin
	matches := True;
	for c := FrameColor to HelpColor do
	  if Colors[c] <> OColors[I] [c] then
	    matches := False;
	if matches then begin
	  num := I;
	  MatchesColors := True;
	  Exit;
	end;
      end;
      MatchesColors := False;
    end;

    procedure GetArrays(SubMnu : SubMenuP);
      {-Get colors and frame types for submenu and children}
    var
      P : ItemP;
      I : Integer;
    begin
      with SubMnu^ do begin

	{Add frame and color types to the lists}

	if not(MatchesFrame(Frame, I)) then begin
	  Inc(NumFrames);
	  if NumFrames <= MaxFrames then
	    OFrames[NumFrames] := Frame;
	end;

	if not(MatchesColors(Colors, I)) then begin
	  Inc(NumColors);
	  if NumColors <= MaxColors then
	    OColors[NumColors] := Colors;
	end;

	{Scan the list of items and follow submenus}
	P := Items.First;
	while P <> nil do begin
	  with P^ do
	    if Sub <> nil then
	      GetArrays(Sub);
	  {Get next item}
	  P := P^.Next;
	end;
      end;
    end;

    function QuotedString(SPtr : Pointer) : string;
      {-Return a string (perhaps containing quotes) in Pascal format}
    var
      S : string;
      I : integer;
    begin
      S := StringFromHeap(SPtr);
      I := 1;
      while I <= length(S) do begin
	if S[I] = Quote then begin
	  insert(Quote,S,I);
	  inc(I);
	end;
	inc(I);
      end;
      QuotedString := Quote+S+Quote;
    end;

    procedure WriteSubSource(var F : Text; SubMnu : SubMenuP);
      {-Write the source code for one submenu and its children}
    const
      OrientName : array[Orientation] of string[10] = ('Vertical', 'Horizontal', '');
    var
      P : ItemP;
      I : Integer;
    begin
      with SubMnu^ do begin

	{Write the submenu statement}
	Write(F, Pad('', 2*NestLevel), 'SubMenu(', XL, ',', YL, ',', YHelp, ',', OrientName[Orient], ',');
	if MatchesFrame(Frame, I) then
	  Write(F, 'Frame', I, ',');
	if MatchesColors(Colors, I) then
	  Write(F, 'Color', I, ',');
	WriteLn(F, QuotedString(Header), ');');

	Inc(NestLevel);

	{Scan the list of items and follow submenus}
	P := Items.First;
	while P <> nil do begin
	  with P^ do begin

	    {Write source for this item}
	    Write(F, Pad('', 2*NestLevel), 'MenuItem(', QuotedString(Name), ',');
	    WriteLn(F, DisplayPos, ',', SelectPos, ',', Key, ',', QuotedString(Help), ');');

	    {Write its submenu}
	    if Sub <> nil then
	      WriteSubSource(F, Sub);
	  end;
	  {Get next item}
	  P := P^.Next;
	end;

	{Leave this level of submenu}
	WriteLn(F, Pad('', 2*NestLevel), 'PopSublevel;');
	Dec(NestLevel);

      end;
    end;

  begin
    MenuGenerate := False;

    {Open the output file}
    Assign(F, Fname);
    Rewrite(F);
    if IoResult <> 0 then begin
      PressEsc('Unable to create output file '+Fname+'.');
      Exit;
    end;

    {Scan the menu to find the various colors and frames}
    NumColors := 0;
    NumFrames := 0;
    GetArrays(User^.Root);

    {Write the boilerplate source}
    WriteLn(F, 'Uses');
    WriteLn(F, '  TPString,');
    WriteLn(F, '  TPCrt,');
    WriteLn(F, '  TPMenu;');
    WriteLn(F);
    WriteLn(F, 'Procedure __InitMenu(var M : Menu);');
    WriteLn(F, 'Const');

    {Write the list of color items}
    for I := 1 to NumColors do begin
      Write(F, '  Color', I, ' : MenuColorArray = (');
      for c := FrameColor to HelpColor do begin
	Write(F, '$', HexB(OColors[I] [c]));
	if c <> HelpColor then
	  Write(F, ', ');
      end;
      WriteLn(F, ');');
    end;

    {Write the list of frame items}
    for I := 1 to NumFrames do begin
      Write(F, '  Frame', I, ' : FrameArray = ');
      if OFrames[I] = LotusFrame then
	Write(F, 'LotusFrame')
      else begin
	Write(F, Quote);
	for Fr := ULeft to Vert do
	  Write(F, OFrames[I] [Fr]);
	Write(F, Quote);
      end;
      WriteLn(F, ';');
    end;

    {More boilerplate}
    WriteLn(F);
    WriteLn(F, 'begin');
    WriteLn(F, '  {Customize this call for special exit characters and custom item displays}');
    WriteLn(F, '  M := NewMenu([], nil);');
    WriteLn(F);

    {Here we go, write the menu system source}
    NestLevel := 1;
    WriteSubSource(F, User^.Root);

    {More boilerplate}
    WriteLn(F);
    WriteLn(F, '  ResetMenu(M);');
    WriteLn(F, 'end;');

    Close(F);
    I := IoResult;
    MenuGenerate := True;
  end;

  function HandleChoice(cmd : MakeCommands) : Boolean;
    {-Perform an action on the menu being built}
  var
    S : string;
    t : string;
    Ch : Char;
    Key : MenuKey;
    X, Y : Byte;
  begin

    HandleChoice := False;

    case cmd of

      MmenuChoose :	     {select item to edit}
	if HaveActive then begin
	  Undraw;
	  DrawMenuFromStack(User, UserStack);
	  User^.Visible := True;
	  Help('Use cursors, <Enter>, <Esc> to browse. Press <Space> to select item to edit');
	  repeat
	    {Put up the user menu and get a new position to edit}
	    Key := MenuChoice(User, Ch);
	  until (Ch in EditKeys);
	  Help(Pad('', CurrentWidth));
	  EraseMenuOntoStack(User, UserStack);
	  Redraw;
	end;

      MmenuNew :	     {make a new menu}
	if NoSave then begin
	  Undraw;
	  User := NewMenu(EditKeys, nil);
	  ClearUserStack;
	  Redraw;
	  if MenuStatus <> MenuSuccess then begin
	    PressEsc('Unable to create new menu.');
	    User := nil;
	  end else
	    PressEsc('New menu created.');
	  Saved := False;
	end;

      MmenuColorFrame :      {set base color for frame}
	begin
	  PromptForColor(UserColors[FrameColor]);
	  if HaveActive then begin
	    {Update colors of current menu and all children}
	    SetColorSubMenu(User^.Active);
	    Undraw;
	    Redraw;
	    Saved := False;
	  end;
	end;

      MmenuColorHeader :     {set base color for header}
	begin
	  PromptForColor(UserColors[HeaderColor]);
	  if HaveActive then begin
	    {Update colors of current menu and all children}
	    SetColorSubMenu(User^.Active);
	    Undraw;
	    Redraw;
	    Saved := False;
	  end;
	end;

      MmenuColorBody :	     {set base color for body}
	begin
	  PromptForColor(UserColors[BodyColor]);
	  if HaveActive then begin
	    {Update colors of current menu and all children}
	    SetColorSubMenu(User^.Active);
	    Undraw;
	    Redraw;
	    Saved := False;
	  end;
	end;

      MmenuColorSelect :     {set base color for selected item}
	begin
	  PromptForColor(UserColors[SelectColor]);
	  if HaveActive then begin
	    {Update colors of current menu and all children}
	    SetColorSubMenu(User^.Active);
	    Undraw;
	    Redraw;
	    Saved := False;
	  end;
	end;

      MmenuColorHilite :     {set base color for hilite character}
	begin
	  PromptForColor(UserColors[HiliteColor]);
	  if HaveActive then begin
	    {Update colors of current menu and all children}
	    SetColorSubMenu(User^.Active);
	    Undraw;
	    Redraw;
	    Saved := False;
	  end;
	end;

      MmenuColorHelp :	     {set base color for help line}
	begin
	  PromptForColor(UserColors[HelpColor]);
	  if HaveActive then begin
	    {Update colors of current menu and all children}
	    SetColorSubMenu(User^.Active);
	    Undraw;
	    Redraw;
	    Saved := False;
	  end;
	end;

      MmenuFrame1..MmenuFrame7 : {choose base frame type}
	begin
	  UserFrame := Frames[Ord(cmd)-Ord(MmenuFrame1)];
	  if HaveActive then
	    UpdateFrames;
	end;

      MmenuHelpRow :	     {set base help row}
	begin
	  UserHelpRow := PromptInteger('Enter row number for help:', UserHelpRow);
	  if HaveActive then begin
	    Undraw;
	    SetHelpRowSubMenu(User^.Active, UserHelpRow);
	    Redraw;
	  end;
	end;

      MmenuHoriz :	     {set horizontal orientation}
	begin
	  Undraw;
	  UserOrient := Horizontal;
	  Redraw;
	end;

      MmenuVert :	     {set vertical orientation}
	begin
	  Undraw;
	  UserOrient := Vertical;
	  Redraw;
	end;

      MmenuRedraw :	     {refresh screen}
	begin
	  Undraw;
	  ClrScr;
	  Redraw;
	end;

      MsubAdd : 	     {add a new submenu}
	if User = nil then
	  PressEsc('Create new menu first.')
	else begin
	  if User^.Active = nil then begin
	    {The first submenu}
	    X := 1;
	    Y := UserStartRow;
	  end else with User^.Active^ do
	    if Items.Current^.Sub <> nil then begin
	      {A submenu already attached here}
	      PressEsc('Submenu already attached.');
	      Exit;
	    end else if UserFrame = LotusFrame then begin
	      {Assume submenus overwrite one another}
	      X := XL;
	      Y := YL;
	    end else if Orient = Horizontal then begin
	      {Attach new submenu to base of active one}
	      X := XL+Items.Current^.DisplayPos;
	      Y := YH;
	    end else begin
	      {Overlap active vertical menu}
	      X := (XL+XH) shr 1;
	      Y := YL+Items.Current^.DisplayPos+1;
	    end;
	  if X > CurrentWidth-3 then
	    X := CurrentWidth-3;
	  if Y >= CurrentHeight-3 then
	    Y := CurrentHeight-4;
	  SubMenu(X, Y, UserHelpRow, UserOrient, UserFrame, UserColors, '');
	  if MenuStatus <> MenuSuccess then
	    PressEsc('Unable to add submenu.');
	  Undraw;
	  Redraw;
	  Saved := False;
	end;

      MsubMove :	     {move an existing submenu}
	if HaveActive then begin
	  DragMenu(User^.Active, False);
	  Saved := False;
	end;

      MsubColorFrame :	     {set color for active frame}
	if HaveActive then begin
	  PromptForColor(User^.Active^.Colors[FrameColor]);
	  Saved := False;
	  Undraw;
	  Redraw;
	end;

      MsubColorHeader :      {set color for active header}
	if HaveActive then begin
	  PromptForColor(User^.Active^.Colors[HeaderColor]);
	  Saved := False;
	  Undraw;
	  Redraw;
	end;

      MsubColorBody :	     {set color for active body}
	if HaveActive then begin
	  PromptForColor(User^.Active^.Colors[BodyColor]);
	  Saved := False;
	  Undraw;
	  Redraw;
	end;

      MsubColorSelect :      {set color for active selected item}
	if HaveActive then begin
	  PromptForColor(User^.Active^.Colors[SelectColor]);
	  Saved := False;
	  Undraw;
	  Redraw;
	end;

      MsubColorHilite :      {set color for active hilite character}
	if HaveActive then begin
	  PromptForColor(User^.Active^.Colors[HiliteColor]);
	  Saved := False;
	  Undraw;
	  Redraw;
	end;

      MsubColorHelp :	     {set color for active help line}
	if HaveActive then begin
	  PromptForColor(User^.Active^.Colors[HelpColor]);
	  Saved := False;
	  Undraw;
	  Redraw;
	end;

      MsubFrame1..MsubFrame7 : {choose base frame type}
	if HaveActive then begin
	  SetActiveFrame(Frames[Ord(cmd)-Ord(MsubFrame1)], User^.Active);
	  Saved := False;
	end;

      MsubHelpRow :	     {set row for help information}
	if HaveActive then
	  with User^.Active^ do begin
	    Y := PromptInteger('Enter row number for help:', YHelp);
	    Saved := False;
	    Undraw;
	    YHelp := Y;
	    Redraw;
	  end;

      MsubHoriz :	     {set horizontal orientation}
	if HaveActive then begin
	  Undraw;
	  User^.Active^.Orient := Horizontal;
	  AdjustXY(User^.Active, True);
	  Saved := False;
	  Redraw;
	end;

      MsubVert :	     {set vertical orientation}
	if HaveActive then begin
	  Undraw;
	  User^.Active^.Orient := Vertical;
	  AdjustXY(User^.Active, True);
	  Saved := False;
	  Redraw;
	end;

      MsubHeader :	     {set header for submenu}
	if HaveActive then begin
	  with User^.Active^ do begin
	    S := PromptString('Enter string for title:', StringFromHeap(Header));
	    Undraw;
	    if S = '' then
	      Header := nil
	    else begin
	      Header := StringToHeap(S);
	      if Header = nil then
		PressEsc('Unable to store header string.');
	    end;
	  end;
	  Saved := False;
	  Redraw;
	end;

      MsubDrag :	     {move a submenu and its descendants}
	if HaveActive then begin
	  DragMenu(User^.Active, True);
	  Saved := False;
	end;

      MsubRemove :	     {remove a submenu}
	if HaveActive then
	  if Confirm('Are you sure you want to remove descendants?') then begin
	    RemoveSubMenu(User^.Active);
	    Saved := False;
	    PressEsc('Child submenu removed.')
	  end;

      MitemAdd :	     {add item to submenu}
	if HaveActive then begin
	  S := PromptString('Enter name of item:', '');
	  if S = '' then
	    Exit;
	  if User^.Active^.YHelp = 0 then
	    t := ''
	  else
	    t := PromptString('Enter help line for item:', '');
	  AddItem(User^.Active, S, t);
	end;

      MitemEdit :	     {edit the name of the item}
	if HaveActive then begin
	  with User^.Active^, Items.Current^ do begin
	    S := PromptString('Enter new name for item:', StringFromHeap(Name));
	    if S = StringFromHeap(Name) then
	      Exit;
	    Undraw;
	    {Store the new string}
	    if OnHeap then
	      DisposeString(Name);
	    Name := StringToHeap(S);
	    {Check the window size}
	    case Orient of
	      Horizontal : X := XL+FrameDelta[LotusStyle]+DisplayPos+Length(S);
	      Vertical : X := XL+4*FrameDelta[LotusStyle]+Length(S)-1;
	    end;
	    if XH < X then
	      XH := X;
	    {Update the select position}
	    SelectPos := FirstNonBlank(S);
	    Redraw;
	  end;
	  Saved := False;
	end;

      MitemMove :	     {move the position of the item}
	if HaveActive then
	  if User^.Active^.Orient = Horizontal then begin
	    MoveItem(User^.Active);
	    Saved := False;
	  end;

      MitemHelp :	     {edit help text for item}
	if HaveActive then begin
	  with User^.Active^, Items.Current^ do begin
	    S := PromptString('Enter new help for item:', StringFromHeap(Help));
	    if S = StringFromHeap(Help) then
	      Exit;
	    Undraw;
	    {Store the new string}
	    if OnHeap then
	      DisposeString(Help);
	    Help := StringToHeap(S);
	    Redraw;
	  end;
	  Saved := False;
	end;

      MitemSelectChar :      {set selectchar for item}
	if HaveActive then begin
	  MoveSelect(User^.Active);
	  Saved := False;
	end;

      MitemKey :	     {set key for item}
	if HaveActive then
	  with User^.Active^.Items.Current^ do begin
	    Key := PromptInteger('Enter key number to return:', Integer(Key));
	    {Make sure the Make menu is updated}
	    Undraw;
	    Redraw;
	    Saved := False;
	  end;

      MitemRemove :	     {remove item from submenu}
	if HaveActive then
	  if User^.Active^.Items.Current^.Sub <> Nil then
	    PressEsc('Cannot remove an item with submenus still attached.')
	  else if Confirm('Are you sure you want to remove item?') then begin
	    RemoveItem(User^.Active);
	    Saved := False;
	  end;

      MfileRead :	     {read library file for current menu}
	if NoSave then begin
	  {Get file to read from}
	  S := PromptString('Enter library file name:', LastRead);
	  if S = '' then
	    Exit;
	  S := defaultextension(S, 'LIB');
	  LastRead := S;
	  {Get id within that file}
	  t := PromptString('Enter library ID for menu:', LastId);
	  if t = '' then
	    Exit;
	  LastId := t;
	  Undraw;
	  ClearUserStack;
	  {Read in the user menu}
	  User := ReadMenuLib(S, t, nil);
	  if MenuStatus <> MenuSuccess then
	    PressEsc('Unable to read menu.')
	  else begin
	    Saved := True;
	    SetMenuSelectKeys(User, EditKeys);
	    PushRootMenuOntoStack;
	  end;
	  Redraw;
	end;

      MfileWrite :	     {write library file for current menu}
	if HaveActive then begin
	  {Get file to read from}
	  S := PromptString('Enter library file name:', LastWrote);
	  if S = '' then
	    Exit;
	  S := defaultextension(S, 'LIB');
	  LastWrote := S;

	  {Get id within that file}
	  t := PromptString('Enter library ID for menu:', LastId);
	  if t = '' then
	    Exit;
	  LastId := t;

	  {Disable the special keys we use for menu making}
	  SetMenuSelectKeys(User, []);

	  {Write the user menu}
	  WriteMenuLib(User, S, t);
	  if MenuStatus <> MenuSuccess then
	    PressEsc('Unable to write menu.')
	  else begin
	    PressEsc('Menu written.');
	    Saved := True;
	  end;

	  {Re-enable the special keys we use for menu making}
	  SetMenuSelectKeys(User, EditKeys);
	end;

      MfileGenerate :	     {write source code for current menu}
	if User <> nil then begin
	  {Get the file to write to}
	  S := PromptString('Enter name of source file to write:', LastWrote);
	  if S = '' then
	    Exit;
	  S := defaultextension(S, 'PAS');
	  LastWrote := S;
	  if MenuGenerate(S) then begin
	    PressEsc('Menu source code generated.');
	    Saved := True;
	  end;
	end;

      MfilePack :	     {pack a menu library}
	begin
	  {Get file to read from}
	  S := PromptString('Enter name of library file to pack:', LastRead);
	  if S = '' then
	    Exit;
	  S := defaultextension(S, 'LIB');
	  LastRead := S;
	  {Get file to write to}
	  if LastWrote = LastRead then
	    LastWrote := '';
	  t := PromptString('Enter name of library file to write:', LastWrote);
	  if t = '' then
	    Exit;
	  T := defaultextension(T, 'LIB');
	  LastWrote := t;
	  {Pack the library}
	  PackMenuLib(S, t);
	  if MenuStatus = MenuSuccess then
	    PressEsc('Menu packed.')
	  else
	    PressEsc('Unable to pack menu, or no packing required.')
	end;

      MfileQuit :	     {quit the menu maker}
	if NoSave then
	  HandleChoice := True;

    end;

  end;

begin

  Copyright('Menu Maker for MIK'); Writeln;
  Write('Press <Enter> to start: '); Readln;

  {make sure we can run under a multitasking environment}
  DetectMultitasking := True;
  ReinitCrt;

  Initialize;

  {Build the menu system for MakeMenu}
  BuildMakeMenu;

  repeat
    {Put up the make menus and get a menu action}
    Key := MenuChoice(Make, Ch);

    {Handle the command}
    case Ch of
      {Normal selection by menus}
      ^M : Done := HandleChoice(MakeCommands(Key));

      {Selection by fast command keys}
      ^A : Done := HandleChoice(MitemMove);
      ^c : Done := HandleChoice(MmenuChoose);
      ^S : Done := HandleChoice(MsubAdd);
      ^I : Done := HandleChoice(MitemAdd);
      ^N : Done := HandleChoice(MmenuNew);
      ^R : Done := HandleChoice(MfileRead);
      ^W : Done := HandleChoice(MfileWrite);
      ^G : Done := HandleChoice(MfileGenerate);
      ^Q : Done := HandleChoice(MfileQuit);
      ^D : Done := HandleChoice(MsubDrag);
      ^E : Done := HandleChoice(MitemEdit);
      ^P : Done := HandleChoice(MfilePack);
    end;
  until Done;

  {Restore the screen}
  EraseMenu(Make, False);
  RestoreCursorState($1901, InitSL);
end.
