Columbia Kermit/kermit.zip/perqb/pq2mut.pas

Pascal/Delphi Source File | 2020-01-01 | 43KB | 1,293 lines

module MenuUtils;

{ Abstract:

{       The procedure GetPList invokes the menues, starting with the
{       root menu, and returns a 'parse list' containing the
{       selections the user has made when traversing the menu tree
{       out to a leaf.

{       The user may enter the selections either by typing the commands,
{       or by invoking PopUp-menues.  Online help will always be available,
{       and the user will never have committed himself to any choice before
{       the last choice (i.e. the leaf) has been done.
}

{==============================} exports {===================================}

imports PopUp from PopUp;


type
        NodeType     =  ( MenuNode, ParmNode, EndNode );

        HelpAddress  =  record
                            BlockNo : integer;
                            Offset  : integer;
                        end;

        pMenuEntry   =  ^MenuEntry;     { Pointer to menu hierarchy }
        MenuEntry    =  record
                                { Where to find help on this item }
                            Help        : HelpAddress;
                                { How to prompt for next selection }
                            Prompt                  : S25;
                            case Node   : NodeType of

                                MenuNode:   { A real menu }
                                       (MPtr      : pNameDesc;
                                        NextLevel : array [1..1]
                                                            of pMenuEntry);

                                ParmNode:   { A leaf, expecting a parameter }
                                       ();

                                EndNode:    { A leaf, no parameter }
                                       ()
                         end;


        pPListEntry  =  ^PListEntry;    { Parse list pointer }
        PListEntry   =  record          { Parse list item }
                            PrevPList   : pPListEntry;
                            CurrMenu    : pMenuEntry;
                            CmdI        : integer;
                            case Node   : NodeType of
                                        { Menu selection }
                                MenuNode    : ( NextPList   : pPListEntry;
                                                Selection   : integer);
                                        { The possible tails of the list }
                                ParmNode    : ( Arg         : String );
                                EndNode     : ()
                        end;

procedure   InitMenues;
procedure   DestroyMenues;
function    GetMenu( MenuFName, HelpFName : String ) : pMenuEntry;

exception   NoMenuFile( MenuFName : String );
exception   BadMenuFile( AtLine : Integer );

function    GetMenuAnswer(MPtr:pNameDesc;  NPix:integer):integer;
function    PushCmdFile( FileName : String ) : Boolean;
procedure   GetPList( root : pMenuEntry; var PListPtr : pPListEntry );
procedure   DestroyPList( var PListPtr : pPListEntry );

{===========================================================================}
{==============================} private {==================================}



imports Memory from Memory;
imports FileSystem from FileSystem;
imports System from System;
imports Screen from Screen;
imports Perq_String from Perq_String;
imports MultiRead from MultiRead;
imports IO_Unit from IO_Unit;
imports IO_Others from IO_Others;
imports IOErrors from IOErrors;
imports Stream from Stream;

const
        HelpCommand = 'HELP';

        DefSeg          =     0;
        UseCursorPos    =    -1;
        NotList         = false;
        ColWidth        =     8;
        ScreenWidth     =    75;
        MenuSize        =   200;  { Max. height of menu }
        CommentChar     =   '!';
        NumLevels       =    20;
        Fold            =  true;
        MaxCLine        =   132;  { Max. length of command line }
        TabKey          =   Chr(128);
        CR              =   Chr( 13);
        Escape          =   Chr( 27);
        BS              =   Chr(  8);
        DEL             =   Chr(127);
        CtrlU           =   Chr( 21);
        CtrlW           =   Chr( 23);
        CtrlX           =   Chr( 24);

        KeyChar         =   Chr( 24);
        CmdFChar        =   Chr( 26);

type
    pInt = ^Integer;

    CLine = packed array [1..MaxCLine] of char;
    CBuff = record
                Prompt      : String;
                Cmd         : CLine;
                BufCur      : 0..MaxCLine;  { character index in buffer}
                CurrPList   : pPListEntry;  { last entry in parse list }
                Comment     : Boolean;
                CommPos,
                HelpPos     : Integer;
            end;

    ParseResult =
        ( ParsedOK, WantHelp, NotFound, NotUnique );


var
    NullMenu        : pNameDesc;
    ShowMenues      : boolean;
    CmdStack        : Array [1..NumLevels] of text;
    CmdLevel        : 0..NumLevels;
    PromptChar      : Char;

    EndMenu,
    ParmMenu        : pNameDesc;

{===========================================================================}

procedure RefreshCBuff( VAR CB : CBuff );
VAR I : Integer;
begin
    with CB do begin
        write( Prompt, PromptChar );
        for I := 1 to BufCur-1 do write( Cmd[I] );
    end;
end;

{===========================================================================}

function CmdEndCBuff( VAR CB : CBuff ) : integer;
VAR I : Integer;
begin
    with CB do
        if CurrPList=NIL then
            CmdEndCBuff := 1
        else begin
            I := CurrPList^.CmdI;
            while (Cmd[i]<>' ') and (Cmd[i]<>CR) and
                  (Cmd[i]<>CommentChar) and (I<BufCur) do
                I := I + 1;
            CmdEndCBuff := I;
        end;
end;

{===========================================================================}

function    PushCmdFile( FileName : String ) : Boolean;

        handler ResetError( FileName : PathName );
        begin
             PushCmdFile := False;
             exit( PushCmdFile );
        end;

begin
    PushCmdFile := True;
    if CmdLevel<NumLevels then begin
        Reset( CmdStack[CmdLevel+1], FileName );
        CmdLevel := CmdLevel + 1;
        PromptChar := CmdFChar;
    end;
end;

{===========================================================================}

function GetChar : Char;
var C       : Char;
    Done    : Boolean;
begin
    if CmdLevel=0 then begin
        SCurOn;
        Done := False;
        while not Done do begin
            if (IOCRead( TransKey, C )=IOEIOC) then begin
                Done := True;
            end else if TabSwitch then begin
                Done := True;
                C := TabKey;
            end;
        end;
        SCurOff;
    end else begin
        if EOF( CmdStack[CmdLevel] ) then begin     { Pop stack }
            Close( CmdStack[CmdLevel] );
            CmdLevel := CmdLevel - 1;
            if CmdLevel=0 then PromptChar := KeyChar;
            C := CR;
        end else
            if EOLn( CmdStack[CmdLevel] ) then begin
                Read( CmdStack[CmdLevel] , C );
                C := CR;
            end else
                Read( CmdStack[CmdLevel], C );
    end;
    GetChar := C;
end;   { GetChar }

{=============================================================================}

function FieldWidth( L : integer ):integer;
begin
    FieldWidth := (( L + ColWidth ) div ColWidth ) * ColWidth;
end;

{===========================================================================}

procedure PushPList( VAR CB : CBuff; NewMenu : PMenuEntry );
var P : pPListEntry;
    I : Integer;
begin
    with CB do begin
        case NewMenu^.Node of
            MenuNode:   New( P, MenuNode );
            ParmNode:   New( P, ParmNode );
            EndNode:    New( P, EndNode );
        end;
        with P^ do begin
            Node := NewMenu^.Node;
            CurrMenu := NewMenu;
            PrevPList := CurrPList;
            I := CmdEndCBuff( CB );
            while ((Cmd[i]=' ') or (Cmd[i]=CR)) and (I<BufCur) do I := I + 1;
            CmdI := I;
            if Node=MenuNode then begin
                NextPList := NIL;
                Selection := 0;
            end else if Node=ParmNode then
                Arg := '';
        end;
        if CurrPList<>NIL then
            CurrPList^.NextPList := P;
        CurrPList := P;
    end;
end;

{===========================================================================}

procedure InitCBuff( VAR CB : CBuff; M : pMenuEntry );
begin
    with CB do begin
        Prompt      := M^.Prompt;
        BufCur      := 1;
        CurrPList   := NIL;
        Comment     := False;
        CommPos     := 0;
        HelpPos     := 0;
    end;
    PushPList( CB, M );
end;

{===========================================================================}

function CComp( C1, C2 : Char ) : Boolean;
begin
    if C1=C2 then
        CComp := true
    else
        if not Fold then
            CComp := false
        else begin
            if (C1>='a') and (C1<='z') then
                C1 := Chr( Ord(C1)-Ord('a')+Ord('A') );
            if (C2>='a') and (C2<='z') then
                C2 := Chr( Ord(C2)-Ord('a')+Ord('A') );
            CComp := C1=C2;
        end;
end;

{===========================================================================}

procedure IntoCBuff( VAR CB : CBuff;  C : Char );
begin
    with CB do begin
        if BufCur<MaxCLine then begin
            Cmd[BufCur] := C;
            if C>=' ' then      { Echo character }
                write(C);
            with CurrPList^ do
                if (CmdI=BufCur) and (C=' ') then
                    CmdI := CmdI + 1;
            BufCur := BufCur + 1;
        end;
    end;
end;

{===========================================================================}

procedure BackCBuff( VAR CB : CBuff; ToPos : Integer );
VAR I : Integer;
begin
    with CB do begin
        if ToPos>BufCur then ToPos := BufCur;
        if ToPos<1 then ToPos := 1;

        if Comment and (ToPos<=CommPos) then
            Comment := False;

        for I := BufCur-1 downto ToPos do begin
            if Cmd[I]>=' ' then             { Character was echoed to screen }
                SClearChar( Cmd[I], RXor );
        end;
        BufCur := ToPos;

            { Pop the last entries off the parse list, if necessary }
        while (CurrPList^.CmdI>BufCur) and (CurrPList^.PrevPList<>NIL) do begin
            CurrPList := CurrPList^.PrevPList;
        end;

        with CurrPList^ do begin
            if CmdI>BufCur then         { Could not pop last item }
                CmdI := BufCur;         { Just note that there are no chars }
            if (NextPList<>NIL) and (Node=MenuNode) then begin
                Selection := 0;
                DestroyPList( NextPList );
                NextPList := NIL;
            end;
        end;
        if ToPos<=HelpPos then
            HelpPos := 0;
    end;
end;

{===========================================================================}

procedure NextCmdCBuff( VAR CB : CBuff );
{ Push to next command in buffer }
VAR I : Integer;
begin
    with CB, CurrPList^, CurrMenu^ do begin
        I := CmdEndCBuff( CB );
        if (I<BufCur) then
            if (Selection>1) and (Selection<=MPtr^.NumCommands) then
            begin
                {$Range-}
                PushPList( CB, NextLevel[Selection] );
                {$Range=}
            end else if Selection=1 then begin
                if HelpPos=0 then
                    HelpPos := CurrPList^.CmdI;
                PushPList( CB, CurrMenu );
            end;
    end;
end;

{===========================================================================}

function FindMatch( VAR CB  : CBuff;
                    VAR Pos : integer ) : Boolean;

{ Abbreviated command lookup.  Starting from "Pos", see if any command in   }
{ command table matches the word starting at CmdI in CB and ending at       }
{ BufCur -1 or first space or other delimiting character.                   }

var GiveUp                  : Boolean;
    CmdEnd, CmdLen, I, J    : Integer;
begin
    with CB, CurrPList^.CurrMenu^.MPtr^ do begin

        CmdEnd := CmdEndCBuff( CB );
        GiveUp := True;
        while (Pos<NumCommands) and (GiveUp) do begin

                { Look if Cmd matches command in table }
            Pos := Pos + 1;
            I := CurrPList^.CmdI;
            J := 1;
            {$Range-}
            CmdLen := Length(Commands[Pos]);
            GiveUp := False;
            while (I<CmdEnd)  and (not GiveUp) do begin
                if CComp( Commands[Pos][J], Cmd[I] ) then begin
                    J := J+1;           { Matching characters, step both }
                    I := I+1;           { indices forward in commands    }
                    if (J>CmdLen) and (I<CmdEnd) then
                        GiveUp := True;
                end else
                    if Cmd[I]='-' then begin { Cmd is abbreviated, just  }
                        J := J+1;       { step the other index forward   }
                        if J>CmdLen then        { Need something to match }
                            GiveUp := True;     { this character to!      }
                    end else begin
                        GiveUp := True;
                    end;
            end;
            {$Range=}
        end;

        FindMatch := not GiveUp;
    end;
end;    { FindMatch }

{===========================================================================}

procedure ShowWord( VAR CB : CBuff );
VAR I : Integer;
begin
    with CB do begin
        write('''');
        I := CurrPList^.CmdI;
        while (Cmd[I]<>' ') and (I<BufCur) do begin
            write(Cmd[I]);
            I := I + 1;
        end;
        write('''');
    end;
end;

{===========================================================================}

function ParseCBuff( VAR CB : CBuff ) : ParseResult;
VAR I, J : Integer;
begin
    with CB, CurrPList^ do

    Case Node of
        MenuNode:
            begin
                I := 0;
                if not FindMatch( CB, I ) then begin
                    ParseCBuff := NotFound;
                    CurrPList^.Selection := 0;
                end else begin
                    CurrPList^.Selection := I;
                    J := I;
                    if FindMatch( CB, J ) then begin
                        ParseCBuff := NotUnique;
                    end else begin
                        NextCmdCBuff( CB );
                        ParseCBuff := ParsedOK;
                    end;
                end;
            end;

        ParmNode:
            begin
                if BufCur>1 then
                    if (Cmd[BufCur-1]=CR) or (Cmd[BufCur-1]=' ') then begin
                        Adjust( Arg, BufCur-1-CurrPList^.CmdI );
                        I := 1;
                        for J := CurrPList^.CmdI to BufCur-2 do begin
                            Arg[I] := Cmd[J];
                            I := I + 1;
                        end;
                    end;
                ParseCBuff := ParsedOK;
            end;

        EndNode:
            begin
                if BufCur>1 then
                    if Cmd[BufCur-1]=CR then
                        if BufCur>CurrPList^.CmdI then begin
                            writeln;
                            write('?Garbage at end of line, ignored ''');
                            for I := CurrPList^.CmdI to BufCur-2 do
                                write( Cmd[I] );
                            writeln('''');
                            RefreshCBuff( CB );
                        end;
                ParseCBuff := ParsedOK;
            end;
    end;
end;

{===========================================================================}

function    ParseAll( VAR CB : CBuff ) : ParseResult;
{ -- Reparse command buffer as far as possible }
var PRes        : ParseResult;
    PrevCmdI,
    TempPos     : Integer;
    TempChar    : Char;
begin
    with CB do begin
        if Comment then begin
            TempPos := BufCur;
            BufCur := CommPos + 1;
            TempChar := Cmd[CommPos];
            Cmd[CommPos] := ' ';
        end;
        if (CmdEndCBuff(CB)<>CurrPList^.CmdI) then begin
            repeat
                PrevCmdI := CurrPList^.CmdI;
                PRes := ParseCBuff(CB);
            until (PRes<>ParsedOK) or (PrevCmdI=CurrPList^.CmdI)
                        or (CmdEndCBuff(CB)=CurrPList^.CmdI);
            ParseAll := PRes;
        end else
            ParseAll := ParsedOK;

        if Comment then begin
            Cmd[CommPos] := TempChar;
            BufCur := TempPos;
        end;
    end;
end;

{===========================================================================}

procedure ParseCommand(     root        : pMenuEntry;
                        var PListPtr    : pPListEntry;
                            HelpMode,
                            RootLevel   : Boolean );

const
    MoreInfo = 'More info on:';
    SelPrompt = 'Select item:';
    SelectOne = 'Select one of the following: ';
    CommNotUnique = '?Command is not unique: ';
var
    C                   : Char;
    Done, QuestionMark  : boolean;
    NextMatch,
    I, J, CmdEnd        : integer;
    Matching            : S25;
    CB                  : CBuff;       { Command buffer to use}
    TabPress            : Boolean;     { Select done by menu? }
    PRes                : ParseResult;
    Dummy, ArgEntry     : pPListEntry;

    HelpFile    : pInt;
    HelpFID     : integer;
    HFBuff      : pDirBlk;
    HFAddr      : HelpAddress;
    MM          : MMPointer;


    handler HelpKey( var retStr : Sys9s );
    begin
        retStr := 'HELP';
    end;

    {------------------------------------------------------------------------}

    procedure PrintHelpText;
    var PrevCR      : boolean;
    begin
        if HelpFID=0 then
            writeln('No helptext found!')
        else
            with CB.CurrPList^.CurrMenu^ do begin
                if HFaddr.BlockNo<>Help.BlockNo then
                    FSBlkRead( HelpFID, Help.BlockNo, HFBuff );
                HFAddr := Help;
                PrevCR := true;
                with HFAddr, HFBuff^ do
                    while not( PrevCR and (ByteBuffer[Offset]=ord('>'))) do
                    begin
                        PrevCR := ByteBuffer[Offset]=13;
                        write( chr(ByteBuffer[Offset]) );
                        if PrevCR then write( chr(10) );
                        Offset := Offset+1;
                        if Offset>511 then begin
                            Offset := 0;
                            BlockNo := BlockNo + 1;
                            FSBlkRead( HelpFID, BlockNo, HFBuff );
                        end;
                    end;
            end;
    end;  { PrintHelpText }

    {------------------------------------------------------------------------}

    procedure PrintAlts;
    var i,l,w,s         : integer;
        Matching        : S25;
    begin
        L := 0;
        with CB.CurrPList^.CurrMenu^, MPtr^ do
        if Node=MenuNode then begin

            if HelpMode then
                writeln( MoreInfo )
            else
                writeln( SelectOne );
            for i := 2 to NumCommands do begin
                {$range-}
                Matching := Commands[i];
                S := Length( Matching );
                W := FieldWidth( S );
                L := L+W;
                if L < ScreenWidth then
                    write( Matching, ' ':(W-S) )
                else if L = ScreenWidth then begin
                    writeln( Matching );
                    L := 0;
                end else begin
                    writeln;
                    write( Matching, ' ':(W-S) );
                    L := W;
                end;
                {$range=}
            end;

        end;
        if L<>0 then writeln;
    end;

    {------------------------------------------------------------------------}

    procedure PrintMatching;
    var i,l,w,s         : integer;
        Matching        : S25;
    begin
        L := 0;
        I := 0;
        writeln( SelectOne );
        with CB.CurrPList^.CurrMenu^.MPtr^ do
            while FindMatch( CB, I ) do begin
                {$Range-}
                Matching := Commands[I];
                {$Range=}
                S := Length( Matching );
                W := FieldWidth( S );
                L := L+W;
                if L < ScreenWidth then
                    write( Matching, ' ':(W-S) )
                else if L = ScreenWidth then begin
                    writeln( Matching );
                    L := 0;
                end else begin
                    writeln;
                    write( Matching, ' ':(W-S) );
                    L := W;
                end;
            end;
        if L<>0 then writeln;
    end;

    {------------------------------------------------------------------------}

    procedure DoHelp;
    begin
        writeln;
        writeln;
        PrintHelpText;
        writeln;
        PrintAlts;
        writeln;
    end;

    {------------------------------------------------------------------------}

    procedure ExplainHelp;
    begin
        writeln;
        writeln;
        write('HELP - online help facility');
        writeln;
        writeln('Use the "HELP" command to obtain command explanations');
        writeln('"HELP" may replace any command, and the effect will be to');
        writeln('explain this command and list the various alternatives.');
        writeln;
        writeln('"HELP" may be used in different ways: ');
        writeln('"HELP" as the last command on the line, before RETURN, will');
        writeln('enter the help mode, where every command entered not is ');
        writeln('executed, but explained.  Exit help mode by entering an ');
        writeln('empty line.');
        writeln('When the "HELP" command is not at the end of the line, ');
        writeln('the result will be to explain the commands after HELP ');
        writeln('and then continue entering commands to execute.');
        writeln;
        writeln('Function keys:');
        writeln('RETURN (CR) terminates the command and executes it.  If ');
        writeln('   the command is partially entered, the command tail will ');
        writeln('   be prompted for.  The command may then be aborted by ');
        writeln('   entering a blank line.');
        writeln('INS (ESC) expands the last command on the line, if it is ');
        writeln('   abbreviated, and it is unique.  Use to check if a valid');
        writeln('   command is entered, and that the abbreviation really');
        writeln('   identifies the correct command.');
        writeln('''?'' lists the commands that matches an abbreviation. ');
        writeln('''??'' enters help mode. ');
        writeln('''!'' is a comment delimiter.  (Most useful in command ');
        writeln('   files.)  Everything between ''!'' and end of line is ');
        writeln('   ignored.');
        writeln('BACKSPACE, DEL deletes the last character on the line.');
        writeln('OOPS, Ctrl-U, Ctrl-X deletes the whole line.');
        writeln('Ctrl-W deletes the last word (back to previous space) ');
        writeln;
    end;    { ExplainHelp }

    {------------------------------------------------------------------------}


begin  { GetPList }
    MM := recast( Root, MMPointer );
    HelpFile := MakePtr( MM.Segmen, 0, pInt );
    HelpFID := HelpFile^;
    HFAddr.BlockNo := -1;       { Note help buffer is empty }
    new( HFBuff);

    Done := false;
    InitCBuff( CB, Root );
    if HelpMode then begin
        DoHelp;
        CB.Prompt := SelPrompt;
    end;
    RefreshCBuff( CB );
    PListPtr := CB.CurrPList;
    QuestionMark := False;

    with CB do
      while not Done do begin

        C := GetChar;

        if (C=TabKey) then begin                { Insert dummy space to     }
            IntoCBuff( CB, ' ' );               { make parse go all the way }
            PRes := ParseAll(CB);               { to the end of buffer.     }
            BackCBuff( CB, BufCur-1 );          { Remove the dummy space.   }
            if BufCur>CurrPList^.CmdI then
                BackCBuff( CB, CurrPList^.CmdI );      { ..partial command }
            Dummy := CurrPList;
            repeat
                case CurrPList^.Node of

                MenuNode:
                    begin
                        I := GetMenuAnswer( CurrPList^.CurrMenu^.MPtr,
                                                MenuSize );
                        if I>1 then begin
                            CurrPList^.Selection := I;
                            {$Range-}
                            Matching := CurrPList^.CurrMenu^.MPtr^.Commands[i];
                            {$Range=}
                            for J := 1 to length(Matching) do begin
                                IntoCBuff(CB,Matching[j]);
                            end;
                            IntoCBuff(CB, ' ');
                            NextCmdCBuff(CB);
                        end;
                    end;

                EndNode:
                    begin
                        if HelpMode then begin
                            I := 1;
                        end else
                            I := GetMenuAnswer( EndMenu, MenuSize );
                        if I=2 then I := -1;
                    end;

                ParmNode:
                    begin
                        if HelpMode then begin
                            I := 1;
                        end else
                            I := GetMenuAnswer( ParmMenu, MenuSize );
                        if I=2 then begin
                            writeln;
                            ParseCommand( CurrPList^.CurrMenu, ArgEntry,
                                    HelpMode, false );
                            CurrPList^.Arg := ArgEntry^.Arg;
                            DestroyPList( ArgEntry );
                            I := -1;
                        end else if I=3 then begin
                            CurrPList^.Arg := '';
                            I := -1;
                        end;
                    end;
                end;

                if I=1 then begin
                    writeln;
                    writeln;
                    PrintHelpText;
                    writeln;
                    write('Press tabswitch to get menu back: ');
                    while TabSwitch do ;
                    while not TabSwitch do ;
                    writeln(CR,'                                     ' );
                    RefreshCBuff(CB);
                end;

                if (I=0) or ((I=1) and (CurrPList^.Node<>MenuNode))
                then begin       { Pop off command }
                    if CurrPList<>Dummy then begin
                        BackCBuff( CB, CurrPList^.PrevPList^.CmdI );
                    end;
                end;

                if (I=-1) and not HelpMode then begin
                    writeln;
                    Done := True;
                end;

            until Done or (CurrPList=Dummy);

        end else

        if (C=CommentChar) then begin
            if not Comment then begin
                Comment := True;
                CommPos := BufCur;
            end;
            IntoCBuff( CB, C );
        end else

        if (C=CR) then
        begin
            IntoCBuff( CB, ' ' );
            case ParseAll( CB ) of

            ParsedOK:
                if HelpMode then begin
                    Done := CurrPList^.PrevPList=NIL;
                    if CurrPList^.Selection=1 then
                        ExplainHelp
                    else begin
                        writeln;
                        if not Done then begin
                            DoHelp;
                            if CurrPList^.Node<>MenuNode then
                                BackCBuff( CB, CurrPList^.PrevPList^.CmdI )
                            else
                                BackCBuff( CB, BufCur-1 );
                            RefreshCBuff(CB);
                        end;
                    end;

                end else begin
                    writeln;
                    with CurrPList^ do

                    if HelpPos>0 then begin
                        if PrevPList^.CmdI=HelpPos then begin { HELP last com.}
                            writeln;
                            ParseCommand( CurrPList^.CurrMenu, Dummy,
                                    True, false );
                            DestroyPList( Dummy );
                        end else begin
                            writeln;
                            PrintHelpText;
                            writeln;
                            if Node=MenuNode then begin
                                PrintMatching;
                                writeln;
                            end;
                        end;
                        RefreshCBuff(CB);

                    end else if (CurrMenu=Root) and (Node=MenuNode) then
                        PListPtr := NIL      { Nothing parsed (or a new}
                                             { entry would have been pushed)}
                    else begin
                        if Node=MenuNode then begin
                              { OK so far, but haven't got all of command }
                            ParseCommand( CurrMenu, Dummy,
                                    false, false );
                            if (Dummy=NIL) then begin   { Quit command }
                                DestroyPList(PListPtr);
                                PListPtr := NIL;
                            end else begin              { link in cmd tail }
                                CurrPList^.PrevPList^.NextPList := Dummy;
                                Dummy^.PrevPList := CurrPList^.PrevPList;
                                DestroyPList(CurrPList);
                                CurrPList := Dummy;
                            end;
                        end;
                    end;
                    if HelpPos>0 then
                        BackCBuff( CB, HelpPos )
                    else
                        Done := true;
                end;

            NotUnique:
                begin
                    BackCBuff( CB, BufCur-1 );
                    writeln;
                    write( CommNotUnique );
                    ShowWord( CB );
                    writeln;
                    PrintMatching;
                    if CmdLevel>0 then begin
                        RefreshCBuff( CB );
                        BackCBuff( CB, 1 )
                    end else begin
                        BackCBuff(CB, CmdEndCBuff(CB));
                        RefreshCBuff( CB );
                    end;
                end;

            NotFound:
                begin
                    BackCBuff( CB, BufCur-1 );
                    writeln;
                    write('?No match for word: ');
                    ShowWord(CB);
                    writeln;
                    PrintAlts;
                    RefreshCBuff( CB );  { ... and start over }
                    if CmdLevel>0 then
                        BackCBuff( CB, 1 );
                end;

            end;
            QuestionMark := false;

        end else

        if (C='?') and (not Comment) then begin

            PRes := ParseAll( CB );
            if QuestionMark and not HelpMode then begin
                writeln;
                ParseCommand( CurrPList^.CurrMenu, Dummy, True, false );
                DestroyPList( Dummy );
                QuestionMark := False;
                RefreshCBuff( CB );

            end else begin

                case PRes of

                ParsedOK:
                    if HelpMode then begin
                        writeln('?');
                        DoHelp;
                        RefreshCBuff(CB);
                    end else if BufCur=CurrPList^.CmdI then
                    begin
                        writeln('?');
                        PrintAlts;
                        RefreshCBuff(CB);
                    end;

                NotFound:
                    begin
                        writeln('?');
                        write('?No match for word: ');
                        ShowWord(CB);
                        writeln;
                        if CmdLevel>0 then begin
                            RefreshCBuff( CB );
                            BackCBuff( CB, 1 )
                        end else begin
                            PrintAlts;
                            RefreshCBuff( CB );  { ... and start over }
                        end;
                    end;

                NotUnique:
                    begin
                        writeln('?');
                        PrintMatching;
                        QuestionMark := True;
                        if CmdLevel>0 then begin
                            RefreshCBuff( CB );
                            BackCBuff( CB, 1 );
                        end else begin
                            BackCBuff(CB, CmdEndCBuff(CB));
                            RefreshCBuff( CB );
                        end;
                    end;
                end;

                QuestionMark := True;
            end;

        end else

        if (C=Escape) and (not Comment) then begin

            QuestionMark := False;

            if BufCur>CurrPList^.CmdI then begin

                PRes := ParseAll(CB);
                case PRes of

                ParsedOK:
                    begin
                        CmdEnd := CmdEndCBuff(CB);
                        if CmdEnd=BufCur then
                            with CurrPList^ do begin
                                {$Range-}
                                Matching :=
                                    CurrMenu^.MPtr^.Commands[Selection];
                                {$Range=}
                                I := CmdI;
                                J := 1;
                                while (I<CmdEnd) and (J<=Length(Matching))
                                do begin
                                    if CComp( Matching[J], Cmd[I] ) then begin
                                        J := J+1;
                                        I := I+1;
                                    end else begin
                                        if Cmd[I]='-' then begin
                                            J := J+1;
                                        end;
                                    end;
                                end;
                                for I := J to Length(Matching) do begin
                                    IntoCBuff( CB, Matching[I] );
                                end;
                                if PRes=ParsedOK then { expect more commands }
                                begin
                                    IntoCBuff( CB, ' ' );
                                end;
                            end;
                    end;

                NotFound:
                    begin
                        write('?No match for word: ');
                        ShowWord(CB);
                        writeln;
                        if CmdLevel>0 then begin
                            RefreshCBuff( CB );  { ... and start over }
                            BackCBuff( CB, 1 );
                        end else begin
                            PrintAlts;
                            RefreshCBuff( CB );  { ... and start over }
                        end;
                    end;

                NotUnique:
                    begin
                        writeln;
                        write(CommNotUnique);
                        ShowWord(CB);
                        writeln;
                        if CmdLevel>0 then begin
                            RefreshCBuff( CB );
                            BackCBuff( CB, 1 )
                        end else begin
                            BackCBuff(CB, CmdEndCBuff(CB));
                            PrintMatching;
                            RefreshCBuff( CB );
                        end;
                    end;

                end;
            end;
        end else

        if (C=BS) or (C=DEL) then begin
            if BufCur=1 then
                write( chr(7) )
            else
                BackCBuff( CB, BufCur-1 );
            QuestionMark := False;
        end else

        if (C=CtrlW) then begin
            if (CurrPList^.CmdI=BufCur) then begin
                if CurrPList^.PrevPList<>NIL then
                    BackCBuff( CB, CurrPList^.PrevPList^.CmdI );
            end else
                BackCBuff(CB, CurrPList^.CmdI );
            QuestionMark := False;
        end else

        if (C=CtrlX) or (C=CtrlU) then begin
            BackCBuff( CB, 1 );
            QuestionMark := False;
        end else

        begin { normal character }
            QuestionMark := False;
            if (C>=' ') and (C<DEL) then begin
                IntoCBuff( CB, C );
            end;
        end;

    end { while };
    dispose( HFBuff );

end;    { ParseCommand }

{===========================================================================}

function    GetMenuAnswer( MPtr:pNameDesc;  NPix:integer ):integer;
    {   Returns 0 for press outside menu }
var     ResPtr  :   ResRes;

    Handler OutSide;
    begin
        ResPtr:=NIL;
        exit(Menu);
    end;  { OutSide }

begin { GetMenuAnswer }
    Menu(   MPtr,
            NotList,
            1,
            MPtr^.NumCommands,
            UseCursorPos,
            UseCursorPos,
            NPix,   {Number of pixels (height)}
            ResPtr);
    if ResPtr <> NIL then begin
        GetMenuAnswer := ResPtr^.Indices[1];
        DestroyRes( ResPtr );
    end
    else
        GetMenuAnswer := 0;
end; { GetMenuAnswer }

{=============================================================================}

procedure   DestroyPList( var PListPtr : pPListEntry );
var Trail : pPListEntry;
begin
    while PListPtr<>NIL do begin
        Trail := PListPtr;
        case Trail^.Node of

            EndNode:
                begin
                    PListPtr := NIL;
                    dispose( Trail, EndNode );
                end;

            ParmNode:
                begin
                    PListPtr := NIl;
                    dispose( Trail, ParmNode );
                end;

            MenuNode:
                begin
                    PListPtr := Trail^.NextPList;
                    Trail^.NextPList := NIL;
                    dispose( Trail, MenuNode );
                end;
        end;
    end;
end;

{=============================================================================}

procedure   GetPList(           Root : pMenuEntry;
                        var PListPtr : pPListEntry );

begin
    SCurOn;
    PListPtr := NIL;
    ParseCommand( Root, PListPtr, false, true );
    SCurOff;
end;

{=============================================================================}

function GetMenu( MenuFName, HelpFName : String ) : pMenuEntry;

VAR MenuFile            : Text;
    Blk, Bits           : Integer;
    SegSize             : Integer;
    MenuF               : FileID;
    Root                : pMenuEntry;
    MMP                 : MMPointer;
    HelpFile            : pInt;
    MenuSeg, OldSeg     : SegmentNumber;

    exception BadMenuSeg;

    handler BadMenuSeg;
    begin
        GetMenu := NIL;
        exit( GetMenu );
    end;

    procedure FixPointer( var ME : pMenuEntry );
    var MME : record case boolean of
                true:   ( MM : MMPointer);
                false:  ( E  : pMenuEntry);
             end;
    begin
        with MME do begin
            E := ME;
            with MM do begin
                if (Segmen<>OldSeg) or (Offset>SegSize) then
                    raise BadMenuSeg;
                Segmen := MenuSeg;
            end;
            ME := E;
        end;
    end;

    procedure ValidatePtrs( ME : pMenuEntry );
    var i       : integer;
        TME     : pMenuEntry;
    begin
        with ME^ do begin
            case Node of
                MenuNode:
                    begin
                        TME := recast( MPtr, pMenuEntry );
                        FixPointer( TME );
                        MPtr := recast( TME, pNameDesc );
                        for i := 2 to MPtr^.NumCommands do begin
                            {$range-}
                            FixPointer( NextLevel[i] );
                            ValidatePtrs( NextLevel[i] );
                            {$range=}
                        end;
                    end;

                EndNode, ParmNode:
                    ;
            end;
        end;
    end;

begin
    MenuF := FSLookUp( MenuFName, Blk, Bits );
    if MenuF=0 then
        raise NoMenuFile( MenuFName )
    else begin
        CreateSegment( MenuSeg, Blk, 1, Blk );
        SegSize := (Blk-1)*256 + (Bits div 16);
        Root := MakePtr( MenuSeg, WordSize( integer ), pMenuEntry );
        MultiRead( MenuF, MakePtr( MenuSeg, 0, pDirBlk ), 0, Blk );
        MMP := recast( Root^.MPtr, MMPointer );
        OldSeg := MMP.Segmen;
        ValidatePtrs( Root );
        HelpFile := MakePtr( MenuSeg, 0, pInt );
        HelpFile^ := FSLookUp( HelpFName, Blk, Bits );
    end;
    GetMenu := Root;
end;

{=============================================================================}

procedure InitMenues;
begin
    {$Range-}
    AllocNameDesc( 1, DefSeg, NullMenu );
    with NullMenu^ do begin
        Header := 'Confirm:';
        Commands[1] := '?';
    end;
    AllocNameDesc( 2, DefSeg, EndMenu );
    with EndMenu^ do begin
        Header := 'Confirm selection:';
        Commands[1] := '?';
        Commands[2] := 'Perform command';
    end;
    AllocNameDesc( 3, DefSeg, ParmMenu );
    with ParmMenu^ do begin
        Header := 'Command arguments:';
        Commands[1] := '?';
        Commands[2] := 'Enter arguments';
        Commands[3] := 'No arguments';
    end;
    {$Range=}
    InitPopUp;
    IOCursorMode(TrackCursor);
    CmdLevel := 0;
    PromptChar := KeyChar;
end;


{=============================================================================}


procedure DestroyMenues;
var CI : integer;
begin
    DestroyNameDescr( NullMenu );
end.