path: root/languages/perl/perlsupportpart.cpp

/***************************************************************************
 *   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 <tdeprocess.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 pluginData("kdevperlsupport");
K_EXPORT_COMPONENT_FACTORY( libkdevperlsupport, PerlSupportFactory( pluginData ) )

PerlSupportPart::PerlSupportPart(TQObject *parent, const char *name, const TQStringList &)
    : KDevLanguageSupport(&pluginData, parent, name ? name : "PerlSupportPart")
{
    setInstance(PerlSupportFactory::instance());

    setXMLFile("kdevperlsupport.rc");

    connect( core(), TQ_SIGNAL(projectOpened()), this, TQ_SLOT(projectOpened()) );
    connect( core(), TQ_SIGNAL(projectClosed()), this, TQ_SLOT(projectClosed()) );
    connect( partController(), TQ_SIGNAL(savedFile(const KURL&)),
             this, TQ_SLOT(savedFile(const KURL&)) );

    TDEAction *action;

    action = new TDEAction( i18n("Execute Main Program"), "application-x-executable", 0,
                          this, TQ_SLOT(slotExecute()),
                          actionCollection(), "build_exec" );
    action->setToolTip( i18n("Runs the Perl program") );

    action = new TDEAction( i18n("Execute String..."), "application-x-executable", 0,
                          this, TQ_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, TQ_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, TQ_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, TQ_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(), TQ_SIGNAL(addedFilesToProject(const TQStringList &)),
             this, TQ_SLOT(addedFilesToProject(const TQStringList &)) );
    connect( project(), TQ_SIGNAL(removedFilesFromProject(const TQStringList &)),
             this, TQ_SLOT(removedFilesFromProject(const TQStringList &)) );

    // We want to parse only after all components have been
    // properly initialized
    TQTimer::singleShot(0, this, TQ_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"