Shareware Overload/ShartewareOverload.cdr/progm/tptools.zip/FIRSTED.ZIP/EDCMDS.PAS

Pascal/Delphi Source File | 1987-12-21 | 5KB | 160 lines

{                          EDCMDS.PAS
                             ED 4.0
             Copyright (c) 1985, 87 by Borland International, Inc.            }

{$I eddirect.inc}

unit EdCmds;
  {-Map keystrokes to commands}

interface

uses
  Dos,                       {DOS calls - standard unit}
  Errors;                    {Runtime error handler}

  {Defines CommandType - enumerated type of all editor commands}
  {$I edcmds.inc}

type
  CommandString = string[4]; {Longest key sequence for a command}
  CmdMatchType = (Match, NoMatch, PartMatch); {Used in matching key sequences to editor commands}
  CommandPriority = (Primary, Secondary); {Two sequences allowed for each command}

var
  {Keyboard-related}
  CmdBuf : CommandString;    {Holds current command until complete command reached}
  CmdPtr : Byte;             {Points to last character in current command}
  AbortChar : Char;          {Character used to abort operation}

function EdScanCmdList(CmdPtr : Byte; var CmdCode : CommandType) : CmdMatchType;
  {-See if current command buffer matches any installed commands}
  {-Return Match if so, PartMatch if possible match, NoMatch if a loser}
  {-Return CmdCode if matched}

function EdCommandKeys(C : CommandType; P : CommandPriority) : CommandString;
  {-Return the primary or secondary key sequence for command c}

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

implementation

const
  CmdListBytes = 512;        {Maximum Number of bytes in installable command list}
type
  CmdListBuffer = array[0..CmdListBytes] of Char;
var
  CmdList : ^CmdListBuffer;  {Points to legal list of command keystrokes}

  {The machine image contains an ID string used by the installation program}
  {It also contains the default command to keystroke mapping}
  {$L EDCMDS}

  function EdInitCmdListPtr : Pointer; external;
  {-Return a pointer to the beginning of command list}

  function EdScanCmdList(CmdPtr : Byte; var CmdCode : CommandType) : CmdMatchType;
    {-See if current command buffer matches any installed commands}
    {-Return Match if so, PartMatch if possible match, NoMatch if a loser}
    {-Return cmdcode if matched}
  var
    Cpos, Cofs, CmdLen : Integer;
    Done : Boolean;
    Result : CmdMatchType;

  begin                      {EdScancmdlist}

    {Initialize}
    CmdCode := CmdLeftChar;  {First command in CommandType}
    Cpos := 0;
    CmdLen := Ord(CmdList^[0]);

    repeat
      {Offset within this command}
      Cofs := 1;
      Result := PartMatch;

      while (Result = PartMatch) and (Cofs <= CmdPtr) and (Cofs <= CmdLen) do
        if CmdBuf[Cofs] <> CmdList^[Cpos+Cofs] then
          Result := NoMatch
        else
          Inc(Cofs);

      Done := (Result = PartMatch);

      if not(Done) then begin
        {Move to next command}
        Cpos := Cpos+CmdLen+2;
        {Bytes in next command}
        CmdLen := Ord(CmdList^[Cpos]);
      end else if (CmdPtr = CmdLen) then begin
        {The whole command matched}
        Result := Match;
        CmdCode := CommandType(CmdList^[Cpos+Cofs]);
      end;

    until Done or (CmdLen = 0);

    EdScanCmdList := Result;
  end;                       {EdScancmdlist}

  function EdCommandKeys(C : CommandType; P : CommandPriority) : CommandString;
    {-Return the primary or secondary key sequence for command c}
  var
    Cofs : Integer;
    Cmd : CommandString;

    function EdNextCommandKeys(C : CommandType; var Cofs : Integer) : CommandString;
      {-Return the next command sequence matching c, starting at cofs}
    var
      Clen : Integer;
      Cmd : CommandString;

    begin                    {EdNextCommandKeys}
      Cmd := '';
      repeat
        Clen := Ord(CmdList^[Cofs]);
        if Clen <> 0 then
          if Ord(C) = Ord(CmdList^[Succ(Cofs+Clen)]) then begin
            Move(CmdList^[Cofs], Cmd, Succ(Clen));
            Cofs := Cofs+Clen+2;
            {Force exit}
            Clen := 0;
          end else
            Cofs := Cofs+Clen+2;
      until (Clen = 0);
      EdNextCommandKeys := Cmd;
    end;                     {EdNextCommandKeys}

  begin                      {EdCommandKeys}
    {Get the primary key sequence}
    Cofs := 0;
    Cmd := EdNextCommandKeys(C, Cofs);
    if (P = Secondary) and (Cmd <> '') then
      {Get the secondary command}
      Cmd := EdNextCommandKeys(C, Cofs);
    EdCommandKeys := Cmd;
  end;                       {EdCommandKeys}

  procedure SetAbortChar;
    {-Set character used to abort operation}
  var
    AbortString : CommandString;

  begin                      {SetAbortChar}
    AbortString := EdCommandKeys(CmdAbort, Primary);
    if AbortString = '' then
      AbortChar := ^U
    else
      AbortChar := AbortString[1];
  end;                       {SetAbortChar}

begin
  {Initialize pointer to the command list stored in this code segment}
  CmdList := EdInitCmdListPtr;
  {Number of chars currently in command buffer}
  CmdPtr := 0;
  {Initialize AbortChar}
  SetAbortChar;
end.