// This module implements the QextScintillaLexerPerl class. // // Copyright (c) 2006 // Riverbank Computing Limited // // 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 #include #include #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")); }