Archivado/Componentes.Terceros.jvcl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b40ce04eb4
Componentes.Terceros.jvcl/official/3.32/run/JvHLEditor.pas

1913 lines
60 KiB
ObjectPascal
Raw Blame History

{-----------------------------------------------------------------------------
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/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvHLEditor.PAS, released on 2002-07-04.
The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.
Contributor(s): Eswar Prakash R [eswar dott prakash att gmail.com]
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
component : TJvHLEditor
description : JvEditor with built-in highlighting for:
pascal, cbuilder, sql, python, jscript,
vbscript, perl, ini, html, not quite c
Known Issues:
(rom) source cleaning incomplete
(rom) GetAttr should be broken up further
-----------------------------------------------------------------------------}
// $Id: JvHLEditor.pas 11043 2006-11-26 07:21:48Z marquardt $
{ history
(JVCL Library versions) :
1.03:
- first release;
1.11:
- improvements in custom reserved words support;
- comments works better in custom reserved words;
1.17:
- python highlighting by Rafal Smotrzyk - rsmotrzyk att mikroplan dott com dott pl;
1.17.2:
- jscript, vbscript highlighting by Rafal Smotrzyk - rsmotrzyk att mikroplan dott com dott pl;
1.17.6:
- html highlighting;
1.12.2:
- fixed bug with pressing End-key if CursorBeoyondEOF enabled
(greetings to Andre N Belokon)
1.23:
- fixed another bug in comment checking (range check error)
(greetings to Willo vd Merwe)
1.23.1:
- first version of perl highlighter;
1.41:
- fixed another bug in comment checking;
1.51.3 (JVCL Library 1.51 with Update 3):
- fixed bug: exception on comments in "c++, java, sql" - mode;
1.51.4 (JVCL Library 1.51 with Update 4):
- ini-file highlighter;
- fixed bug: custom reserved words not working;
1.61:
- new: in html-highlighter unknown (not html) tag highlighted with
"statement" color. This allows to use html-highlighter to display
xml-files.
2.10.2: (changes by Andreas Hausladen)
- C/C++ line continuation symbol '\' extends the highlight colors to the
next line (LongToken=True)
- "Not Quite C" highlighter (C similar, for programming LEGO MindStorm(R) robots)
- fixed bug: SetBlockColor raise an exception (AV) if iEnd becomes greater than
MAX_X
- in TRAHLEditor.GetAttr all IsXxxKeyWord get a CONST string, so no compiler
magic LStrAddRef is needed.
- some speed optimations
- new property DelphiColors: Boolean
- renamed all "Identifer" to "Identifier". published property "Identifer"
still exists but uses "FIdentifier"
- added some new DelphiKeyWord
- fixed bug: RescanLong() may exceed FLongDesc[] dimension
2.10.3: (changes by Andreas Hausladen
- faster RescanLong
- faster KeyWord search for drawing
3.0:
- added TJvEditorHighlighter component
}
unit JvHLEditor;
{$I jvcl.inc}
interface
uses
Windows,
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
SysUtils, Classes, Graphics,
JvEditor, JvEditorCommon, JvHLParser;
type
TJvHLEditor = class;
TOnReservedWord = procedure(Sender: TObject; Token: string;
var Reserved: Boolean) of object;
TJvEditorHighlighter = class(TComponent)
protected
procedure GetAttr(Editor: TJvHLEditor; Lines: TStrings; Line, ColBeg, ColEnd: Integer;
LongToken: TLongTokenType; var LineAttrs: TLineAttrs); virtual; abstract;
procedure ScanLongTokens(Editor: TJvHLEditor; Lines: TStrings; Line: Integer;
var FLong: TLongTokenType); virtual; abstract;
function GetRescanLongKeys(Editor: TJvHLEditor; Action: TModifiedAction;
ACaretX, ACaretY: Integer; const Text: string): Boolean; virtual; abstract;
end;
TJvHLEditor = class(TJvEditor, IJvHLEditor)
private
Parser: TJvIParser;
FHighlighter: TJvHighlighter;
FColors: TJvColors;
FLine: string;
FLineNum: Integer;
FLong: TLongTokenType;
FLongTokens: Boolean;
FLongDesc: array {[0..Max_Line]} of TLongTokenType;
FSyntaxHighlighting: Boolean;
FSyntaxHighlighter: TJvEditorHighlighter;
FOnReservedWord: TOnReservedWord;
// Coco/R
ProductionsLine: Integer;
function RescanLong(iLine: Integer): Boolean;
procedure CheckInLong;
function FindLongEnd: Integer;
procedure SetHighlighter(const Value: TJvHighlighter);
function GetDelphiColors: Boolean;
procedure SetDelphiColors(Value: Boolean);
function GetColors: TJvColors;
procedure SetColors(const Value: TJvColors);
function GetSyntaxHighlighting: Boolean;
procedure SetSyntaxHighlighting(Value: Boolean);
function GetHighlighter: TJvHighlighter;
protected
procedure Loaded; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure GetAttr(Line, ColBeg, ColEnd: Integer); override;
procedure TextModified(ACaretX, ACaretY: Integer; Action: TModifiedAction;
const Text: string); override;
function GetReservedWord(const Token: string; var Reserved: Boolean): Boolean; virtual;
function UserReservedWords: Boolean; virtual;
procedure SetSyntaxHighlighter(const Value: TJvEditorHighlighter);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
published
property Highlighter: TJvHighlighter read GetHighlighter write SetHighlighter default hlPascal;
property Colors: TJvColors read GetColors write SetColors;
property DelphiColors: Boolean read GetDelphiColors write SetDelphiColors stored False;
property LongTokens: Boolean read FLongTokens write FLongTokens default True;
property OnReservedWord: TOnReservedWord read FOnReservedWord write FOnReservedWord;
property SyntaxHighlighting: Boolean read GetSyntaxHighlighting write SetSyntaxHighlighting stored False;
property SyntaxHighlighter: TJvEditorHighlighter read FSyntaxHighlighter write SetSyntaxHighlighter;
end;
{$IFDEF UNITVERSIONING}
const
UnitVersioning: TUnitVersionInfo = (
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvHLEditor.pas $';
Revision: '$Revision: 11043 $';
Date: '$Date: 2006-11-26 08:21:48 +0100 (dim., 26 nov. 2006) $';
LogPath: 'JVCL\run'
);
{$ENDIF UNITVERSIONING}
implementation
uses
Math,
JvConsts, JvJCLUtils;
function LastNonSpaceChar(const S: string): Char;
var
I: Integer;
begin
Result := #0;
I := Length(S);
while (I > 0) and (S[I] = ' ') do
Dec(I);
if I > 0 then
Result := S[I];
end;
function GetTrimChar(const S: string; Index: Integer): Char;
var
LS, L: Integer;
begin
LS := Length(S);
if LS <> 0 then
begin
L := 1;
while (L <= LS) and (S[L] = ' ') do
Inc(L);
if L <= LS then
Result := S[L - 1 + Index]
else
Result := S[Index];
end
else
Result := #0;
end;
function HasStringOpenEnd(Lines: TStrings; iLine: Integer): Boolean;
{ find C/C++ "line breaker" '\' }
var
I: Integer;
IsOpen: Boolean;
P, F: PChar;
S: string;
begin
Result := False;
if (iLine < 0) or (iLine >= Lines.Count) then
Exit;
I := iLine - 1;
IsOpen := False;
if (I >= 0) and (LastNonSpaceChar(Lines[I]) = '\') then // check prior lines
IsOpen := HasStringOpenEnd(Lines, I);
S := Lines[iLine];
F := PChar(S);
P := F;
repeat
P := StrScan(P, Char('"'));
if P <> nil then
begin
if (P = F) or (P[-1] <> '\') then
IsOpen := not IsOpen
else
begin
// count the backslashes
I := 1;
while (P-1-I > F) and (P[-1-I] = '\') do
Inc(I);
if I mod 2 = 0 then
IsOpen := not IsOpen;
end;
Inc(P);
end;
until P = nil;
Result := IsOpen;
end;
function StrScan(P: PChar; Ch: Char): PChar;
begin
Result := P;
while True do
begin
while Result[0] in LeadBytes do
Inc(Result); // mbcs
if Result[0] = Ch then
Exit
else
if Result[0] = #0 then
begin
Result := nil;
Exit;
end;
Inc(Result);
end;
end;
//=== { TJvHLEditor } ========================================================
constructor TJvHLEditor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Parser := TJvIParser.Create;
Parser.ReturnComments := True;
FHighlighter := hlPascal;
FColors := TJvColors.Create;
FLongTokens := True;
FSyntaxHighlighting := True;
ProductionsLine := High(Integer);
end;
destructor TJvHLEditor.Destroy;
begin
Parser.Free;
FColors.Free;
inherited Destroy;
end;
procedure TJvHLEditor.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FSyntaxHighlighter) then
SyntaxHighlighter := nil;
inherited Notification(AComponent, Operation);
end;
procedure TJvHLEditor.Loaded;
begin
inherited Loaded;
RescanLong(0);
end;
procedure TJvHLEditor.SetHighlighter(const Value: TJvHighlighter);
begin
if FHighlighter <> Value then
begin
FHighlighter := Value;
case FHighlighter of
hlPascal:
Parser.Style := psPascal;
hlCBuilder, hlJava, hlJScript, hlNQC, hlCSharp:
Parser.Style := psCpp;
hlPython:
Parser.Style := psPython;
hlVB:
Parser.Style := psVB;
hlHtml:
Parser.Style := psHtml;
hlPerl:
Parser.Style := psPerl;
hlIni:
Parser.Style := psPascal;
hlCocoR:
Parser.Style := psCocoR;
hlPhp:
Parser.Style := psPhp;
hlSql:
Parser.Style := psSql;
end;
RescanLong(0);
Invalidate;
end;
end;
procedure TJvHLEditor.GetAttr(Line, ColBeg, ColEnd: Integer);
const
Symbols = [',', ':', ';', '.', '[', ']', '(', ')', '=', '+',
'-', '/', '<', '>', '%', '*', '~', '''', '\', '^', '@', '{', '}',
'#', '|', '&'];
const
DelphiKeyWords =
' constructor destructor string record procedure with of' +
' repeat until try finally except for to downto case' +
' type interface implementation initialization finalization' +
' default private public protected published automated property' +
' program read write override object nil raise' +
' on set xor shr shl begin end args if then else' +
' endif goto while do var or and not mod div unit' +
' function uses external const class inherited' +
' register stdcall cdecl safecall pascal is as package program' +
' external overload platform deprecated implements export contains' +
' requires resourcestring message dispid assembler asm abstract absolute' +
' dispinterface file threadvar library' +
// TurboPascal
' interrupt inline near far' +
// Delphi 8
' operator strict final unsafe sealed static ';
BuilderKeyWords =
' __asm _asm asm auto __automated break bool case catch __cdecl' +
' _cdecl cdecl char class __classid __closure const const_cast' +
' continue __declspec default delete __dispid do double dynamic_cast' +
' else enum __except explicit _export __export extern false __fastcall' +
' _fastcall __finally float for friend goto if __import _import inline' +
' int __int8 __int16 __int32 __int64 long mutable namespace new operator' +
' __pascal _pascal pascal private protected __property public __published' +
' register reinterpret_cast return __rtti short signed sizeof static static_cast' +
' __stdcall _stdcall struct switch template this __thread throw true __try' +
' try typedef typename typeid union using unsigned virtual void volatile' +
' wchar_t while ';
NQCKeyWords = {Not Quite C - a C similar language for programming LEGO MindStorm(R) robots }
' __event_src __type acquire break __sensor abs asm case catch const' +
' continue default do else false for if inline' +
' int monitor repeat return signed start stop sub switch task true' +
' until void while ';
// REPLACE keyword added to the list
SQLKeyWords =
' active as add asc after ascending all at alter auto' +
' and autoddl any avg based between basename blob' +
' base_name blobedit before buffer begin by cache compiletime' +
' cast computed char close character conditional character_length connect' +
' char_length constraint check containing check_point_len continue check_point_length count' +
' collate create collation cstring column current commit cursor' +
' committed database descending date describe db_key descriptor debug disconnect' +
' dec display decimal distinct declare do default domain' +
' delete double desc drop echo exception edit execute' +
' else exists end exit entry_point extern escape external' +
' event extract fetch foreign file found filter from' +
' float full for function gdscode grant generator group' +
' gen_id commit_group_wait global group_commit_wait_time goto' +
' having help if input_type immediate insert in int' +
' inactive integer index into indicator is init isolation' +
' inner isql input join key' +
' lc_messages like lc_type logfile left log_buffer_size length log_buf_size' +
' lev long level manual merge max message' +
' maximum min maximum_segment minimum max_segment module_name names not' +
' national null natural numeric nchar num_log_bufs no num_log_buffers' +
' noauto octet_length or of order on outer only output' +
' open output_type option overflow page post_event pagelength precision' +
' pages prepare page_size procedure parameter protected password primary' +
' plan privileges position public quit' +
' raw_partitions retain rdb db_key return read replace returning_values real returns' +
' record_version revoke references right release rollback reserv runtime replace' +
' reserving schema sql segment sqlcode select sqlerror set sqlwarning' +
' shadow stability shared starting shell starts show statement' +
' singular static size statistics smallint sub_type snapshot sum' +
' some suspend sort table translate terminator translation then trigger to trim' +
' transaction uncommitted upper union user unique using update' +
' value varying values version varchar view variable' +
' wait while when with whenever work where write' +
' term new old ';
PythonKeyWords =
' and del for is raise' +
' assert elif from lambda return' +
' break else global not try' +
' class except if or while' +
' continue exec import pass' +
' def finally in print ';
JavaKeyWords =
' abstract delegate if boolean do implements break double import' +
' byte else instanceof case extends int catch false interface' +
' char final long class finally multicast continue float' +
' default for native short transient new static true' +
' null super try package switch void private synchronized volatile' +
' protected this while public throw return throws ';
JScriptKeyWords =
//'@cc_on @if @set'
' break delete function return typeof case do if switch var' +
' catch else in this void continue false instanceof throw while' +
' debugger finally new true with default for null try' +
' abstract double goto native static boolean enum implements package super' +
' byte export import private synchronized char extends int protected throws' +
' class final interface public transient const float long short volatile' ;
VBKeyWords =
' as and base binary byref byval call case class compare const date debug declare deftype dim do each else elseif ' +
' empty end endif enum eqv erase error event execute exit explicit false for friend function get' +
' global gosub goto if imp implements input is kill len let line load lock loop lset me mid mod name new next not nothing null on open option optional' +
' or paramarray preserve print private property public raiseevent randomize redim rem' +
' resume return seek select set static step' +
' string sub then time to true unlock until wend while with withevents xor ';
VBStatements =
' access alias any beep ccur cdbl chdir chdrive choose' +
' chr cint clear clng clone close cls command compare' +
' cos csng cstr curdir currency cvar cvdate ' +
' defcur defdbl defint deflng defsng defstr deftype defvar delete deletesetting' +
' doevents double dynaset edit environ eof erl err exp fix format ' +
' hex int integer isdate isempty isnull isnumeric lbound lcase' +
' lib like loc local lof long mkdir oct output pset put' +
' random read refresh reset restore rmdir rnd rset savesetting ' +
' sendkeys shared single stop system text type typeof ubound unload ' +
' using variant vartype write';
HTMLTags =
' doctype a address applet area b base basefont bgsound big blink ' +
' blockquote body br caption center cite code col colgroup comment ' +
' dfn dir li div dl dt dd em embed font form frame frameset h align ' +
' h1 h2 h3 h4 h5 h6 head hr html i iframe img input isindex kbd link ' +
' listing map marquee menu meta multicol nextid nobr noframes noscript ' +
' object ol option p plaintext pre s samp script select small sound ' +
' spacer span strike strong style sub sup table tbody td textarea tfoot' +
' th thead title tr tt u ul var wbr xmp ';
HTMLSpecChars =
' Aacute aacute acirc Acirc acute AElig aelig agrave Agrave alefsym ' +
' alpha Alpha AMP amp and ang Aring aring asymp atilde Atilde Auml ' +
' auml bdquo beta Beta brvbar bull cap Ccedil ccedil cedil cent chi ' +
' Chi circ clubs cong copy COPY crarr cup curren dagger Dagger dArr ' +
' darr deg Delta delta diams divide eacute Eacute ecirc Ecirc Egrave ' +
' egrave empty emsp ensp Epsilon epsilon equiv eta Eta ETH eth Euml ' +
' euml euro exist fnof forall frac12 frac14 frac34 frasl Gamma gamma ' +
' ge gt GT harr hArr hearts hellip iacute Iacute Icirc icirc iexcl Igrave ' +
' igrave image infin int Iota iota iquest isin Iuml iuml kappa Kappa Lambda ' +
' lambda lang laquo larr lArr lceil ldquo le lfloor lowast loz lrm lsaquo ' +
' lsquo lt LT macr mdash micro middot minus mu Mu nabla nbsp ndash ne ' +
' ni not notin nsub Ntilde ntilde Nu nu oacute Oacute ocirc Ocirc oelig ' +
' OElig ograve Ograve oline Omega omega omicron Omicron oplus or ordf ' +
' ordm Oslash oslash Otilde otilde otimes ouml Ouml para part permil ' +
' perp phi Phi Pi pi piv plusmn pound Prime prime prod prop psi Psi quot ' +
' QUOT radic rang raquo rArr rarr rceil rdquo real REG reg rfloor Rho ' +
' rho rlm rsaquo rsquo sbquo scaron Scaron sdot sect shy Sigma sigma ' +
' sigmaf sim spades sub sube sum sup sup1 sup2 sup3 supe szlig Tau ' +
' tau there4 Theta theta thetasym thinsp THORN thorn tilde times trade ' +
' Uacute uacute uArr uarr ucirc Ucirc ugrave Ugrave uml upsih upsilon ' +
' Upsilon uuml Uuml weierp xi Xi Yacute yacute yen yuml Yuml zeta Zeta ' +
' zwj zwnj ';
PerlKeyWords =
' sub if else unless foreach next local ' +
' return defined until while do elsif eq ';
PerlStatements =
' stat die open print push close defined chdir last read chop ' +
' keys sort bind unlink select length ';
CocoKeyWords = DelphiKeyWords +
' compiler productions delphi end_delphi ignore case characters ' +
' tokens create destroy errors comments from nested chr any ' +
' description ';
CSharpKeyWords =
' abstract as base bool break byte case catch char checked class ' +
' const continue decimal default delegate do double else enum event ' +
' explicit extern false finally fixed float for foreach goto if ' +
' implicit in int interface internal is lock long namespace new null ' +
' object operator out override params private protected public readonly ' +
' ref return sbyte sealed short sizeof stackalloc static string struct ' +
' switch this throw true try typeof uint ulong unchecked unsafe ushort ' +
' using virtual void volatile while ';
function PosI(const S1, S2: string): Boolean;
var
F, P: PChar;
Len: Integer;
begin
Len := Length(S1);
Result := True;
P := PChar(S2);
while P[0] <> #0 do
begin
while P[0] = ' ' do
Inc(P);
F := P;
while not (P[0] <= #32) do
Inc(P);
if (P - F) = Len then
if StrLIComp(PChar(S1), F, Len) = 0 then
Exit;
end;
Result := False;
end;
function PosNI(const S1, S2: string): Boolean;
var
F, P: PChar;
Len: Integer;
begin
Len := Length(S1);
Result := True;
P := PChar(S2);
while P[0] <> #0 do
begin
while P[0] = ' ' do
Inc(P);
F := P;
while not (P[0] <= #32) do
Inc(P);
if (P - F) = Len then
if StrLComp(PChar(S1), F, Len) = 0 then
Exit;
end;
Result := False;
end;
function IsDelphiKeyWord(const St: string): Boolean;
begin
Result := PosI(St, DelphiKeyWords);
end;
function IsBuilderKeyWord(const St: string): Boolean;
begin
Result := PosNI(St, BuilderKeyWords);
end;
function IsNQCKeyWord(const St: string): Boolean;
begin
Result := PosNI(St, NQCKeyWords);
end;
function IsJavaKeyWord(const St: string): Boolean;
begin
Result := PosNI(St, JavaKeyWords);
end;
function IsJScriptKeyWord(const St: string): Boolean;
begin
Result := PosNI(St, JScriptKeyWords);
end;
function IsVBKeyWord(const St: string): Boolean;
begin
Result := PosI(St, VBKeyWords);
end;
function IsVBStatement(const St: string): Boolean;
begin
Result := PosI(St, VBStatements);
end;
function IsSQLKeyWord(const St: string): Boolean;
begin
Result := PosI(St, SQLKeyWords);
end;
function IsPythonKeyWord(const St: string): Boolean;
begin
Result := PosNI(St, PythonKeyWords);
end;
function IsHtmlTag(const St: string): Boolean;
begin
Result := PosI(St, HTMLTags);
end;
function IsHtmlSpecChar(const St: string): Boolean;
begin
Result := PosI(St, HTMLSpecChars);
end;
function IsPerlKeyWord(const St: string): Boolean;
begin
Result := PosNI(St, PerlKeyWords);
end;
function IsPerlStatement(const St: string): Boolean;
begin
Result := PosNI(St, PerlStatements);
end;
function IsCocoKeyWord(const St: string): Boolean;
begin
Result := PosI(St, CocoKeyWords);
end;
function IsPhpKeyWord(const St: string): Boolean;
begin
Result := PosNI(St, PerlKeyWords);
end;
function IsCSharpKeyWord(const St: string): Boolean;
begin
Result := PosNI(St, CSharpKeyWords);
end;
function IsComment(const St: string): Boolean;
var
LS: Integer;
begin
LS := Length(St);
case Highlighter of
hlPascal:
Result := ((LS > 0) and (St[1] = '{')) or
((LS > 1) and (((St[1] = '(') and (St[2] = '*')) or
((St[1] = '/') and (St[2] = '/'))));
hlCBuilder, hlJava, hlJScript, hlPhp, hlNQC, hlCSharp:
Result := (LS > 1) and (St[1] = '/') and
((St[2] = '*') or (St[2] = '/'));
// Support for SQL comment line beginning with --
hlSql:
Result := (LS > 1) and (((St[1] = '-') and
(St[2] = '-')) or
(St[1] = '/') and ((St[2] = '*'))); // support for /* */
// HTML multi line comment support
hlHtml:
Result := (LS > 3) and (St[1] = '<') and (St[2] = '!') and
(St[3] = '-') and (St[4] = '-');
hlVB:
Result := (LS > 0) and (St[1] = '''');
hlPython, hlPerl:
Result := (LS > 0) and (St[1] = '#');
hlIni:
Result := (LS > 0) and ((St[1] = '#') or (St[1] = ';'));
hlCocoR:
Result := (LS > 1) and (((St[1] = '/') and (St[2] = '/')) or
((St[1] = '(') and (St[2] = '*')) or
((St[1] = '/') and (St[2] = '*'))
);
else
Result := False;
end;
end;
function IsPreproc(const St: string): Boolean;
var
LS: Integer;
begin
LS := Length(St);
case Highlighter of
hlPascal:
Result := ((LS > 0) and ((St[1] = '{') and (St[2] = '$'))) or
((LS > 1) and (((St[1] = '(') and (St[2] = '*') and (St[3] = '$'))));
{hlCBuilder, hlSql, hlJava, hlJscript, hlPhp, hlNQC:
hlVB:
hlPython, hlPerl:
hlIni:
hlCocoR:}
else
Result := False;
end;
end;
function IsStringConstant(const St: string): Boolean;
var
LS: Integer;
begin
LS := Length(St);
case FHighlighter of
hlPascal, hlCBuilder, hlSql, hlPython, hlJava, hlJScript, hlPerl, hlCocoR, hlPhp,
hlNQC, hlCSharp:
Result := (LS > 0) and ((St[1] = '''') or (St[1] = '"'));
hlVB:
Result := (LS > 0) and (St[1] = '"');
hlHtml:
Result := False;
else
Result := False; { unknown Highlighter ? }
end;
end;
procedure SetBlockColor(iBeg, iEnd: Integer; Color: TJvSymbolColor);
var
I: Integer;
begin
if iEnd > Max_X then
iEnd := Max_X;
for I := iBeg to iEnd do
with LineAttrs[I] do
begin
FC := Color.ForeColor;
BC := Color.BackColor;
Style := Color.Style;
Border := clNone;
end;
end;
procedure SetColor(Color: TJvSymbolColor);
begin
SetBlockColor(Parser.PosBeg[0] + 1, Parser.PosEnd[0], Color);
end;
function NextSymbol: string;
var
I: Integer;
begin
I := 0;
while (Parser.pcPos[I] <> #0) and (Parser.pcPos[I] in [' ', Tab, Cr, Lf]) do
Inc(I);
Result := Parser.pcPos[I];
end;
procedure TestHtmlSpecChars(const Token: string);
var
I, J, iBeg, iEnd: Integer;
S1: string;
F1: Integer;
begin
I := 1;
F1 := Parser.PosBeg[0];
while I <= Length(Token) do
begin
if Token[I] = '&' then
begin
iBeg := I;
iEnd := iBeg;
Inc(I);
while I <= Length(Token) do
begin
if Token[I] = ';' then
begin
iEnd := I;
Break;
end;
Inc(I);
end;
if iEnd > iBeg + 1 then
begin
S1 := Copy(Token, iBeg + 1, iEnd - iBeg - 1);
if IsHtmlSpecChar(S1) then
for J := iBeg to iEnd do
with LineAttrs[F1 + J] do
begin
FC := Colors.Preproc.ForeColor;
BC := Colors.Preproc.BackColor;
Style := Colors.Preproc.Style;
Border := clNone;
end;
end;
end;
Inc(I);
end;
end;
procedure SetIniColors(const S: string);
var
EquPos: Integer;
LS: Integer;
begin
LS := Length(S);
if (LS > 0) and (S[1] = '[') and (S[LS] = ']') then
SetBlockColor(0, LS, Colors.Declaration)
else
begin
EquPos := Pos('=', S);
if EquPos > 0 then
begin
SetBlockColor(0, EquPos, Colors.Identifier);
SetBlockColor(EquPos, EquPos, Colors.Symbol);
SetBlockColor(EquPos + 1, LS, Colors.Strings);
end;
end;
end;
// for Coco/R
procedure HighlightGrammarName(const S: string);
var
P: Integer;
begin
P := Pos('-->Grammar<--', S);
if P > 0 then
SetBlockColor(P, P + Length('-->Grammar<--') - 1, Colors.Preproc);
end;
// (rom) const, var, local function sequence not cleaned up yet
var
F: Boolean;
C: TJvSymbolColor;
Reserved: Boolean;
PrevToken: string;
PrevToken2: string;
NextToken: string;
Ch: Char;
InTag: Boolean;
N: Integer;
var
S: string;
LS: Integer;
Token: string;
I: Integer;
begin
if not FSyntaxHighlighting then
Exit;
S := Lines[Line];
if (FHighlighter = hlNone) and not UserReservedWords then
C := Colors.PlainText
else
begin
FLine := S;
FLineNum := Line;
CheckInLong;
if (FHighlighter = hlSyntaxHighlighter) and (FSyntaxHighlighter <> nil) then
begin
// user defined syntax highlighting
FSyntaxHighlighter.GetAttr(Self, Lines, Line, ColBeg, ColEnd, FLong, LineAttrs);
Exit;
end;
Parser.pcProgram := PChar(S);
Parser.pcPos := Parser.pcProgram;
LS := Length(S);
Ch := GetTrimChar(S, 1);
if (Highlighter in [hlCBuilder, hlNQC]) and (LS > 0) and
(((Ch = '#') and (FLong = 0)) or (FLong = lgPreproc)) then
C := Colors.Preproc
else
if ((FHighlighter in [hlPython, hlPerl]) and (LS > 0) and
(Ch = '#') and (FLong = 0)) or
((Highlighter = hlIni) and (LS > 0) and ((Ch = '#') or (Ch = ';'))) then
C := Colors.Comment
else
C := Colors.PlainText;
// (rom) reenabled second part of if to handle two line DOCTYPE
if (FLong <> 0) and (FHighlighter <> hlHtml) then
begin
Parser.pcPos := Parser.pcProgram + FindLongEnd + 1;
case Highlighter of
hlCBuilder, hlPython, hlPerl, hlNQC, hlCSharp, hlHtml:
case FLong of
lgString:
C := Colors.Strings;
lgComment1, lgComment2:
C := Colors.Comment;
lgPreproc:
C := Colors.Preproc;
end;
hlPascal:
case FLong of
lgComment1, lgComment2:
C := Colors.Comment;
lgPreproc1, lgPreproc2:
C := Colors.Preproc;
end;
else
C := Colors.Comment;
end;
end;
end;
LineAttrs[1].FC := C.ForeColor;
LineAttrs[1].Style := C.Style;
LineAttrs[1].BC := C.BackColor;
LineAttrs[1].Border := clNone;
N := Min(Max_X, Length(S));
for I := 2 to N do
Move(LineAttrs[1], LineAttrs[I], SizeOf(LineAttrs[1]));
if Length(S) < Max_X then
begin
LineAttrs[N + 1].FC := Font.Color;
LineAttrs[N + 1].Style := Font.Style;
LineAttrs[N + 1].BC := Color;
LineAttrs[N + 1].Border := clNone;
for I := N + 1 + 1 to Max_X do
Move(LineAttrs[N + 1], LineAttrs[I], SizeOf(LineAttrs[1]));
end;
if (FHighlighter = hlNone) and not UserReservedWords then
Exit;
if (Length(S) > 0) then
begin
Ch := GetTrimChar(S, 1);
if ((Ch = '#') and (FHighlighter in [hlCBuilder, hlPython, hlPerl, hlNQC])) or
(((Ch = '#') or (Ch = ';')) and (FHighlighter = hlIni)) then
Exit;
end;
if FHighlighter = hlIni then
SetIniColors(S)
else
try
InTag := FLong = lgTag;
PrevToken := '';
PrevToken2 := '';
Token := Parser.Token;
while Token <> '' do
begin
F := True;
if GetReservedWord(Token, Reserved) then
begin
if Reserved then
SetColor(Colors.Reserved)
else
F := False;
end
else
case FHighlighter of
hlPascal:
if IsDelphiKeyWord(Token) then
SetColor(Colors.Reserved)
else
F := False;
hlCBuilder:
if IsBuilderKeyWord(Token) then
SetColor(Colors.Reserved)
else
F := False;
hlNQC:
if IsNQCKeyWord(Token) then
SetColor(Colors.Reserved)
else
F := False;
hlSql:
if IsSQLKeyWord(Token) then
SetColor(Colors.Reserved)
else
F := False;
hlPython:
if IsPythonKeyWord(Token) then
SetColor(Colors.Reserved)
else
if Token = 'None' then
SetColor(Colors.Number)
else
if (PrevToken = 'def') or (PrevToken = 'class') then
SetColor(Colors.Declaration)
else
if (NextSymbol = '(') and IsIdentifier(Token) then
SetColor(Colors.FunctionCall)
else
F := False;
hlJava:
if IsJavaKeyWord(Token) then
SetColor(Colors.Reserved)
else
if PrevToken = 'function' then
SetColor(Colors.Declaration)
else
F := False;
hlJScript:
if IsJScriptKeyWord(Token) then
SetColor(Colors.Reserved)
else
if PrevToken = 'function' then
SetColor(Colors.Declaration)
else
F := False;
hlVB:
if IsVBKeyWord(Token) then
SetColor(Colors.Reserved)
else
if IsVBStatement(Token) then
SetColor(Colors.Statement)
else
if SameText(PrevToken, 'function') or SameText(PrevToken, 'sub') or
SameText(PrevToken, 'class') then
SetColor(Colors.Declaration)
else
F := False;
hlHtml:
if not InTag then
begin
{ Check for the comment starting
with <!-- and force the hilighter to check for
the comments }
if Token = '<!--' then
begin
InTag := True;
SetColor(Colors.Comment);
F := False;
end
else
if Token = '<' then
begin
InTag := True;
SetColor(Colors.Reserved);
F := True;
end
else
F := False;
end
else
begin
if Token = '-->' then
begin
InTag := False;
SetColor(Colors.Reserved);
F := False;
end
else
if Token = '>' then
begin
InTag := False;
SetColor(Colors.Reserved)
end
else
if (Token = '/') and (PrevToken = '<') then
SetColor(Colors.Reserved)
else
if (NextSymbol = '=') and IsIdentifier(Token) then
SetColor(Colors.Identifier)
else
if PrevToken = '=' then
SetColor(Colors.Strings)
else
if IsHtmlTag(Token) then
SetColor(Colors.Reserved)
else
if (PrevToken = '<') or ((PrevToken = '/') and (PrevToken2 = '<')) then
SetColor(Colors.Statement)
else
F := False;
end;
hlPerl:
if IsPerlKeyWord(Token) then
SetColor(Colors.Reserved)
else
if IsPerlStatement(Token) then
SetColor(Colors.Statement)
else
if (Token[1] in ['$', '@', '%', '&']) then
SetColor(Colors.FunctionCall)
else
F := False;
hlCocoR:
if IsCocoKeyWord(Token) then
SetColor(Colors.Reserved)
else
if (Parser.PosBeg[0] = 0) and (Line > ProductionsLine) and
IsIdentifier(Token) then
begin
NextToken := Parser.Token;
Parser.RollBack(1);
SetColor(Colors.Declaration)
end
else
F := False;
hlPhp:
if IsPhpKeyWord(Token) then
SetColor(Colors.Reserved)
else
F := False;
hlCSharp:
if IsCSharpKeyWord(Token) then
SetColor(Colors.Reserved)
else
F := False;
else
F := False;
end;
if F then
{Ok}
else
if IsPreproc(Token) then
SetColor(Colors.Preproc)
else
if IsComment(Token) then
SetColor(Colors.Comment)
else
if IsStringConstant(Token) then
SetColor(Colors.Strings)
else
if (Length(Token) = 1) and (Token[1] in Symbols) then
SetColor(Colors.Symbol)
else
if IsIntConstant(Token) or IsRealConstant(Token) then
SetColor(Colors.Number)
else
if (FHighlighter in [hlCBuilder, hlJava, hlJScript, hlPython, hlPhp, hlNQC, hlCSharp]) and
(PrevToken = '0') and ((Token[1] = 'x') or (Token[1] = 'X')) then
SetColor(Colors.Number)
else
if FHighlighter = hlHtml then
SetColor(Colors.PlainText)
else
SetColor(Colors.Identifier);
if FHighlighter = hlHtml then
{ found special chars starting with '&' and ending with ';' }
TestHtmlSpecChars(Token);
PrevToken2 := PrevToken;
PrevToken := Token;
Token := Parser.Token;
end;
if Highlighter = hlCocoR then
HighlightGrammarName(S);
except
end;
end;
procedure TJvHLEditor.CheckInLong;
begin
if not FLongTokens then
begin
FLong := lgNone;
Exit;
end;
if FLineNum < Length(FLongDesc) then
begin
FLong := FLongDesc[FLineNum];
if FLong = lgUndefined then
begin
RescanLong(FLineNum); // scan the line
FLong := FLongDesc[FLineNum];
end;
end
else
RescanLong(-1);
end;
function TJvHLEditor.RescanLong(iLine: Integer): Boolean;
const
MaxScanLinesAtOnce = 5000;
var
P, F: PChar;
MaxLine, MaxScanLine: Integer;
S: string;
I, i1, L1: Integer;
begin
FLong := lgNone;
Result := False; // no Invalidate
if (not FSyntaxHighlighting) or
(not FLongTokens or (FHighlighter in [hlNone, hlIni])) or
(Lines.Count = 0) then
Exit;
if Lines.Count >= Length(FLongDesc) then
SetLength(FLongDesc, (Lines.Count div (64*1024) + 1) * (64*1024));
ProductionsLine := High(Integer);
MaxLine := Lines.Count - 1;
if MaxLine > High(FLongDesc) then
MaxLine := High(FLongDesc);
if iLine > MaxLine then
Exit;
MaxScanLine := MaxLine;
FLong := lgNone;
if iLine < 0 then
begin
FillChar(FLongDesc[0], SizeOf(FLongDesc[0]) * (1 + MaxLine), lgUndefined);
FLongDesc[0] := lgNone;
iLine := 0;
end
else
begin
FLong := FLongDesc[iLine];
if FLong = lgUndefined then
begin
if (iLine > 0) and (FLongDesc[iLine - 1] = lgUndefined) then
begin
iLine := 0; // scan all
FLong := lgNone;
end
else
begin
Dec(iLine);
FLong := FLongDesc[iLine];
MaxScanLine := Min(iLine + MaxScanLinesAtOnce, MaxLine);
end;
end
else
MaxScanLine := Min(iLine + MaxScanLinesAtOnce, MaxLine);
end;
while iLine < MaxScanLine do
begin
if (FHighlighter = hlSyntaxHighlighter) and (FSyntaxHighlighter <> nil) then
FSyntaxHighlighter.ScanLongTokens(Self, Lines, iLine, FLong)
else
begin
S := Lines[iLine];
P := Pointer(S);
F := P;
L1 := Length(S);
if (L1 = 0) then
begin
case Highlighter of
hlPascal:
if FLong in [lgString] then
FLong := lgNone;
hlCBuilder, hlPython, hlPerl, hlNQC:
if FLong in [lgPreproc] then
FLong := lgNone;
else
if FLong in [lgPreproc1, lgPreproc2, lgString] then
FLong := lgNone;
end;
end;
I := 1;
while I <= L1 do
begin
case FHighlighter of
hlPascal:
case FLong of
lgNone: // not in comment
case S[I] of
'/':
begin
if S[I + 1] = '/' then
Break;
end;
'{':
begin
P := StrScan(F + I, Char('}'));
if P = nil then
begin
if S[I + 1] = '$' then
FLong := lgPreproc1
else
FLong := lgComment1;
Break;
end
else
I := P - F + 1;
end;
'(':
if {S[I + 1]} F[I] = '*' then
begin
if {S[I + 2]} F[I + 1] = '$' then
FLong := lgPreproc2
else
FLong := lgComment2;
P := StrScan(F + I + 2, Char(')'));
if P = nil then
Break
else
begin
if P[-1] = '*' then
FLong := lgNone;
I := P - F + 1;
end;
end;
'''':
begin
P := StrScan(F + I + 1, Char(''''));
if P <> nil then
begin
i1 := P - F;
if P[1] <> '''' then
I := i1
else
{ ?? }
end
else
I := L1 + 1;
end;
end;
lgPreproc1, lgComment1:
begin // {
P := StrScan(F + I - 1, Char('}'));
if P <> nil then
begin
FLong := lgNone;
I := P - F + 1;
end
else
I := L1 + 1;
end;
lgPreproc2, lgComment2:
begin // (*
P := StrScan(F + I, Char(')'));
if P = nil then
Break
else
begin
if P[-1] = '*' then
FLong := lgNone;
I := P - F + 1;
end;
end;
end;
hlCBuilder, hlSql, hlJava, hlJScript, hlPhp, hlNQC, hlCSharp:
case FLong of
lgNone: // not in comment
case S[I] of
'/':
if {S[I + 1]} F[I] = '*' then
begin
FLong := lgComment2;
P := StrScan(F + I + 2, Char('/'));
if P = nil then
Break
else
begin
if P[-1] = '*' then
FLong := lgNone;
I := P - F + 1;
end;
end;
'"':
begin
P := StrScan(F + I + 1, Char('"'));
if P <> nil then
begin
i1 := P - F;
if P[1] <> '"' then
I := i1
else
{ ?? }
end
else
if FHighlighter in [hlCBuilder, hlJava, hlJScript, hlNQC] then
begin
if (LastNonSpaceChar(S) = '\') and (HasStringOpenEnd(Lines, iLine)) then
FLong := lgString;
I := L1 + 1;
end
else
I := L1 + 1;
end;
'#':
begin
if (GetTrimChar(S, 1) = '#') and (LastNonSpaceChar(S) = '\') then
begin
FLong := lgPreproc;
Break;
end;
end;
end;
lgComment2:
begin // /*
P := StrScan(F + I, Char('/'));
if P = nil then
Break
else
begin
if P[-1] = '*' then
FLong := lgNone;
I := P - F + 1;
end;
end;
lgString:
begin
P := StrScan(F + I + 1, Char('"'));
if P <> nil then
begin
i1 := P - F;
if P[1] <> '"' then
I := i1
else
{ ?? }
end
else
begin
if FHighlighter in [hlCBuilder, hlJava, hlJScript, hlNQC] then
begin
if (LastNonSpaceChar(S) <> '\') or (not HasStringOpenEnd(Lines, iLine)) then
FLong := lgNone;
end;
I := L1 + 1;
end;
end;
lgPreproc:
begin
if LastNonSpaceChar(S) <> '\' then
FLong := lgNone;
end;
end;
hlPython, hlPerl:
case FLong of
lgNone: // not in comment
case S[I] of
'#':
I := L1;
'"':
begin
P := StrScan(F + I, Char('"'));
if P = nil then
begin
FLong := lgString;
Break;
end
else
I := P - F + 1;
end;
end;
lgString: // python and perl long string
begin
P := StrScan(F + I - 1, Char('"'));
if P <> nil then
begin
FLong := lgNone;
I := P - F + 1;
end
else
I := L1 + 1;
end;
end;
hlHtml:
case FLong of
lgNone: // not in comment
case S[I] of
'<':
begin
P := StrScan(F + I, Char('>'));
if P = nil then
begin
// Multiline comments in HTML
if S[2] = '!' then
FLong := lgComment1
else
FLong := lgTag;
Break;
end
else
I := P - F + 1;
end;
end;
// Multiline comments in HTML
lgComment1:
begin
P := StrScan(F + I - 1, Char('>'));
if P = nil then
Break
else
if (P[-2] = '-') and (P[-1] = '-') then
FLong := lgNone;
I := P - F + 1;
end;
lgTag: // html tag
begin
P := StrScan(F + I - 1, Char('>'));
if P <> nil then
begin
FLong := lgNone;
I := P - F + 1;
end
else
I := L1 + 1;
end;
end;
hlCocoR:
case FLong of
lgNone: // not in comment
case S[I] of
'(':
if {S[I + 1]} F[I] = '*' then
begin
FLong := lgComment2;
P := StrScan(F + I + 2, Char(')'));
if P = nil then
Break
else
begin
if P[-1] = '*' then
FLong := lgNone;
I := P - F + 1;
end;
end;
'"':
begin
P := StrScan(F + I + 1, Char('"'));
if P <> nil then
begin
i1 := P - F;
if P[1] <> '"' then
I := i1
else
{ ?? }
end
else
I := L1 + 1;
end;
'''':
begin
P := StrScan(F + I + 1, Char(''''));
if P <> nil then
begin
i1 := P - F;
if P[1] <> '''' then
I := i1
else
{ ?? }
end
else
I := L1 + 1;
end;
'/':
if {S[I + 1]} F[I] = '*' then
begin
FLong := lgComment2;
P := StrScan(F + I + 2, Char('/'));
if P = nil then
Break
else
begin
if P[-1] = '*' then
FLong := lgNone;
I := P - F + 1;
end;
end;
end;
lgComment2:
begin // (*
P := StrScan(F + I, Char(')'));
if P = nil then
Break
else
begin
if P[-1] = '*' then
FLong := lgNone;
I := P - F + 1;
end;
end;
end;
end;
Inc(I);
end;
if (FHighlighter = hlCocoR) and
(StrLIComp(PChar(S), 'productions', Length('productions')) = 0) then
begin
ProductionsLine := iLine;
end;
end;
Inc(iLine);
if FLongDesc[iLine] <> FLong then
begin
FLongDesc[iLine] := FLong;
Result := True; // Invalidate
end;
end;
// undefine following lines
if MaxScanLine < MaxLine then
FillChar(FLongDesc[MaxScanLine + 1], SizeOf(FLongDesc[0]) * (MaxLine - MaxScanLine), lgUndefined);
end;
function TJvHLEditor.FindLongEnd: Integer;
var
P, F: PChar;
I: Integer;
begin
P := PChar(FLine);
Result := Length(FLine);
case FHighlighter of
hlPascal:
case FLong of
lgPreproc1, lgComment1:
begin
P := StrScan(P, Char('}'));
if P <> nil then
Result := P - PChar(FLine);
end;
lgPreproc2, lgComment2:
begin
F := P;
while True do
begin
F := StrScan(F, Char('*'));
if F = nil then
Exit;
if F[1] = ')' then
Break;
Inc(F);
end;
P := F + 1;
Result := P - PChar(FLine);
end;
end;
hlCBuilder, hlSql, hlJava, hlJScript, hlPhp, hlNQC, hlCSharp:
begin
case FLong of
lgComment2:
begin
F := P;
while True do
begin
F := StrScan(F, Char('*'));
if F = nil then
Exit;
if F[1] = '/' then
Break;
Inc(F);
end;
P := F + 1;
Result := P - PChar(FLine);
end;
lgString:
begin
F := P;
repeat
P := StrScan(P, Char('"'));
if P <> nil then
begin
if (P = F) or (P[-1] <> '\') then
begin
Result := P - F;
Break;
end
else
begin
// count the backslashes
I := 1;
while (P - 1 - I > F) and (P[-1 - I] = '\') do
Inc(I);
if I and $01 = 0 then {faster than: if I mod 2 = 0 then}
begin
Result := P - F;
Break;
end;
end;
Inc(P);
end;
until P = nil;
end;
end;
end;
hlPython, hlPerl:
case FLong of
lgString:
begin
P := StrScan(P, Char('"'));
if P <> nil then
Result := P - PChar(FLine);
end;
end;
hlHtml:
case FLong of
// HTML multiline comments
lgComment1:
begin
P := StrScan(P, Char('>'));
if P <> nil then
// check if the previous characters are
// --
if (P[-1] = '-') and (P[-2] = '-') then
Result := P - PChar(FLine);
end;
lgTag:
begin
P := StrScan(P, Char('>'));
if P <> nil then
Result := P - PChar(FLine);
end;
end;
end;
end;
procedure TJvHLEditor.TextModified(ACaretX, ACaretY: Integer; Action: TModifiedAction;
const Text: string);
var
S: string;
L: Integer;
{ LP, I: Integer;
P: PChar;
OldProductionsLine: Integer; }
begin
if not FLongTokens then
Exit;
case FHighlighter of
hlPascal:
S := #13'{}*()/ ';
hlCBuilder, hlJava, hlJScript, hlSql, hlPhp, hlNQC, hlCSharp:
S := #13'*/\ ';
hlVB:
S := #13'''';
hlPython, hlPerl:
S := #13'#"';
hlHtml:
S := #13'<>';
hlCocoR:
S := #13'*()/ ';
hlSyntaxHighlighter:
if FSyntaxHighlighter <> nil then
begin
if FSyntaxHighlighter.GetRescanLongKeys(Self, Action, ACaretX, ACaretY, Text) then
begin
if RescanLong(ACaretY) then
Invalidate;
end;
Exit;
end
else
S := #13;
else
S := #13; { unknown Highlighter ? }
end;
if Action = maAll then
ACaretY := -1; // rescan all lines
if (Action in [maAll, maReplace]) or HasAnyChar(S, Text) then
begin
if RescanLong(ACaretY) then
Invalidate;
end
else
begin
if (Highlighter = hlPascal) and (Cardinal(ACaretY) < Cardinal(Length(FLongDesc))) then
begin
// comment <-> preproc
S := Lines[ACaretY];
L := Length(S);
// [Backspace, "insert"]
if ((ACaretX > 1) and (ACaretX <= L + 1) and (S[ACaretX - 1] = '{')) or
((ACaretX > 2) and (ACaretX <= L + 2) and (S[ACaretX - 2] = '(') and (S[ACaretX - 1] = '*')) or
// [Delete]
((ACaretX > 0) and (ACaretX <= L) and (S[ACaretX] = '{')) or
((ACaretX > 1) and (ACaretX <= L + 1) and (S[ACaretX - 1] = '(') and (S[ACaretX] = '*')) then
begin
if RescanLong(ACaretY) then
Invalidate;
end;
end;
end;
{
if (FHighlighter = hlCocoR) and (HasAnyChar('productions'#13, Text)) then
begin
LP := Length('productions');
OldProductionsLine := ProductionsLine;
ProductionsLine := High(Integer);
for I := 0 to Lines.Count - 1 do
begin
P := PChar(Lines[I]);
if (StrLIComp(P, 'productions', LP) = 0) and
((Length(P) = LP) or (P[LP] = ' ')) then
begin
ProductionsLine := I;
Break;
end;
end;
if ProductionsLine <> OldProductionsLine then
Invalidate;
end; }
end;
function TJvHLEditor.GetReservedWord(const Token: string;
var Reserved: Boolean): Boolean;
begin
Result := Assigned(FOnReservedWord);
if Result then
begin
Reserved := False;
FOnReservedWord(Self, Token, Reserved);
end
end;
function TJvHLEditor.UserReservedWords: Boolean;
begin
Result := Assigned(FOnReservedWord);
end;
procedure TJvHLEditor.Assign(Source: TPersistent);
begin
inherited Assign(Source);
if Source is TJvHLEditor then
begin
FHighlighter := TJvHLEditor(Source).Highlighter;
Colors.Assign(TJvHLEditor(Source).Colors);
SelForeColor := TJvHLEditor(Source).SelForeColor;
SelBackColor := TJvHLEditor(Source).SelBackColor;
Color := TJvHLEditor(Source).Color;
FSyntaxHighlighting := TJvHLEditor(Source).SyntaxHighlighting;
RightMarginColor := TJvHLEditor(Source).RightMarginColor;
Invalidate;
end;
end;
function TJvHLEditor.GetDelphiColors: Boolean;
function CompareColor(Symbol: TJvSymbolColor; const DelphiColor: TDelphiColor): Boolean;
begin
Result := (Symbol.ForeColor = DelphiColor.ForeColor) and
(Symbol.BackColor = DelphiColor.BackColor) and
(Symbol.Style = DelphiColor.Style);
end;
begin
Result := False;
if not CompareColor(Colors.Comment, DelphiColor_Comment) then
Exit;
if not CompareColor(Colors.Preproc, DelphiColor_Preproc) then
Exit;
if not CompareColor(Colors.Number, DelphiColor_Number) then
Exit;
if not CompareColor(Colors.Strings, DelphiColor_Strings) then
Exit;
if not CompareColor(Colors.Symbol, DelphiColor_Symbol) then
Exit;
if not CompareColor(Colors.Reserved, DelphiColor_Reserved) then
Exit;
if not CompareColor(Colors.Identifier, DelphiColor_Identifier) then
Exit;
if not CompareColor(Colors.PlainText, DelphiColor_PlainText) then
Exit;
Result := True;
end;
procedure TJvHLEditor.SetDelphiColors(Value: Boolean);
procedure SetColor(Symbol: TJvSymbolColor; const DelphiColor: TDelphiColor);
begin
with DelphiColor do
Symbol.SetColor(ForeColor, BackColor, Style);
end;
begin
if Value then
begin
SetColor(Colors.Comment, DelphiColor_Comment);
SetColor(Colors.Preproc, DelphiColor_Preproc);
SetColor(Colors.Number, DelphiColor_Number);
SetColor(Colors.Strings, DelphiColor_Strings);
SetColor(Colors.Symbol, DelphiColor_Symbol);
SetColor(Colors.Reserved, DelphiColor_Reserved);
SetColor(Colors.Identifier, DelphiColor_Identifier);
SetColor(Colors.PlainText, DelphiColor_PlainText);
end;
end;
procedure TJvHLEditor.SetSyntaxHighlighter(const Value: TJvEditorHighlighter);
begin
if Value <> FSyntaxHighlighter then
begin
if Value <> nil then
FHighlighter := hlSyntaxHighlighter
else
if FHighlighter = hlSyntaxHighlighter then
FHighlighter := hlNone;
FSyntaxHighlighter := Value;
RescanLong(0);
Invalidate;
end;
end;
function TJvHLEditor.GetColors: TJvColors;
begin
Result := FColors;
end;
procedure TJvHLEditor.SetColors(const Value: TJvColors);
begin
FColors.Assign(Value);
end;
function TJvHLEditor.GetSyntaxHighlighting: Boolean;
begin
Result := FSyntaxHighlighting;
end;
procedure TJvHLEditor.SetSyntaxHighlighting(Value: Boolean);
begin
FSyntaxHighlighting := Value;
Invalidate;
end;
function TJvHLEditor.GetHighlighter: TJvHighlighter;
begin
Result := FHighlighter;
end;
{$IFDEF UNITVERSIONING}
initialization
RegisterUnitVersion(HInstance, UnitVersioning);
finalization
UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
end.
Reference in New Issue View Git Blame Copy Permalink