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.
tdevelop/languages/perl/perlsupportpart.cpp

331 lines
10 KiB

/***************************************************************************
* Copyright (C) 2001-2002 by Bernd Gehrmann *
* bernd@kdevelop.org *
* *
* This program 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 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
#include "perlsupportpart.h"
#include <tqfileinfo.h>
#include <tqpopupmenu.h>
#include <tqstringlist.h>
#include <tqtextstream.h>
#include <tqtimer.h>
#include <tdeaction.h>
#include <tdeapplication.h>
#include <kdebug.h>
#include <kdevgenericfactory.h>
#include <kinputdialog.h>
#include <tdelocale.h>
#include <tqregexp.h>
#include <codemodel.h>
#include <tqprogressbar.h>
#include <kstatusbar.h>
#include "kdevmainwindow.h"
#include <kprocess.h>
#include <stdlib.h>
#include <unistd.h>
#include "kdevcore.h"
#include "kdevproject.h"
#include "kdevpartcontroller.h"
#include "kdevplugininfo.h"
#include "kdevappfrontend.h"
//#include "classstore.h"
//#include "parsedclass.h"
//#include "parsedmethod.h"
//#include "parsedscript.h"
#include "domutil.h"
//#include "programmingbycontract.h"
typedef KDevGenericFactory<PerlSupportPart> PerlSupportFactory;
static const KDevPluginInfo data("kdevperlsupport");
K_EXPORT_COMPONENT_FACTORY( libkdevperlsupport, PerlSupportFactory( data ) )
PerlSupportPart::PerlSupportPart(TQObject *parent, const char *name, const TQStringList &)
: KDevLanguageSupport(&data, parent, name ? name : "PerlSupportPart")
{
setInstance(PerlSupportFactory::instance());
setXMLFile("kdevperlsupport.rc");
connect( core(), TQT_SIGNAL(projectOpened()), this, TQT_SLOT(projectOpened()) );
connect( core(), TQT_SIGNAL(projectClosed()), this, TQT_SLOT(projectClosed()) );
connect( partController(), TQT_SIGNAL(savedFile(const KURL&)),
this, TQT_SLOT(savedFile(const KURL&)) );
TDEAction *action;
action = new TDEAction( i18n("Execute Main Program"), "application-x-executable", 0,
this, TQT_SLOT(slotExecute()),
actionCollection(), "build_exec" );
action->setToolTip( i18n("Runs the Perl program") );
action = new TDEAction( i18n("Execute String..."), "application-x-executable", 0,
this, TQT_SLOT(slotExecuteString()),
actionCollection(), "build_execstring" );
action->setToolTip( i18n("Executes a string as Perl code") );
action = new TDEAction( i18n("Start Perl Interpreter"), "application-x-executable", 0,
this, TQT_SLOT(slotStartInterpreter()),
actionCollection(), "build_runinterpreter" );
action->setToolTip( i18n("Starts the Perl interpreter without a program") );
action = new TDEAction( i18n("Find Perl Function Documentation..."), 0,
this, TQT_SLOT(slotPerldocFunction()),
actionCollection(), "help_perldocfunction" );
action->setToolTip( i18n("Show the documentation page of a Perl function") );
action = new TDEAction( i18n("Find Perl FAQ Entry..."), 0,
this, TQT_SLOT(slotPerldocFAQ()),
actionCollection(), "help_perldocfaq" );
action->setToolTip( i18n("Show the FAQ entry for a keyword") );
//perl parser for codemodel
m_parser = new perlparser(core(),codeModel(),interpreter());
}
PerlSupportPart::~PerlSupportPart()
{
if (project())
projectClosed();
delete m_parser;
m_parser=0;
}
void PerlSupportPart::projectOpened()
{
kdDebug(9007) << "projectOpened()" << endl;
connect( project(), TQT_SIGNAL(addedFilesToProject(const TQStringList &)),
this, TQT_SLOT(addedFilesToProject(const TQStringList &)) );
connect( project(), TQT_SIGNAL(removedFilesFromProject(const TQStringList &)),
this, TQT_SLOT(removedFilesFromProject(const TQStringList &)) );
// We want to parse only after all components have been
// properly initialized
TQTimer::singleShot(0, this, TQT_SLOT(initialParse()));
}
void PerlSupportPart::projectClosed()
{
}
void PerlSupportPart::maybeParse(const TQString fileName)
{
TQFileInfo fi(fileName);
TQString path = fi.filePath();
TQString extension = fi.extension();
if (extension == "pl" || extension == "pm") {
kdDebug(9016) << "maybe " << fileName << endl;
removeWithReference(fileName);
m_parser->parse(fileName);
emit addedSourceInfo( fileName);
}
}
void PerlSupportPart::addedFilesToProject(const TQStringList &fileList)
{
kdDebug(9016) << "addedFilesToProject()" << endl;
TQStringList::ConstIterator it;
for ( it = fileList.begin(); it != fileList.end(); ++it )
{
maybeParse(project()->projectDirectory() + "/" + ( *it ));
}
}
void PerlSupportPart::removedFilesFromProject(const TQStringList &fileList)
{
kdDebug(9016) << "removedFilesFromProject()" << endl;
TQStringList::ConstIterator it;
for ( it = fileList.begin(); it != fileList.end(); ++it )
{
TQString fileName = project()->projectDirectory() + "/" + ( *it );
removeWithReference(fileName);
}
emit updatedSourceInfo();
}
void PerlSupportPart::savedFile(const KURL &fileName)
{
Q_UNUSED( fileName.path() );
#if 0 // not needed anymore
kdDebug(9016) << "savedFile()" << endl;
if (project()->allFiles().contains(fileName.mid ( project()->projectDirectory().length() + 1 ))) {
maybeParse(fileName);
emit updatedSourceInfo();
}
#endif
}
KDevLanguageSupport::Features PerlSupportPart::features()
{
return KDevLanguageSupport::Features(Classes | Functions | Variables | Namespaces | /*Scripts | */NewClass | AddMethod | AddAttribute /*| NewScript*/);
// return Functions;
}
TQString PerlSupportPart::interpreter()
{
TQString prog = DomUtil::readEntry(*projectDom(), "/kdevperlsupport/run/interpreter");
if (prog.isEmpty())
prog = "perl";
return prog;
}
void PerlSupportPart::startApplication(const TQString &program)
{
bool inTerminal = DomUtil::readBoolEntry(*projectDom(), "/kdevperlsupport/run/terminal");
if (KDevAppFrontend *appFrontend = extension<KDevAppFrontend>("TDevelop/AppFrontend"))
appFrontend->startAppCommand(TQString(), program, inTerminal);
}
void PerlSupportPart::slotExecute()
{
TQString program = project()->mainProgram();
TQString cmd = interpreter() + " " + program;
startApplication(cmd);
}
void PerlSupportPart::slotStartInterpreter()
{
startApplication(interpreter());
}
void PerlSupportPart::slotExecuteString()
{
bool ok;
TQString cmd = KInputDialog::getText(i18n("String to Execute"), i18n("String to execute:"), TQString(), &ok, 0);
if (ok) {
cmd.prepend("'");
cmd.append("'");
startApplication(cmd);
}
}
void PerlSupportPart::slotPerldocFunction()
{
bool ok;
TQString key = KInputDialog::getText(i18n("Show Perl Documentation"), i18n("Show Perl documentation for function:"), "", &ok, 0);
if (ok && !key.isEmpty()) {
TQString url = "perldoc:functions/";
url += key;
partController()->showDocument(KURL(url));
}
}
void PerlSupportPart::slotPerldocFAQ()
{
bool ok;
TQString key = KInputDialog::getText(i18n("Show FAQ Entry"), i18n("Show FAQ entry for keyword:"), "", &ok, 0);
if (ok && !key.isEmpty()) {
TQString url = "perldoc:faq/";
url += key;
partController()->showDocument(KURL(url));
}
}
KMimeType::List PerlSupportPart::mimeTypes( )
{
KMimeType::List list;
KMimeType::Ptr mime = KMimeType::mimeType( "application/x-perl" );
if( mime )
list << mime;
return list;
}
void PerlSupportPart::initialParse()
{
kdDebug(9016) << "initialParse()" << endl;
if (project()) {
//copy from cpp support : give user some feedback
mainWindow()->statusBar()->message( i18n("Updating...") );
kapp->processEvents( );
kapp->setOverrideCursor(waitCursor);
TQStringList files = project()->allFiles();
m_parser->initialParse();
//progress bar
TQProgressBar* bar = new TQProgressBar( files.count( ), mainWindow( )->statusBar( ) );
bar->setMinimumWidth( 120 );
bar->setCenterIndicator( true );
mainWindow( )->statusBar( )->addWidget( bar );
bar->show( );
int n = 0;
for (TQStringList::Iterator it = files.begin(); it != files.end() ;++it) {
// kdDebug(9016) << "maybe parse " << project()->projectDirectory() + "/" + (*it) << endl;
maybeParse(project()->projectDirectory() + "/" + *it);
//update progress bar
bar->setProgress( n++ );
if( (n%5) == 0 )
kapp->processEvents();
}
parseUseFiles();
emit updatedSourceInfo();
//remove progressbar
mainWindow( )->statusBar( )->removeWidget( bar );
delete bar;
kapp->restoreOverrideCursor();
mainWindow()->statusBar()->message( i18n("Done") );
} else {
kdDebug(9016) << "No project" << endl;
}
}
void PerlSupportPart::removeWithReference( const TQString & fileName )
{
kdDebug(9016) << "remove with references: " << fileName << endl;
//m_timestamp.remove( fileName );
if( !codeModel()->hasFile(fileName) )
return;
emit aboutToRemoveSourceInfo( fileName );
codeModel()->removeFile( codeModel()->fileByName(fileName) );
}
void PerlSupportPart::parseUseFiles()
{
kdDebug(9016) << "parse addional libs" << endl;
return;
TQString filename;
TQStringList m_usefiles = m_parser->UseFiles();
//parse addional use files
for (TQStringList::Iterator it = m_usefiles.begin(); it != m_usefiles.end() ;++it)
{
filename = m_parser->findLib(*it);
//if something found , parse it
if (!filename.isEmpty()) {
//kdDebug(9016) << "found " << filename << endl;
maybeParse(filename);
}
}
}
#include "perlsupportpart.moc"