psvphpscript.pas

PIC 单片机 PAS SOURCE CODE SAMPLES

  case FLine[Run + 1] of
    '=':                               {inclusive or assign}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
    '|':                               {conditional or}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {inclusive or}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TpsvPHPRTF.PlusProc;
begin
  case FLine[Run + 1] of
    '=':                               {add assign}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
    '+':                               {increment}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {add}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TpsvPHPRTF.PointProc;
begin
  inc(Run);                            {point}
  fTokenID := tkSymbol;
end;

procedure TpsvPHPRTF.PoundProc;
begin
  repeat
    inc(Run);
  until FLine[Run] in [#0, #10, #13];
  fTokenID := tkComment;
end;

procedure TpsvPHPRTF.QuestionProc;
begin
  fTokenID := tkSymbol;                {question mark - conditional}
  inc(Run);
end;

procedure TpsvPHPRTF.RemainderSymbolProc;
begin
  case FLine[Run + 1] of
    '=':                               {remainder assign}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {remainder}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TpsvPHPRTF.RoundCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvPHPRTF.RoundOpenProc;
begin
  inc(Run);
  FTokenID := tkSymbol;
end;

procedure TpsvPHPRTF.SemiColonProc;
begin
  inc(Run);                            {semicolon}
  fTokenID := tkSymbol;
end;

procedure TpsvPHPRTF.SlashProc;
begin
  case FLine[Run + 1] of
    '/':                               {c++ style comments}
      begin
        inc(Run, 2);
        fTokenID := tkComment;
        while FLine[Run] <> #0 do
        begin
          case FLine[Run] of
            #10, #13: break;
          end;
          inc(Run);
        end;
      end;
    '*':
      begin
        fRange := rsComment;
        inc(Run);
        fTokenID := tkComment;       {c style comment}

        inc(Run);
        while fLine[Run] <> #0 do
          case fLine[Run] of
            '*':
              if fLine[Run + 1] = '/' then
              begin
                fRange := rsUnKnown;
                inc(Run, 2);
                break;
              end else inc(Run);
            #10: break;
            #13: break;
          else inc(Run);
          end;
      end;
    '=':                               {division assign}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {division}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TpsvPHPRTF.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSpace;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;

procedure TpsvPHPRTF.SquareCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvPHPRTF.SquareOpenProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TpsvPHPRTF.StringProc;
begin
  fRange := rsString34;
  fTokenID := tkString;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
      #92:                             {backslash}
        {if we have an escaped quote it doesn't count}
        if FLine[Run + 1] = #34 then inc(Run);
    end;
    inc(Run);
  until FLine[Run] = #34;
  if (FLine[Run] = #34) then
    fRange := rsUnKnown;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TpsvPHPRTF.TildeProc;
begin
  inc(Run);                            {bitwise complement}
  fTokenId := tkSymbol;
end;

procedure TpsvPHPRTF.VariableProc;
begin
  fTokenID := tkVariable;
  inc(Run);                            
  while Identifiers[fLine[Run]] do inc(Run);
end;

procedure TpsvPHPRTF.XOrSymbolProc;
begin
  Case FLine[Run + 1] of
    '=':                               {xor assign}
      begin
        inc(Run, 2);
        fTokenID := tkSymbol;
      end;
  else                                 {xor}
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

procedure TpsvPHPRTF.UnknownProc;
begin
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TpsvPHPRTF.AnsiCProc;
begin
  fTokenID := tkComment;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;
    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while FLine[Run] <> #0 do
    case FLine[Run] of
      '*':
        if fLine[Run + 1] = '/' then
        begin
          inc(Run, 2);
          fRange := rsUnKnown;
          break;
        end
        else inc(Run);
      #10: break;
      #13: break;
    else inc(Run);
    end;
end;

procedure TpsvPHPRTF.String39Proc;
begin
  fTokenID := tkString;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;
    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while FLine[Run] <> #0 do
    case FLine[Run] of
      #39:
        begin
          inc(Run);
          fRange := rsUnKnown;
          break;
        end;
      #10: break;
      #13: break;
    else inc(Run);
    end;
end;

procedure TpsvPHPRTF.String34Proc;
begin
  fTokenID := tkString;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;
    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while FLine[Run] <> #0 do
    case FLine[Run] of
      #34:
        begin
          inc(Run);
          fRange := rsUnKnown;
          break;
        end;
      #10: break;
      #13: break;
      #92:                             {backslash}
        {if we have an escaped quote it doesn't count}
        if FLine[Run + 1] = #34 then inc(Run, 2)
        else inc(Run);
    else inc(Run);
    end;
end;

procedure TpsvPHPRTF.Next;
begin
  fTokenPos := Run;
  case fRange of
    rsComment: AnsiCProc;
    rsString39: String39Proc;
    rsString34: String34Proc;
    else begin
      fRange := rsUnknown;
      fProcTable[fLine[Run]];
    end;
  end;
end;


function TpsvPHPRTF.GetEOL: Boolean;
begin
  Result := fTokenID = tkNull;
end;

function TpsvPHPRTF.GetRange: Pointer;
begin
  Result := Pointer(fRange);
end;

function TpsvPHPRTF.GetToken: String;
var
  Len: LongInt;
begin
  Len := Run - fTokenPos;
  SetString(Result, (FLine + fTokenPos), Len);
end;

function TpsvPHPRTF.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end;

function TpsvPHPRTF.GetTokenAttribute: integer;
begin
  case GetTokenID of
    tkComment: Result := 1;
    tkIdentifier: Result := 2;
    tkInvalidSymbol: Result := 3;
    tkKey: Result := 4;
    tkNumber: Result := 5;
    tkSpace: Result := 6;
    tkString: Result := 7;
    tkSymbol: Result := 8;
    tkVariable: Result := 9;
    tkUnknown: Result := 10;
    else Result := 11;
  end;
end;

function TpsvPHPRTF.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

function TpsvPHPRTF.GetTokenPos: Integer;
begin
  Result := fTokenPos;
end;

procedure TpsvPHPRTF.ResetRange;
begin
  fRange := rsUnknown;
end;

procedure TpsvPHPRTF.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;



procedure TpsvPHPRTF.SetupDefaultColors;
begin
  CreateColorTable([clBlue,     //1   tkComment
                    clBlack,    //2   tkIdentifier
                    clRed,      //3   tkInvalidSymbol
                    clNavy,     //4   tkKey
                    clGreen,    //5   tkNumber
                    clBlack,    //6   tkSpace
                    clMaroon,   //7   tkString
                    clBlack,    //8   tkSymbol
                    clBlack,    //9   tkVariable
                    clBlack,    //10  tkUnknown
                    clBlack]);  //11
end;

initialization
  MakeIdentTable;
end.