highlightxml.pas

Delphi VCL Component Pack

  { I got Permition to add the XML HighLighter unit and to change the code
   by my needs from Ajay Tandon
   We thank him for that.
   bsalsa }

{*******************************************************}
{               RichEdit Syntax HighLight               }
{                     version 3.0                       }
{ Author:                                               }
{ Ajay Tandon                                           }
{                              }
{ bsalsa made some minor code changes                   }
{*******************************************************}
{-------------------------------------------------------------------------------
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: SynHighlighterXML.pas, released 2000-11-20.
The Original Code is based on the SynHighlighterHTML.pas file from the
mwEdit component suite by Martin Waldenburg and other developers, the Initial
Author of this file is Jeff Rafter.
All Rights Reserved.

Contributors to the SynEdit and mwEdit projects are listed in the
Contributors.txt file.

Alternatively, the contents of this file may be used under the terms of the
GNU General Public License Version 2 or later (the "GPL"), in which case
the provisions of the GPL are applicable instead of those above.
If you wish to allow use of your version of this file only under the terms
of the GPL and not to allow others to use your version of this file
under the MPL, indicate your decision by deleting the provisions above and
replace them with the notice and other provisions required by the GPL.
If you do not delete the provisions above, a recipient may use your version
of this file under either the MPL or the GPL.

$Id: SynHighlighterXML.pas,v 1.0 2000/11/20 00:00:00 mghie Exp $

You may retrieve the latest version of this file at the SynEdit home page,
located at http://SynEdit.SourceForge.net

History:
-------------------------------------------------------------------------------
2000-11-30 Removed mHashTable and MakeIdentTable per Michael Hieke

Known Issues:
-------------------------------------------------------------------------------}
//Nothing is really constrained (properly) to valid name chars
//Entity Refs are not constrained to valid name chars
//Support for "Combining Chars and Extender Chars" in names are lacking
//The internal DTD is not parsed (and not handled correctly)

{
@abstract(Provides an XML highlighter for SynEdit)
@author(Jeff Rafter-- Phil 4:13, based on SynHighlighterHTML by Hideo Koiso, converted to SynEdit by Michael Hieke)
@created(2000-11-17)
@lastmod(2000-11-17)
The SynHighlighterXML unit provides SynEdit with an XML highlighter. }

unit HighLightXML;

interface

{$I EWB.inc}

uses
   SysUtils, Windows, Messages, Classes, Controls, Graphics, HighLightRichSyntax;

