adtrmpsr.pas

测试用例

(***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Async Professional
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1991-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   ADTRMPSR.PAS 4.06                   *}
{*********************************************************}
{*             Terminal: Data stream parser              *}
{*********************************************************}

unit ADTrmPsr;

interface

{Notes: The purpose of the data stream parser is to identify terminal
        escape sequences in the stream of data coming into the
        terminal. The parser is the class that embodies the knowledge
        of the terminal's escape sequences, if another emulator is to
        be written then a new parser descendant must be written to
        encapsulate the knowledge about the terminal to be supported.

        Consequently, there is an ancestor parser class. Operations
        supported by this class are:
        - process a single character (virtual method)
        - clear the parser (virtual method)
        - get the command (property)
        - get the arguments (property)
        - get the sequence (property)

        Taking these operations in order, let's describe them.

        Processing a single character will return one of four states:
        the parser did not understand the character and so it was
        ignored; the character is a displayable character; the
        character started or continued an escape sequence, however
        that sequence is as yet incomplete; the character completed
        an escape seqence and the relevant command must be obeyed.
        Internally it is up to the overridden method to determine how
        sequences are built up, etc.

        The clear operation should reset the parser into a state such
        that no sequence is being built up, and hence no knowledge of
        previous characters is maintained.

        The command property will return the current unprocessed
        command. This propoerty is reset to a null command if a
        sequence is being built up; no exception is raised.

        The arguments property is an array property returning the
        arguments for the current command. If there is no current
        command, the values are all zero; no exception is raised.

        The sequence property returns the actual escape sequence that
        has just been parsed. If the current command is null, this
        property returns the empty string.

        The VT100 parser has two modes to reflect the behavior of the
        standard VT100 terminal. The two modes are known as ANSI mode
        and VT52 mode. When in VT52 mode, the parser only accepts VT52
        sequences, together with the ESC< sequence (to switch back to
        ANSI mode). In ANSI mode the VT52 sequences are ignored. The
        command to switch from one to the other is obeyed immediately
        within the ProcessChar method as well being returned by it.

        ANSI control sequences (in both the VT100 and ANSI parsers)
        are always of the following form:

