You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
tqscintilla/qt/qextscintillalexerperl.cpp

483 lines
10 KiB

// This module implements the QextScintillaLexerPerl class.
//
// Copyright (c) 2006
// Riverbank Computing Limited <info@riverbankcomputing.co.uk>
//
// This file is part of TQScintilla.
//
// This copy of TQScintilla is free software; you can redistribute it and/or
// modify it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2, or (at your option) any
// later version.
//
// TQScintilla is supplied in the hope that it will be useful, but WITHOUT ANY
// WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
// FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
// details.
//
// You should have received a copy of the GNU General Public License along with
// TQScintilla; see the file LICENSE. If not, write to the Free Software
// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#include <tqcolor.h>
#include <tqfont.h>
#include <tqsettings.h>
#include "qextscintillalexerperl.h"
// The ctor.
QextScintillaLexerPerl::QextScintillaLexerPerl(TQObject *parent,
const char *name)
: QextScintillaLexer(parent,name), fold_comments(FALSE),
fold_compact(TRUE)
{
}
// The dtor.
QextScintillaLexerPerl::~QextScintillaLexerPerl()
{
}
// Returns the language name.
const char *QextScintillaLexerPerl::language() const
{
return "Perl";
}
// Returns the lexer name.
const char *QextScintillaLexerPerl::lexer() const
{
return "perl";
}
// Return the style used for braces.
int QextScintillaLexerPerl::braceStyle() const
{
return Operator;
}
// Return the string of characters that comprise a word.
const char *QextScintillaLexerPerl::wordCharacters() const
{
return "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$@%&";
}
// Returns the foreground colour of the text for a style.
TQColor QextScintillaLexerPerl::color(int style) const
{
switch (style)
{
case Default:
return TQColor(0x80,0x80,0x80);
case Error:
case Backticks:
case QuotedStringQX:
return TQColor(0xff,0xff,0x00);
case Comment:
return TQColor(0x00,0x7f,0x00);
case POD:
case PODVerbatim:
return TQColor(0x00,0x40,0x00);
case Number:
return TQColor(0x00,0x7f,0x7f);
case Keyword:
return TQColor(0x00,0x00,0x7f);
case DoubleQuotedString:
case SingleQuotedString:
case SingleQuotedHereDocument:
case DoubleQuotedHereDocument:
case BacktickHereDocument:
case QuotedStringQ:
case QuotedStringQQ:
return TQColor(0x7f,0x00,0x7f);
case Operator:
case Identifier:
case Scalar:
case Array:
case Hash:
case SymbolTable:
case Regex:
case Substitution:
case HereDocumentDelimiter:
case QuotedStringQR:
case QuotedStringQW:
return TQColor(0x00,0x00,0x00);
case DataSection:
return TQColor(0x60,0x00,0x00);
}
return QextScintillaLexer::color(style);
}
// Returns the end-of-line fill for a style.
bool QextScintillaLexerPerl::eolFill(int style) const
{
switch (style)
{
case POD:
case DataSection:
case SingleQuotedHereDocument:
case DoubleQuotedHereDocument:
case BacktickHereDocument:
case PODVerbatim:
return TRUE;
}
return FALSE;
}
// Returns the font of the text for a style.
TQFont QextScintillaLexerPerl::font(int style) const
{
TQFont f;
switch (style)
{
case Comment:
#if defined(Q_OS_WIN)
f = TQFont("Comic Sans MS",9);
#else
f = TQFont("Bitstream Vera Serif",9);
#endif
break;
case POD:
#if defined(Q_OS_WIN)
f = TQFont("Times New Roman",11);
#else
f = TQFont("Bitstream Charter",10);
#endif
break;
case Keyword:
case Operator:
case DoubleQuotedHereDocument:
f = QextScintillaLexer::font(style);
f.setBold(TRUE);
break;
case DoubleQuotedString:
case SingleQuotedString:
case QuotedStringQQ:
case PODVerbatim:
#if defined(Q_OS_WIN)
f = TQFont("Courier New",10);
#else
f = TQFont("Bitstream Vera Sans Mono",9);
#endif
break;
case BacktickHereDocument:
f = QextScintillaLexer::font(style);
f.setItalic(TRUE);
break;
default:
f = QextScintillaLexer::font(style);
}
return f;
}
// Returns the set of keywords.
const char *QextScintillaLexerPerl::keywords(int set) const
{
if (set == 1)
return
"NULL __FILE__ __LINE__ __PACKAGE__ __DATA__ __END__ "
"AUTOLOAD BEGIN CORE DESTROY END EQ GE GT INIT LE LT "
"NE CHECK abs accept alarm and atan2 bind binmode "
"bless caller chdir chmod chomp chop chown chr chroot "
"close closedir cmp connect continue cos crypt "
"dbmclose dbmopen defined delete die do dump each "
"else elsif endgrent endhostent endnetent endprotoent "
"endpwent endservent eof eq eval exec exists exit exp "
"fcntl fileno flock for foreach fork format formline "
"ge getc getgrent getgrgid getgrnam gethostbyaddr "
"gethostbyname gethostent getlogin getnetbyaddr "
"getnetbyname getnetent getpeername getpgrp getppid "
"getpriority getprotobyname getprotobynumber "
"getprotoent getpwent getpwnam getpwuid getservbyname "
"getservbyport getservent getsockname getsockopt glob "
"gmtime goto grep gt hex if index int ioctl join keys "
"kill last lc lcfirst le length link listen local "
"localtime lock log lstat lt m map mkdir msgctl "
"msgget msgrcv msgsnd my ne next no not oct open "
"opendir or ord our pack package pipe pop pos print "
"printf prototype push q qq qr quotemeta qu qw qx "
"rand read readdir readline readlink readpipe recv "
"redo ref rename require reset return reverse "
"rewinddir rindex rmdir s scalar seek seekdir select "
"semctl semget semop send setgrent sethostent "
"setnetent setpgrp setpriority setprotoent setpwent "
"setservent setsockopt shift shmctl shmget shmread "
"shmwrite shutdown sin sleep socket socketpair sort "
"splice split sprintf sqrt srand stat study sub "
"substr symlink syscall sysopen sysread sysseek "
"system syswrite tell telldir tie tied time times tr "
"truncate uc ucfirst umask undef unless unlink unpack "
"unshift untie until use utime values vec wait "
"waitpid wantarray warn while write x xor y";
return 0;
}
// Returns the user name of a style.
TQString QextScintillaLexerPerl::description(int style) const
{
switch (style)
{
case Default:
return tr("Default");
case Error:
return tr("Error");
case Comment:
return tr("Comment");
case POD:
return tr("POD");
case Number:
return tr("Number");
case Keyword:
return tr("Keyword");
case DoubleQuotedString:
return tr("Double-quoted string");
case SingleQuotedString:
return tr("Single-quoted string");
case Operator:
return tr("Operator");
case Identifier:
return tr("Identifier");
case Scalar:
return tr("Scalar");
case Array:
return tr("Array");
case Hash:
return tr("Hash");
case SymbolTable:
return tr("Symbol table");
case Regex:
return tr("Regular expression");
case Substitution:
return tr("Substitution");
case Backticks:
return tr("Backticks");
case DataSection:
return tr("Data section");
case HereDocumentDelimiter:
return tr("Here document delimiter");
case SingleQuotedHereDocument:
return tr("Single-quoted here document");
case DoubleQuotedHereDocument:
return tr("Double-quoted here document");
case BacktickHereDocument:
return tr("Backtick here document");
case QuotedStringQ:
return tr("Quoted string (q)");
case QuotedStringQQ:
return tr("Quoted string (qq)");
case QuotedStringQX:
return tr("Quoted string (qx)");
case QuotedStringQR:
return tr("Quoted string (qr)");
case QuotedStringQW:
return tr("Quoted string (qw)");
case PODVerbatim:
return tr("POD verbatim");
}
return TQString();
}
// Returns the background colour of the text for a style.
TQColor QextScintillaLexerPerl::paper(int style) const
{
switch (style)
{
case Error:
return TQColor(0xff,0x00,0x00);
case POD:
return TQColor(0xe0,0xff,0xe0);
case Scalar:
return TQColor(0xff,0xe0,0xe0);
case Array:
return TQColor(0xff,0xff,0xe0);
case Hash:
return TQColor(0xff,0xe0,0xff);
case SymbolTable:
return TQColor(0xe0,0xe0,0xe0);
case Regex:
return TQColor(0xa0,0xff,0xa0);
case Substitution:
return TQColor(0xf0,0xe0,0x80);
case Backticks:
return TQColor(0xa0,0x80,0x80);
case DataSection:
return TQColor(0xff,0xf0,0xd8);
case HereDocumentDelimiter:
case SingleQuotedHereDocument:
case DoubleQuotedHereDocument:
case BacktickHereDocument:
return TQColor(0xdd,0xd0,0xdd);
case PODVerbatim:
return TQColor(0xc0,0xff,0xc0);
}
return QextScintillaLexer::paper(style);
}
// Refresh all properties.
void QextScintillaLexerPerl::refreshProperties()
{
setCommentProp();
setCompactProp();
}
// Read properties from the settings.
bool QextScintillaLexerPerl::readProperties(TQSettings &qs,const TQString &prefix)
{
int rc = TRUE;
bool ok, flag;
// Read the fold comments flag.
flag = qs.readBoolEntry(prefix + "foldcomments",FALSE,&ok);
if (ok)
fold_comments = flag;
else
rc = FALSE;
// Read the fold compact flag.
flag = qs.readBoolEntry(prefix + "foldcompact",TRUE,&ok);
if (ok)
fold_compact = flag;
else
rc = FALSE;
return rc;
}
// Write properties to the settings.
bool QextScintillaLexerPerl::writeProperties(TQSettings &qs,const TQString &prefix) const
{
int rc = TRUE;
// Write the fold comments flag.
if (!qs.writeEntry(prefix + "foldcomments",fold_comments))
rc = FALSE;
// Write the fold compact flag.
if (!qs.writeEntry(prefix + "foldcompact",fold_compact))
rc = FALSE;
return rc;
}
// Return TRUE if comments can be folded.
bool QextScintillaLexerPerl::foldComments() const
{
return fold_comments;
}
// Set if comments can be folded.
void QextScintillaLexerPerl::setFoldComments(bool fold)
{
fold_comments = fold;
setCommentProp();
}
// Set the "fold.comment" property.
void QextScintillaLexerPerl::setCommentProp()
{
emit propertyChanged("fold.comment",(fold_comments ? "1" : "0"));
}
// Return TRUE if folds are compact.
bool QextScintillaLexerPerl::foldCompact() const
{
return fold_compact;
}
// Set if folds are compact
void QextScintillaLexerPerl::setFoldCompact(bool fold)
{
fold_compact = fold;
setCompactProp();
}
// Set the "fold.compact" property.
void QextScintillaLexerPerl::setCompactProp()
{
emit propertyChanged("fold.compact",(fold_compact ? "1" : "0"));
}