type

   TtkTokenKind = (tkNull, tkElement, tkAttribute, tkText, tkCDATA, tkEntityRef,
      tkProcessingInstruction, tkComment, tkQuoteAttrValue, tkAposAttrValue,
      tkQuoteEntityRef, tkAposEntityRef, tkSymbol, tkSpace, tkEqual, tknsAttribute,
      tknsQuoteAttrValue, tknsAposAttrValue, tknsQuoteEntityRef, tknsAposEntityRef,
      tknsEqual, tkDocType);

   TRangeState = (rsElement, rsEqual, rsAttribute, rsQuoteAttrValue, rsAposAttrValue,
      rsQuoteEntityRef, rsAPosEntityRef, rsText, rsCDATA, rsEntityRef, rsProcessingInstruction,
      rsComment, rsnsEqual, rsnsQuoteAttrValue, rsnsAposAttrValue, rsnsQuoteEntityRef,
      rsnsAPosEntityRef, rsDocType);

   TProcTableProc = procedure of object;

   THighlightXML = class(THighlightRichSyntax)
   private
      fRange: TRangeState;
      fLine: PChar;
      Run: Longint;
      fTokenPos: Integer;
      fTokenID: TtkTokenKind;
      fLineNumber: Integer;
      fProcTable: array[#0..#255] of TProcTableProc;
      procedure NullProc;
      procedure CarriageReturnProc;
      procedure LineFeedProc;
      procedure SpaceProc;
      procedure LessThanProc;
      procedure GreaterThanProc;
      procedure CommentProc;
      procedure ProcessingInstructionProc;
      procedure DocTypeProc;
      procedure CDATAProc;
      procedure TextProc;
      procedure ElementProc;
      procedure AttributeProc;
      procedure QAttributeValueProc;
      procedure AAttributeValueProc;
      procedure EqualProc;
      procedure IdentProc;
      procedure MakeMethodTables;
      function NextTokenIs(T: string): Boolean;
      procedure EntityRefProc;
      procedure QEntityRefProc;
      procedure AEntityRefProc;
   protected
      function GetEol: Boolean; override;
      function GetRange: Pointer;
      function GetTokenID: TtkTokenKind;
      procedure SetLine(NewValue: string; LineNumber: Integer); override;
      function GetToken: string; override;
      function GetTokenAttribute: integer; override;
      function GetTokenKind: integer;
      function GetTokenPos: Integer;
      procedure Next; override;
      procedure SetRange(Value: Pointer);
      procedure ReSetRange;
      procedure PrepareToken(var AToken: string); override;
      function PrepareOutput(Attr: integer; AToken: string): string; override;
   public
      constructor Create; override;
      procedure SetupDefaultColors; override;
   end;

implementation

const
   SYNS_FilterXML = 'XML Document (*.xml,*.xsd,*.xsl,*.xslt)|*.xml;*.xsd;*.xsl;*.xslt';
   SYNS_LangXML = 'XML Document';

   NameChars: set of char = ['0'..'9', 'a'..'z', 'A'..'Z', '_', '.', ':', '-'];

constructor THighlightXML.Create;
begin
   inherited Create;
   inherited Create;
   MakeMethodTables;
   CreateColorTable([clGreen, //1
      clMaroon, //2
         clBlack, //3
         clBlue, //4
         clBlack, //5
         clGreen, //6
         clBlue, //7
         clBlack, //8
         clRed, //9
         clBlack, //10
         clBlack]); //11
   fRange := rsText;
end;

procedure THighlightXML.MakeMethodTables;
var
   i: Char;
begin
   for i := #0 to #255 do
      begin
         case i of
            #0:
               begin
                  fProcTable[i] := NullProc;
               end;
            #10:
               begin
                  fProcTable[i] := LineFeedProc;
               end;
            #13:
               begin
                  fProcTable[i] := CarriageReturnProc;
               end;
            #1..#9, #11, #12, #14..#32:
               begin
                  fProcTable[i] := SpaceProc;
               end;
            '<':
               begin
                  fProcTable[i] := LessThanProc;
               end;
            '>':
               begin
                  fProcTable[i] := GreaterThanProc;
               end;
            else
               fProcTable[i] := IdentProc;
         end;
      end;
end;

procedure THighlightXML.SetLine(NewValue: string; LineNumber: Integer);
begin
   fLine := PChar(NewValue);
   Run := 0;
   fLineNumber := LineNumber;
   Next;
end;

procedure THighlightXML.NullProc;
begin
   fTokenID := tkNull;
end;

procedure THighlightXML.CarriageReturnProc;
begin
   fTokenID := tkSpace;
   Inc(Run);
   if fLine[Run] = #10 then
      Inc(Run);
end;

procedure THighlightXML.LineFeedProc;
begin
   fTokenID := tkSpace;
   Inc(Run);
end;

procedure THighlightXML.SpaceProc;
begin
   Inc(Run);
   fTokenID := tkSpace;
   while fLine[Run] <= #32 do
      begin
         if fLine[Run] in [#0, #9, #10, #13] then
            break;
         Inc(Run);
      end;
end;

procedure THighlightXML.LessThanProc;
begin
   Inc(Run);
   if (fLine[Run] = '/') then
      Inc(Run);

   if (fLine[Run] = '!') then
      begin
         if NextTokenIs('--') then
            begin
               fTokenID := tkSymbol;
               fRange := rsComment;
               Inc(Run, 3);
            end
         else
            if NextTokenIs('DOCTYPE') then
               begin
                  fTokenID := tkDocType;
                  fRange := rsDocType;
                  Inc(Run, 7);
               end
            else
               if NextTokenIs('[CDATA[') then
                  begin
                     fTokenID := tkCDATA;
                     fRange := rsCDATA;
                     Inc(Run, 7);
                  end
               else
                  begin
                     fTokenID := tkSymbol;
                     fRange := rsElement;
                     Inc(Run);
                  end;
      end
   else
      if fLine[Run] = '?' then
         begin
            fTokenID := tkProcessingInstruction;
            fRange := rsProcessingInstruction;
            Inc(Run);
         end
      else
         begin
            fTokenID := tkSymbol;
            fRange := rsElement;
         end;
end;

procedure THighlightXML.GreaterThanProc;
begin
   fTokenId := tkSymbol;
   fRange := rsText;
   Inc(Run);
end;

procedure THighlightXML.CommentProc;
begin
   if (fLine[Run] = '-') and (fLine[Run + 1] = '-') and (fLine[Run + 2] = '>')
      then
      begin
         fTokenID := tkSymbol;
         fRange := rsText;
         Inc(Run, 3);
         Exit;
      end;

   fTokenID := tkComment;

   if (fLine[Run] in [#0, #10, #13]) then
      begin
         fProcTable[fLine[Run]];
         Exit;
      end;

   while not (fLine[Run] in [#0, #10, #13]) do
      begin
         if (fLine[Run] = '-') and (fLine[Run + 1] = '-') and (fLine[Run + 2] = '>')
            then
            begin
               fRange := rsComment;
               break;
            end;
         Inc(Run);
      end;
end;

procedure THighlightXML.ProcessingInstructionProc;
begin
   fTokenID := tkProcessingInstruction;
   if (fLine[Run] in [#0, #10, #13]) then
      begin
         fProcTable[fLine[Run]];
         Exit;
      end;

   while not (fLine[Run] in [#0, #10, #13]) do
      begin
         if (fLine[Run] = '>') and (fLine[Run - 1] = '?')
            then
            begin
               fRange := rsText;
               Inc(Run);
               break;
            end;
         Inc(Run);
      end;
end;

procedure THighlightXML.DocTypeProc;
begin
   fTokenID := tkDocType;
   fRange := rsDocType;

   if (fLine[Run] in [#0, #10, #13]) then
      begin
         fProcTable[fLine[Run]];
         Exit;
      end;

   while not (fLine[Run] in [#0, #10, #13]) do
      begin
         if (fLine[Run - 1] = ']') and (fLine[Run] = '>') then
            begin
               fRange := rsAttribute;
               Inc(Run);
               break;
            end;
         Inc(Run);
      end;
end;