/* Bluefish HTML Editor
 * perl.c - Embedding perl functions in bluefish
 *
 * Copyright (C) 2001 Olivier Sessink and Roland Steinbach
 *
 * 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.
 *
 * This program is distributed 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 this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

#include "config.h"

#ifdef PERL

/* #define DEBUG */

#include "default_include.h"
#include "gtk_easy.h"
#include "bluefish.h"
#include <glib.h>
#include "bf_perl.h"
#include "html_diag.h"
#include "perl_ezembed.h"

#include "perl_local.h"

static PerlInterpreter *myperl;

/*****************************************************************************
                   Local Callbacks
*****************************************************************************/

static void perl_callscriptok_lcb(GtkWidget * widget, Thtml_diag *dg) {
        gchar *thestring, *finalstring;
 
        thestring = g_strdup(PKGDATADIR);
        thestring = g_strconcat(thestring,"/",thestring,dg->entry[0]);
        finalstring = g_strconcat(thestring, NULL);
        g_free(thestring);
 



        g_free(finalstring);
        html_diag_destroy_cb(NULL, NULL, dg);
}
/*****************************************************************************
                   Local Callbacks end
*****************************************************************************/


void perl_status_cb(GtkWidget * w, gpointer data)
{
  STRLEN n_a;
  char *embedding[] = { "", "-e", "0" };
  myperl = perl_alloc();
  perl_construct(myperl);
  perl_parse(myperl,NULL,3,embedding,NULL);
  perl_run (myperl);
  eval_pv("$]",TRUE);
	error_dialog(_("Perl Version"),SvPV(get_sv("]",FALSE), n_a)); 
  perl_destruct(myperl);
  perl_free(myperl);
}

void perl_strip_cr_cb(GtkWidget * w, gpointer data)
{
  gchar *old_text;
  gchar *embedding[] = { "", "-e", "0" };
  DEBUG_MSG("Getting Text\n");
  old_text = gtk_editable_get_chars(GTK_EDITABLE(main_v->current_document->textbox),0,-1);
  DEBUG_MSG("Deleting Text\n");
  gtk_editable_delete_text(GTK_EDITABLE(main_v->current_document->textbox),0,-1);
	gtk_text_freeze(GTK_TEXT(main_v->current_document->textbox));
  myperl = perl_alloc();
  perl_construct(myperl);
  perl_parse(myperl,NULL,3,embedding,NULL);
  DEBUG_MSG("Running perl\n");
  if (perl_eval_va("sub main::strip_cr {"
  						 "my ($txt) = shift;"
               "$txt =~ s/\r//gi;"
               "$txt;"
               "}",NULL) == -1) {
  	error_dialog(_("Error!"),_("Could not eval() strip_cr."));
  	gtk_text_insert(GTK_TEXT(main_v->current_document->textbox), NULL, &main_v->current_document->textbox->style->black, NULL,  old_text, strlen(old_text));
  } else {
    perl_call_va("strip_cr","s",old_text,"OUT","s",old_text,NULL);
	  DEBUG_MSG("Inserting Text %d\n",strlen(old_text));
		gtk_text_insert(GTK_TEXT(main_v->current_document->textbox), NULL, &main_v->current_document->textbox->style->black, NULL,  old_text, strlen(old_text));
  }
  DEBUG_MSG("Inserting Text %d\n",strlen(SvPV(text, n_a)));
	gtk_text_thaw(GTK_TEXT(main_v->current_document->textbox));
  perl_destruct(myperl);
  perl_free(myperl);
}

void perl_callscript_cb(GtkWidget * widget, gpointer data)
{ 
        static gchar *tagitems[] = { "Scriptname", NULL };
        gchar *tagvalues[1];
        gchar *custom = NULL;
        GtkWidget *dgtable;
        Thtml_diag *dg;
 
        dg = html_diag_new(_("Call Perlscript"));
        fill_dialogvalues(tagitems, tagvalues, &custom, (Ttagpopup *) data, widget, dg);
 
        dgtable = gtk_table_new(3, 5, 0);
        gtk_box_pack_start(GTK_BOX(dg->vbox), dgtable, FALSE, FALSE, 0);
 
        dg->entry[0] = entry_with_text(tagvalues[0], 256);
        gtk_table_attach_defaults(GTK_TABLE(dgtable), gtk_label_new(_("Scriptname")), 0, 1, 0, 1);
        gtk_table_attach_defaults(GTK_TABLE(dgtable), dg->entry[0], 1, 2, 0, 1);
 
        html_diag_finish(dg, perl_callscriptok_lcb);
 
        if (custom)     g_free(custom);
}


#endif /* PERL */
