synhighlighterprogress.pas

SynEditStudio delphi 代码编辑器

{-------------------------------------------------------------------------------
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: SynHighlighterProgress.pas, released 2000-04-20.
The Initial Author of the Original Code is Bruno Mikkelsen.
Portions written by Bruno Mikkelsen are copyright 2000 Bruno Mikkelsen.
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: SynHighlighterProgress.pas,v 1.17 2005/01/28 16:53:24 maelh Exp $

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

Known Issues:
-------------------------------------------------------------------------------}
{
@abstract(Provides a Progress Syntax highlighter for SynEdit)
@author(Bruno Mikkelsen <[e-mail]>)
@created(2000-04-16)
@lastmod(2000-06-20)
The SynHighlighterProgress provides SynEdit with a syntax highlighter for the
Progress programming language.
Thanks to Michael Hieke for providing a sample highlighter on which this
highlighter is based.
}

{$IFNDEF QSYNHIGHLIGHTERPROGRESS}
unit SynHighlighterProgress;
{$ENDIF}

{$I SynEdit.inc}

interface

uses
{$IFDEF SYN_CLX}
  QGraphics,
  QSynEditTypes,
  QSynEditHighlighter,
  QSynHighlighterHashEntries,
{$ELSE}
  Graphics,
  SynEditTypes,
  SynEditHighlighter,
  SynHighlighterHashEntries,
{$ENDIF}
  SysUtils,
  Classes;

type
  {Enumerates the different tokens in Progress.}
  TtkTokenKind = (tkComment, tkEvent, tkIdentifier, tkInclude, tkKey,
    tkNonReserved, tkNull, tkNumber, tkPreprocessor, tkSpace, tkDataType,
    tkString, tkSymbol, tkUnknown);

  {Enumerates the ranges in Progress syntax.}
  TRangeState = (rsNone, rsInclude, rsPreprocessorDef, rsPreprocessor,
    rsComment);

  {Used to hold extra rangeinfo in the Lines.Objects pointer.}
  TRangeInfo = packed record
    case boolean of
      false: (Ptr: Pointer);
      true : (Range: Word;
              Level: Word);
  end;

  TProcTableProc = procedure of object;

  PIdentFuncTableFunc = ^TIdentFuncTableFunc;
  TIdentFuncTableFunc = function: TtkTokenKind of object;

