path: root/tqt/tqextscintillalexerperl.cpp

// This module implements the TQextScintillaLexerPerl 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.

#ifdef HAVE_CONFIG_H
#  include "config.h"
#endif

#include <tqcolor.h>
#include <tqfont.h>
#include <tqsettings.h>

#include "tqextscintillalexerperl.h"


// The ctor.
TQextScintillaLexerPerl::TQextScintillaLexerPerl(TQObject *parent,
					       const char *name)
	: TQextScintillaLexer(parent,name), fold_comments(FALSE),
	  fold_compact(TRUE)
{
}


// The dtor.
TQextScintillaLexerPerl::~TQextScintillaLexerPerl()
{
}


// Returns the language name.
const char *TQextScintillaLexerPerl::language() const
{
	return "Perl";
}


// Returns the lexer name.
const char *TQextScintillaLexerPerl::lexer() const
{
	return "perl";
}


// Return the style used for braces.
int TQextScintillaLexerPerl::braceStyle() const
{
	return Operator;
}


// Return the string of characters that comprise a word.
const char *TQextScintillaLexerPerl::wordCharacters() const
{
	return "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$@%&";
}


// Returns the foreground colour of the text for a style.
TQColor TQextScintillaLexerPerl::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 TQextScintillaLexer::color(style);
}


// Returns the end-of-line fill for a style.
bool TQextScintillaLexerPerl::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 TQextScintillaLexerPerl::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 = TQextScintillaLexer::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 = TQextScintillaLexer::font(style);
		f.setItalic(TRUE);
		break;

	default:
		f = TQextScintillaLexer::font(style);
	}

	return f;
}


// Returns the set of keywords.
const char *TQextScintillaLexerPerl::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 TQextScintillaLexerPerl::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 TQextScintillaLexerPerl::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 TQextScintillaLexer::paper(style);
}


// Refresh all properties.
void TQextScintillaLexerPerl::refreshProperties()
{
	setCommentProp();
	setCompactProp();
}


// Read properties from the settings.
bool TQextScintillaLexerPerl::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 TQextScintillaLexerPerl::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 TQextScintillaLexerPerl::foldComments() const
{
	return fold_comments;
}


// Set if comments can be folded.
void TQextScintillaLexerPerl::setFoldComments(bool fold)
{
	fold_comments = fold;

	setCommentProp();
}


// Set the "fold.comment" property.
void TQextScintillaLexerPerl::setCommentProp()
{
	emit propertyChanged("fold.comment",(fold_comments ? "1" : "0"));
}


// Return TRUE if folds are compact.
bool TQextScintillaLexerPerl::foldCompact() const
{
	return fold_compact;
}


// Set if folds are compact
void TQextScintillaLexerPerl::setFoldCompact(bool fold)
{
	fold_compact = fold;

	setCompactProp();
}


// Set the "fold.compact" property.
void TQextScintillaLexerPerl::setCompactProp()
{
	emit propertyChanged("fold.compact",(fold_compact ? "1" : "0"));
}

#include "tqextscintillalexerperl.moc"