From 5fd966f0f3b3403d90316d519898369232555524 Mon Sep 17 00:00:00 2001 From: shb Date: Sun, 3 Feb 2008 19:21:02 +0000 Subject: [PATCH] Various improvements to autoperl Originally committed to SVN as r1858. --- aegisub/auto4_perl.cpp | 7 ++-- aegisub/auto4_perl.h | 2 +- aegisub/auto4_perl_ass.cpp | 11 ++++- aegisub/auto4_perl_script.cpp | 77 +++++++++++++++++------------------ 4 files changed, 53 insertions(+), 44 deletions(-) diff --git a/aegisub/auto4_perl.cpp b/aegisub/auto4_perl.cpp index 918b1318b..4300563a3 100644 --- a/aegisub/auto4_perl.cpp +++ b/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 diff --git a/aegisub/auto4_perl.h b/aegisub/auto4_perl.h index 693a4a20b..cff6d74ca 100644 --- a/aegisub/auto4_perl.h +++ b/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) \ diff --git a/aegisub/auto4_perl_ass.cpp b/aegisub/auto4_perl_ass.cpp index 3e1c6d252..968ba1d2d 100644 --- a/aegisub/auto4_perl_ass.cpp +++ b/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::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();) { diff --git a/aegisub/auto4_perl_script.cpp b/aegisub/auto4_perl_script.cpp index 47e3f8d8c..caec1b940 100644 --- a/aegisub/auto4_perl_script.cpp +++ b/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(); }