type
  TSynProgressSyn = class(TSynCustomHighLighter)
  private
    fLine: PChar;
    fLineNumber: Integer;
    fRange: TRangeState;
    fCommentLevel: Integer;
    fIncludeLevel: Integer;
    fPreProcessorLevel: Integer;
    fProcTable: array[#0..#255] of TProcTableProc;
    Run: LongInt;
    fStringLen: Integer;
    fIdentChars: TSynIdentChars;
    fToIdent: PChar;
    fTokenPos: Integer;
    FTokenID: TtkTokenKind;
    fCommentAttri: TSynHighlighterAttributes;
    fEventAttri: TSynHighlighterAttributes;
    fIdentifierAttri: TSynHighlighterAttributes;
    fIncludeAttri: TSynHighlighterAttributes;
    fKeyAttri: TSynHighlighterAttributes;
    fNonReservedKeyAttri: TSynHighlighterAttributes;
    fNumberAttri: TSynHighlighterAttributes;
    fPreprocessorAttri: TSynHighlighterAttributes;
    fSpaceAttri: TSynHighlighterAttributes;
    fStringAttri: TSynHighlighterAttributes;
    fDataTypeAttri: TSynHighlighterAttributes;
    fSymbolAttri: TSynHighlighterAttributes;
    fHashList: TSynHashEntryList;
    function KeyHash(ToHash: PChar): Integer;
    function KeyComp(const aKey: string): Boolean;
    function IdentKind(MayBe: PChar): TtkTokenKind;
    procedure MakeMethodTables;
    procedure DoAddKeyword(AKeyword: string; AKind: integer);

    procedure AsciiCharProc;
    procedure CommentRangeProc;
    procedure IncludeRangeProc;
    procedure PreprocessorRangeProc;
    procedure PreprocessorDefinitionProc;
    procedure PreprocessorDefinitionRangeProc;
    procedure BraceOpenProc;
    procedure IdentProc;
    procedure NullProc;
    procedure NumberProc;
    procedure SlashProc;
    procedure SpaceProc;
    procedure StringProc;
    procedure UnknownProc;
    procedure SymbolProc;

  protected
    function GetDefaultAttribute(Index: integer): TSynHighlighterAttributes;
      override;
    function GetIdentChars: TSynIdentChars; override;
    function GetSampleSource: String; override;
    function IsFilterStored: Boolean; override;
  public
    class function GetLanguageName: string; override;
{$IFDEF DEBUG}
  public
    property Keywords: TSynHashEntryList read fHashList;
{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetEol: Boolean; override;
    function GetRange: Pointer; override;
    function GetTokenID: TtkTokenKind;
    procedure SetLine(NewValue: string; LineNumber: Integer); override;
    function GetToken: string; override;
    function GetTokenAttribute: TSynHighlighterAttributes; override;
    function GetTokenKind: integer; override;
    function GetTokenPos: Integer; override;
    procedure Next; override;
    procedure SetRange(Value: Pointer); override;
    procedure ResetRange; override;
    property IdentChars: TSynIdentChars read GetIdentchars write fIdentChars;
  published
    property CommentAttri: TSynHighlighterAttributes read fCommentAttri
      write fCommentAttri;
    property EventAttri: TSynHighlighterAttributes read fEventAttri
      write fEventAttri;
    property IdentifierAttri: TSynHighlighterAttributes read fIdentifierAttri
      write fIdentifierAttri;
    property IncludeAttri: TSynHighlighterAttributes read fIncludeAttri
      write fIncludeAttri;
    property KeyAttri: TSynHighlighterAttributes read fKeyAttri write fKeyAttri;
    property NonReservedKeyAttri: TSynHighlighterAttributes
      read fNonReservedKeyAttri write fNonReservedKeyAttri;
    property NumberAttri: TSynHighlighterAttributes read fNumberAttri
      write fNumberAttri;
    property PreprocessorAttri: TSynHighlighterAttributes
      read fPreprocessorAttri write fPreprocessorAttri;
    property SpaceAttri: TSynHighlighterAttributes read fSpaceAttri
      write fSpaceAttri;
    property StringAttri: TSynHighlighterAttributes read fStringAttri
      write fStringAttri;
    property DataTypeAttri: TSynHighlighterAttributes read fDataTypeAttri
      write fDataTypeAttri;
    property SymbolAttri: TSynHighlighterAttributes read fSymbolAttri
      write fSymbolAttri;
  end;

const
  DefaultKeywords: string =
                    'accum accumulate active-window add alias ' +
                    'all alter ambig ambiguous analyze ' +
                    'analyze-resume analyze-suspend and any apply ' +
                    'as asc ascending assign at ' +
                    'attr-space authorization auto-return avail available ' +
                    'background before-hide begins bell between ' +
                    'bin blank break btos by ' +
                    'byte call can-do can-find case ' +
                    'case-sensitive center centered check chr ' +
                    'clear clipboard col colon color ' +
                    'column column-label columns compiler control ' +
                    'count-of cpstream create ctos current ' +
                    'current-changed current-lang current-language current-window cursor ' +
                    'database dataservers dbcodepage dbcollation dbname ' +
                    'dbparam dbrestrictions dbtaskid dbtype dbversion ' +
                    'dde deblank debug-list debugger decimals ' +
                    'declare def default default-noxlate default-window ' +
                    'define delete delimiter desc descending ' +
                    'dict dictionary disable disconnect disp ' +
                    'display distinct do dos down ' +
                    'drop each editing else ' +
                    'elseif enable encode end endif ' +
                    'entry error-status escape etime except ' +
                    'exclusive exclusive-lock exists export false ' +
                    'fetch field fields file-info file-information ' +
                    'fill find find-case-sensitive find-global find-next-occurrence ' +
                    'find-prev-occurrence find-select find-wrap-around first first-of ' +
                    'focus font font-based-grid for form ' +
                    'format frame frame-col frame-db frame-down ' +
                    'frame-field frame-file frame-index frame-line frame-name ' +
                    'frame-row frame-val frame-value from from-chars ' +
                    'from-pixels gateways get-byte get-codepages get-collations ' +
                    'get-key-value getbyte glob global ' +
                    'global-define go-on go-pending grant graphic-edge ' +
                    'group having header help hide ' +
                    'if import in index ' +
                    'indicator input input-output insert into ' +
                    'is is-attr-space join kblabel key-code ' +
                    'key-function key-label keycode keyfunction keylabel ' +
                    'keys keyword label last last-event ' +
                    'last-key last-of lastkey ldbname leave ' +
                    'library like line-count line-counter line-number ' +
                    'listing locked long lookup machine-class ' +
                    'map member memptr message ' +
                    'message-lines mouse mpe new next ' +
                    'next-prompt no no-attr-space no-error no-fill ' +
                    'no-help no-hide no-label no-labels no-lock ' +
                    'no-map no-message no-pause no-prefetch no-undo ' +
                    'no-validate no-wait not null num-aliases ' +
                    'num-dbs num-entries of off old ' +
                    'on open opsys option ' +
                    'or os-append os-command os-copy os-create-dir ' +
                    'os-delete os-dir os-rename os2 os400 ' +
                    'otherwise output overlay page page-bottom ' +
                    'page-num page-number page-top param parameter ' +
                    'pause pdbname persistent pixels preprocess ' +
                    'privileges proc-handle proc-status process program-name ' +
                    'progress prompt prompt-for promsgs propath ' +
                    'proversion put put-byte put-key-value putbyte ' +
                    'query query-tuning quit r-index rcode-information ' +
                    'readkey recid record-length rectangle ' +
                    'release repeat reposition retain retry ' +
                    'return revert revoke run save ' +
                    'schema scop scoped scoped-define screen ' +
                    'screen-io screen-lines scroll sdbname search ' +
                    'seek select self sequence session ' +
                    'set setuserid share share-lock shared ' +
                    'short show-stats skip some space ' +
                    'status stream stream-io string-xref system-dialog ' +
                    'table term terminal text text-cursor ' +
                    'text-height text-seg-growth then this-procedure ' +
                    'time title to top-only trans ' +
                    'transaction trigger triggers trim true ' +
                    'undefine underline undo unformatted union ' +
                    'unique unix unless-hidden unsigned-short up ' +
                    'update use-index use-revvideo use-underline user ' +
                    'userid using v6frame value values ' +
                    'view view-as vms wait-for web-context ' +
                    'when where while window window-maximized ' +
                    'window-minimized window-normal with work-table workfile ' +
                    'write xcode xref yes _actailog ' +
                    '_actbilog _actbuffer _actindex _actiofile _actiotype ' +
                    '_actlock _actother _actpws _actrecord _actserver ' +
                    '_actspace _actsummary _block _buffstatus _cbit ' +
                    '_checkpoint _connect _control _db _dbstatus ' +
                    '_dcm _field _field-trig _file _file-trig ' +
                    '_filelist _index _index-field _license _list ' +
                    '_lock _lockreq _logging _memory _msg ' +
                    '_mstrblk _pcontrol _segments _sequence _serial-num ' +
                    '_servers _startup _trace _trans _user ' +
                    '_userio _userlock _view _view-col _view-ref';

  DefaultNonReservedKeywords: string =
                               'abs absolute accelerator across add-events-procedure ' +
                               'add-first add-last advise alert-box allow-replication ' +