Various improvements to autoperl

Originally committed to SVN as r1858.

aegisub/auto4_perl.cpp

@@ -100,7 +100,7 @@ namespace Automation4 {
 	  text = wxString(SvPV_nolen(ST(1)), pl2wx);
 	}
 	else {
-	  /* TODO maybe: emit warning */
+	  PerlLogWarning(_("Not enough parameters for Aegisub::text_extents()"));
 	  // We needed 2 parameters at least!
 	  XSRETURN_UNDEF;
 	}
@@ -251,7 +251,7 @@ namespace Automation4 {
   XS(perl_progress_cancelled)
   {
 	wxTRACE_FUNC(Aegisub::Progress::is_cancelled);
-	dXSARGS;
+	dMARK; dAX;
 
 	if(PerlProgressSink *ps = PerlProgressSink::GetProgressSink()) {
 	  if(ps->IsCancelled())	XSRETURN_YES;
@@ -266,8 +266,8 @@ namespace Automation4 {
   XS(perl_console_register)
   {
 	wxTRACE_FUNC(Aegisub::PerlConsole::register_console);
-	dXSARGS;
 #ifdef WITH_PERLCONSOLE
+	dXSARGS;
 
 	PerlScript *script = PerlScript::GetScript();
 	if(script) {
@@ -286,6 +286,7 @@ namespace Automation4 {
 	}
 	XSRETURN_YES;
 #else
+	dMARK; dAX;
 	PerlLogWarning(_("Tried to register PerlConsole, but support for it was disabled in this version."));  // Warning or Hint?
 	XSRETURN_UNDEF;
 #endif

aegisub/auto4_perl.h

@@ -68,7 +68,7 @@
 
 // Debug support
 /* define the following to activate tracing for the perl engine */
-//#define WXTRACE_AUTOPERL
+#define WXTRACE_AUTOPERL
 #define wxTRACE_AutoPerl _T("auto4_perl")
 
 #define wxTRACE_METH(name) \

aegisub/auto4_perl_ass.cpp

@@ -249,6 +249,7 @@ namespace Automation4 {
 	return diag;
   }
 
+  /* TODO: report progress */
   AV *PerlAss::MakeHasshLines(AV *lines, AssFile *ass)
   {
 	if(!lines) {
@@ -436,6 +437,7 @@ namespace Automation4 {
 	return d;
   }
 
+  /* TODO: report progress */
   AssFile *PerlAss::MakeAssLines(AssFile *ass, AV *lines)
   {
 	if(!ass) {
@@ -443,9 +445,13 @@ namespace Automation4 {
 	  return NULL;
 	}
 
+	// There may be a progress sink to report to
+	PerlProgressSink *ps = PerlProgressSink::GetProgressSink();
+
 	dAV;
 	std::list<AssEntry*>::iterator it = ass->Line.begin();
-	for(I32 i = 0; i <= av_len(lines); i++) {
+	I32 len = av_len(lines);
+	for(I32 i = 0; i <= len; i++) {
 	  if(!av_exists(lines, i)) continue;
 	  if(i < (I32)ass->Line.size()) {
 		if(*it) delete *it;
@@ -456,6 +462,9 @@ namespace Automation4 {
 		AV_FETCH(lines, i)
 		  ass->Line.push_back(MakeAssEntry((HV*)SvRV(AV_VAL)));
 	  }
+
+	  // Report progress
+	  if(ps) ps->SetProgress((i+1)/(len+1) * 100);
 	}
 
 	for(; it != ass->Line.end();) {

aegisub/auto4_perl_script.cpp

@@ -125,7 +125,6 @@ namespace Automation4 {
 	// and check on errors
 	if(SvTRUE(_err)) {
 	  description = wxString(SvPV_nolen(_err), pl2wx);
-	  //wxLogError(description);  // Remove?
 	  loaded = false;
 	}
 	else {
@@ -159,20 +158,6 @@ namespace Automation4 {
 	wxTRACE_FUNC(PerlScript::activate);
 	wxLogTrace(wxTRACE_AutoPerl, _T("name = '%s',  package = '%s'"), script->GetName().c_str(), script->GetPackage().c_str());
 
-	// Check if the source file is newer
-	/* FIX */
-	if(script->reload) {
-//	  struct stat s;
-//	  stat(script->GetFilename().mb_str(wxConvLibc), &s);
-	  wxFileName fn(script->GetFilename());
-	  wxDateTime mod;
-	  fn.GetTimes(NULL,&mod,NULL);
-	  if(script->mtime != mod.GetTicks()) {
-		PerlLogVerbose(wxString::Format(_("Reloading %s because the file on disk (%s) changed"), script->GetName().c_str(), script->GetFilename().c_str()));
-		script->Reload();
-	  }
-	}
-
 	// Hooking $SIG{__WARN__}
 	wxLogTrace(wxTRACE_AutoPerl, _T("$SIG{__WARN__} = \\&Aegisub::warn"));
 	eval_pv("$SIG{__WARN__} = \\&Aegisub::warn", 1);
@@ -200,11 +185,6 @@ namespace Automation4 {
 	  PerlLogWarning(_("Unable to add the automation include path(s) to @INC: the script's code may not compile or execute properly."));
 	}
 
-	// Require the core modules
-	//load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("Aegisub", 7), NULL);
-	//load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("Aegisub::Progress", 17), NULL);
-	//load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("Aegisub::Script", 15), NULL);
-
 	// Set the values of script vars
 	script->WriteVars();
 
@@ -234,6 +214,20 @@ namespace Automation4 {
 	// Read the values of script vars
 	active->ReadVars();
 
+	// If reload flag is set...
+	/* STILL BROKEN :< */
+	if(active->reload) {
+	  // check if the source file on disk changed
+	  wxFileName fn(active->GetFilename());
+	  wxDateTime mod;
+	  fn.GetTimes(NULL,&mod,NULL);
+	  if(active->mtime != mod.GetTicks()) {
+		// and reload the script
+		PerlLogVerbose(wxString::Format(_("Reloading %s because the file on disk (%s) changed."), active->GetName().c_str(), active->GetFilename().c_str()));
+		active->Reload();
+	  }
+	}
+
 	// Unhooking $SIG{__WARN__}
 	wxLogTrace(wxTRACE_AutoPerl, _T("undef $SIG{__WARN__}"));
 	eval_pv("undef $SIG{__WARN__}", 1);
@@ -284,9 +278,9 @@ namespace Automation4 {
 	whore = get_sv(bitch.mb_str(wx2pl), 0);
 	if(whore) version = wxString(SvPV_nolen(whore), pl2wx);
 
-	bitch = package + _T("::_script_reload");
-	whore = get_sv(bitch.mb_str(wx2pl), 0);
-	if(whore) reload = SvTRUE(whore);
+	//bitch = package + _T("::_script_reload");
+	//whore = get_sv(bitch.mb_str(wx2pl), 0);
+	//if(whore) reload = SvTRUE(whore);
   }
 
   void PerlScript::WriteVars() const
@@ -423,47 +417,52 @@ namespace Automation4 {
 	AV *selected_av = newAV();
 	VECTOR_AV(selected, selected_av, int, iv);
 
-	script->Activate();
-
 	// Prepare the stack
 	dSP;
-
 	ENTER;
 	SAVETMPS;
 
-	// Push the parameters on the stack
+	// Push the arguments onto the stack
 	PUSHMARK(SP);
-	XPUSHs(sv_2mortal(newRV_noinc((SV*)lines)));
-	XPUSHs(sv_2mortal(newRV_noinc((SV*)selected_av)));
+	SV* lines_ref = sv_2mortal(newRV_noinc((SV*)lines));
+	XPUSHs(lines_ref);
+	SV* selected_ref = sv_2mortal(newRV_noinc((SV*)selected_av));
+	XPUSHs(selected_ref);
 	XPUSHs(sv_2mortal(newSViv(active)));
 	PUTBACK;
 
 	// Create a progress window
 	PerlProgressSink *ps = new PerlProgressSink(progress_parent, GetName());
 	// Start the callback thread
+	script->Activate();
 	PerlThread call(processing_sub, G_EVAL | G_VOID);
-	// Show the progress window
+	// Show the progress window until it is dismissed
 	ps->ShowModal();
-	// And wait unitl it's dismessed
-	delete ps;
 	// Now wait the thread to return
 	call.Wait();
+	script->Deactivate();
 
 	if(!SvTRUE(ERRSV)) {
-	  // Non-error: recreate the hassh :S
+	  // Show progress sink again
+	  ps->Show(true);
+	  ps->SetTask(_("Saving changes"));
+
+	  // Recreate the ass :S
 	  subs->FlagAsModified(GetName());
-	  PerlAss::MakeAssLines(subs, lines);
+	  PerlAss::MakeAssLines(subs, (AV*)SvRV(lines_ref));
 	  // And reset selection vector
 	  selected.clear();
-	  AV_VECTOR(selected_av, selected, IV);
+	  AV_VECTOR((AV*)SvRV(selected_ref), selected, IV);
 	  CHOP_SELECTED(subs, selected);
-	}
 
-	// Clean everything
+	  ps->Hide();
+	}
+	// Delete the progress sink
+	ps->Destroy();
+
+	// Clean the call stack
 	FREETMPS;
 	LEAVE;
-
-	script->Deactivate();
   }