            ESC[P...PI...IF

        where ESC is the escape character, #27, [ is the left bracket,
        the Ps are characters in the range #$30..#$3F, the Is are in
        the range #$20..#$2F, and F is in the range #$40..#$7E. This
        way if the parser does not recognize a particular command it
        can discard it easily since it knows when the command
        finishes.

        With the VT100 parser in ANSI mode, escape sequences either
        start with ESC[, ESC#, ESC(, or ESC), or form a two character
        escape sequence ESCx where x is the command identifier. The
        ESC[ sequences follow the standard ANSI format. The other
        three sequence types are all three character sequences with
        the final character identifying the command. Hence the parser
        can know when unknown sequences terminate.

        With the VT100 parser in VT52 mode, all sequences are two
        character sequences of the form ESCx with the x being the
        command identifier. The only exception is ESCY where the
        following two characters *also* form part of the sequence
        (ESCY is "cursor position" and the two following characters
        are the row and column numbers respecitively). Hence the
        parser can know when unknown sequences terminate.

        With the ANSI parser, escape sequences either follow the ANSI
        format or are two character sequences of the form ESCx. Hence
        the parser can know when unknown sequences terminate.
}

{$I AWDEFINE.INC}

{$IFOPT R+}
{$DEFINE UseRangeChecks}
{$ENDIF}

uses
  SysUtils,
  {$IFDEF Win32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF}
  Classes,
  Graphics,
  OOMisc;

type
  TAdParserCmdType = ( {Parser return command types...}
    pctNone,           {..no command, unknown command or char ignored}
    pctChar,           {..single displayable character}
    pct8bitChar,       {..single character with bit 7 set}
    pctPending,        {..command being built up}
    pctComplete);      {..a complete command is ready}

  TAdVTParserState = (   {VT Parser states...}
    psIdle,              {..nothing happening}
    psGotEscape,         {..received escape char}
    psParsingANSI,       {..parsing an ESC[ sequence}
    psParsingHash,       {..parsing an ESC# sequence}
    psParsingLeftParen,  {..parsing an ESC( sequence}
    psParsingRightParen, {..parsing an ESC) sequence}
    psParsingCharSet,    {..parsing ESC *, +, -, ., / sequence}
    psGotCommand,        {..received complete command}
    psGotInterCommand,   {..received complete intermediary command}
    psParsingCUP52);     {..received VT52 position cursor command}

type
  PAdIntegerArray = ^TAdIntegerArray;
  TAdIntegerArray = array [0..pred(MaxInt div sizeof(integer))] of integer;

type
  TAdTerminalParser = class
    {the ancestor parser class}
    private
      FArgCount    : integer;
      FCommand     : byte;
      FUseWideChar : boolean;
    protected
      function tpGetArgument(aInx : integer) : integer; virtual;
      function tpGetSequence : string; virtual;
    public
      constructor Create(aUseWideChar : boolean);
      destructor Destroy; override;

      function ProcessChar(aCh : AnsiChar) : TAdParserCmdType; virtual;
      {$IFDEF Win32}
      function ProcessWideChar(aCh : WideChar) :TAdParserCmdType; virtual;
      {$ENDIF}

      procedure Clear; virtual;
      procedure ForceCommand (Command : Integer);                        {!!.03}

      property Argument [aInx : integer] : integer
         read tpGetArgument;
      property ArgumentCount : integer read FArgCount;
      property Command : byte read FCommand;
      property Sequence : string read tpGetSequence;
  end;

  TAdVT100Parser = class(TAdTerminalParser)
    {the VT100 terminal parser}
    private
      FArgCountMax : integer;
      FArgs        : PAdIntegerArray;
      FInVT52Mode  : boolean;
      FSavedSeq    : pointer;
      FSavedState  : TAdVTParserState;
      FSequence    : pointer;
      FState       : TAdVTParserState;
    protected
      function tpGetArgument(aInx : integer) : integer; override;
      function tpGetSequence : string; override;

      function vtpGetArguments : boolean;
      function vtpParseANSISeq(aCh : char) : TAdParserCmdType;
      function vtpProcessVT52(aCh : char) : TAdParserCmdType;
      function vtpValidateArgsPrim(aMinArgs : integer;
                                   aMaxArgs : integer;
                                   aDefault : integer) : boolean;

      procedure vtpGrowArgs;
    public
      constructor Create(aUseWideChar : boolean);
      destructor Destroy; override;

      function ProcessChar(aCh : AnsiChar) : TAdParserCmdType; override;
      {$IFDEF Win32}
      function ProcessWideChar(aCh : WideChar) :TAdParserCmdType; override;
      {$ENDIF}

      procedure Clear; override;

      property InVT52Mode : boolean read FInVT52Mode;
  end;


implementation

{===TAdTerminalParser================================================}
constructor TAdTerminalParser.Create(aUseWideChar : boolean);
begin
  inherited Create;
  FUseWideChar := aUseWideChar;
  FCommand := eNone;
end;
{--------}
destructor TAdTerminalParser.Destroy;
begin
  inherited Destroy;
end;
{--------}
procedure TAdTerminalParser.Clear;
begin
  {do nothing at this level}
end;
{--------}
procedure TAdTerminalParser.ForceCommand (Command : Integer);            {!!.03}
begin                                                                    {!!.03}
  Clear;                                                                 {!!.03}
  FCommand := Command;                                                   {!!.03}
end;                                                                     {!!.03}
{--------}
function TAdTerminalParser.ProcessChar(aCh : AnsiChar) : TAdParserCmdType;
begin
  Result := pctNone;
end;
{--------}
{$IFDEF Win32}
function TAdTerminalParser.ProcessWideChar(aCh : WideChar) : TAdParserCmdType;
begin
  Result := pctNone;
end;
{$ENDIF}
{--------}
function TAdTerminalParser.tpGetArgument(aInx : integer) : integer;
begin
  Result := 0;
end;
{--------}
function TAdTerminalParser.tpGetSequence : string;
begin
  Result := '';
end;
{====================================================================}


{====================================================================}
type
  PSeq = ^TSeq;
  TSeq = packed record
    sSize : longint;
    sLen  : longint;
    sText : array [1..10000] of AnsiChar;
  end;
{--------}
function ReAllocSeq(aSeq : PSeq; aSize : longint) : PSeq;
var
  NewSeq : PSeq;
begin
  if (aSize = 0) then
    NewSeq := nil
  else begin
    GetMem(NewSeq, 2*sizeof(longint) + aSize);
    NewSeq^.sSize := aSize;
    NewSeq^.sLen := 0;
    if (aSeq <> nil) then begin
      Move(aSeq^.sText, NewSeq^.sText, aSeq^.sLen);
      NewSeq^.sLen := aSeq^.sLen;
    end;
  end;
  if (aSeq <> nil) then
    FreeMem(aSeq, 2*sizeof(longint) + aSeq^.sSize);
  Result := NewSeq;
end;
{--------}
procedure AddCharToSeq(var aSeq : PSeq; aCh : AnsiChar);
begin
  if (aSeq = nil) then
    aSeq := ReAllocSeq(aSeq, 64)
  else if (aSeq^.sSize = aSeq^.sLen) then
    aSeq := ReAllocSeq(aSeq, aSeq^.sSize + 64);
  inc(aSeq^.sLen);
  aSeq^.sText[aSeq^.sLen] := aCh;
end;
{--------}
procedure AssignSeqToChar(var aSeq : PSeq; aCh : AnsiChar);
begin
  if (aSeq <> nil) then
    aSeq^.sLen := 0;
  AddCharToSeq(aSeq, aCh);
end;
{--------}
procedure CopySeq(aFromSeq : PSeq; var aToSeq : PSeq);
begin
  if (aFromSeq = nil) then begin
    if (aToSeq <> nil) then
      aToSeq^.sLen := 0;
  end
  else begin
    if (aToSeq = nil) or
       (aToSeq^.sSize < aFromSeq^.sLen) then
      aToSeq := ReAllocSeq(aToSeq, aFromSeq^.sLen);
    if (aToSeq <> nil) then begin
      aToSeq^.sLen := aFromSeq^.sLen;
      Move(aFromSeq^.sText, aToSeq^.sText, aFromSeq^.sLen);
    end;
  end;
end;
{--------}
procedure DelCharFromSeq(aSeq : PSeq);
begin
  if (aSeq <> nil) and (aSeq^.sLen > 0) then
    dec(aSeq^.sLen);
end;
{--------}
procedure ClearSeq(aSeq : PSeq);
begin
  if (aSeq <> nil) then
    aSeq^.sLen := 0;
end;
{--------}
function GetSeqLength(aSeq : PSeq) : integer;
begin
  Result := aSeq^.sLen;
end;
{--------}
function GetStringFromSeq(aSeq : PSeq) : string;
begin
  Result := '';
  if (aSeq <> nil) and (aSeq^.sLen > 0) then begin
    {$IFDEF Windows}
    Result[0] := char(aSeq^.sLen);
    {$ELSE}
    SetLength(Result, aSeq^.sLen);
    {$ENDIF}
    Move(aSeq^.sText, Result[1], aSeq^.sLen);
  end;
end;
{====================================================================}

const
  DECSCLseq : string[6] = ^['[61"p';

{===TAdVT100Parser===================================================}
constructor TAdVT100Parser.Create(aUseWideChar : boolean);
begin
  inherited Create(aUseWideChar);
  FArgCount := 0;
  vtpGrowArgs;
  FInVT52Mode := false;
end;
{--------}
destructor TAdVT100Parser.Destroy;