diff --git a/aegisub/Makefile.am b/aegisub/Makefile.am index 0d3b600ae..accb498f0 100644 --- a/aegisub/Makefile.am +++ b/aegisub/Makefile.am @@ -47,6 +47,11 @@ if WITH_AUTO4_RUBY AUTOMATION += auto4_ruby_assfile.cpp auto4_ruby.cpp auto4_ruby_dialog.cpp AM_CPPFLAGS += $(shell ruby -r rbconfig -e "p '-I' + Config::CONFIG['rubylibdir'] + '/' + Config::CONFIG['arch'] ") $(AM_CPPFLAGST) endif +if WITH_AUTO4_PERL +AUTOMATION += auto4_perl.cpp auto4_perl_script.cpp auto4_perl_dialogs.cpp auto4_perl_ass.cpp auto4_perl_console.cpp +AM_CPPFLAGS += $(shell perl -MExtUtils::Embed -eccflags -eperl_inc) +aegisub_LDFLAGS += $(shell perl -MExtUtils::Embed -eldopts) +endif if HAVE_HUNSPELL HUNSPELL=spellchecker_hunspell.cpp diff --git a/aegisub/auto4_perl.cpp b/aegisub/auto4_perl.cpp index c61b46744..5c17cc6ce 100644 --- a/aegisub/auto4_perl.cpp +++ b/aegisub/auto4_perl.cpp @@ -38,6 +38,16 @@ #include "auto4_perl.h" +#include "auto4_perl_console.h" +#include "options.h" +#include "ass_style.h" + + +#define COLLECT_PV(buf, s, e) \ + buf = wxString(SvPV_nolen(ST(s)), pl2wx);\ + for(int ARG_i = s+1; ARG_i <= e; ARG_i++) {\ + buf << _T(" ") << wxString(SvPV_nolen(ST(ARG_i)), pl2wx);\ + } namespace Automation4 { @@ -46,9 +56,264 @@ namespace Automation4 { /////////////////////////////////// // Perl -> C++ interface (XSUBS) // + + /* Aegisub */ + XS(perl_log) // Aegisub::log() + { + wxTRACE_FUNC(Aegisub::log); + dXSARGS; + IV level = 6; + + int start = 0; + if(items >= 2 && SvIOK(ST(0))) { + level = SvIV(ST(0)); + start = 1; + } + wxString msg; + COLLECT_PV(msg, start, items-1); + PerlLog(level, msg); + } + + XS(perl_warning) // Aegisub::warn() + { + wxTRACE_FUNC(Aegisub::warn); + dXSARGS; + + if(items >= 1) { + wxString buf; + COLLECT_PV(buf, 0, items-1); + PerlLogWarning(buf); + } + } + + + XS(perl_text_extents) // Aegisub::text_extents + { + wxTRACE_FUNC(Aegisub::text_extents); + dXSARGS; + + // Read the parameters + SV *style; wxString text; + if(items >= 2) { + // Enough of them + style = sv_mortalcopy(ST(0)); + text = wxString(SvPV_nolen(ST(1)), pl2wx); + } + else { + /* TODO maybe: emit warning */ + // We needed 2 parameters at least! + XSRETURN_UNDEF; + } + + // Get the AssStyle + AssStyle *s; + if(SvROK(style)) { + // Create one from the hassh + s = PerlAss::MakeAssStyle((HV*)SvRV(style)); + } + else { + // It's the name of the style + wxString sn(SvPV_nolen(style), pl2wx); + // We get it from the AssFile::top + s = AssFile::top->GetStyle(sn); + /* TODO maybe: make it dig from the current hassh's styles */ + if(!s) + XSRETURN_UNDEF; + } + + // The return parameters + double width, height, descent, extlead; + // The actual calculation + if(!CalculateTextExtents(s, text, width, height, descent, extlead)) { + /* TODO: diagnose error */ + XSRETURN_EMPTY; + } + + // Returns + switch(GIMME_V) { + case G_SCALAR: + // Scalar context + XSRETURN_NV(width); + break; + default: + case G_ARRAY: + // List context + EXTEND(SP, 4); + XST_mNV(0, width); + XST_mNV(1, height); + XST_mNV(2, descent); + XST_mNV(3, extlead); + XSRETURN(4); + } + } + + /* Aegisub::Script */ + XS(perl_script_set_info) + { + wxTRACE_FUNC(Aegisub::Script::set_info); + dXSARGS; + + PerlScript *active = PerlScript::GetScript(); + if(active) { + // Update the object's vars + active->ReadVars(); + + // We want at most 4 parameters :P + if(items > 4) items = 4; + // Set script info vars + switch (items) { + case 4: + active->SetVersion(wxString(SvPV_nolen(ST(3)), pl2wx)); + case 3: + active->SetAuthor(wxString(SvPV_nolen(ST(2)), pl2wx)); + case 2: + active->SetDescription(wxString(SvPV_nolen(ST(1)), pl2wx)); + case 1: + active->SetName(wxString(SvPV_nolen(ST(0)), pl2wx)); + } + + // Update the package's vars + active->WriteVars(); + } + } + + XS(perl_script_register_macro) + { + wxTRACE_FUNC(Aegisub::Script::register_macro); + dXSARGS; + + PerlScript *active = PerlScript::GetScript(); + if(active && items >= 3) { + wxString name, description; + SV *proc_sub = NULL, *val_sub = NULL; + + if(items > 4) items = 4; + switch (items) { + case 4: + val_sub = sv_mortalcopy(ST(3)); + case 3: + proc_sub = sv_mortalcopy(ST(2)); + description = wxString(SvPV_nolen(ST(1)), pl2wx); + name = wxString(SvPV_nolen(ST(0)), pl2wx); + } + if(proc_sub) { + active->AddFeature(new PerlFeatureMacro(name, description, active, proc_sub, val_sub)); + XSRETURN_YES; + } + } + XSRETURN_UNDEF; + } + + /* Aegisub::Progress */ + XS(perl_progress_set) + { + wxTRACE_FUNC(Aegisub::Progress::set_progress); + dXSARGS; + + PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); + if(ps && items >= 1) { + NV pc = SvNV(ST(0)); + if(pc <= 1) pc *= 100; + if(pc > 100) pc = 100; + ps->SetProgress(pc); + wxWakeUpIdle(); + } + } + + XS(perl_progress_task) + { + wxTRACE_FUNC(Aegisub::Progress::set_task); + dXSARGS; + + PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); + if(ps && items >= 1) { + wxString task; + COLLECT_PV(task, 0, items-1); + ps->SetTask(task); + wxWakeUpIdle(); + } + } + + XS(perl_progress_title) + { + wxTRACE_FUNC(Aegisub::Progress::set_title); + dXSARGS; + + PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); + if(ps && items >= 1) { + wxString title; + COLLECT_PV(title, 0, items-1); + ps->SetTitle(title); + wxWakeUpIdle(); + } + } + + XS(perl_progress_cancelled) + { + wxTRACE_FUNC(Aegisub::Progress::is_cancelled); + dXSARGS; + + if(PerlProgressSink *ps = PerlProgressSink::GetProgressSink()) { + if(ps->IsCancelled()) XSRETURN_YES; + else XSRETURN_NO; + } + else { + XSRETURN_UNDEF; + } + } + + /* Aegisub::PerlConsole */ + XS(perl_console_register) + { + wxTRACE_FUNC(Aegisub::PerlConsole::register_console); + dXSARGS; + + PerlScript *script = PerlScript::GetScript(); + if(script) { + wxString name = _T("Perl console"); + wxString desc = _T("Show the Perl console"); + switch (items) { + case 2: + desc = wxString(SvPV_nolen(ST(1)), pl2wx); + case 1: + name = wxString(SvPV_nolen(ST(0)), pl2wx); + } + + if(!PerlConsole::GetConsole()) + // If there's no registered console + script->AddFeature(new PerlConsole(name, desc, script)); + } + } + + XS(perl_console_echo) + { + wxTRACE_FUNC(Aegisub::PerlConsole::echo); + dXSARGS; + + // We should get some parameters + if(items == 0) return; + + // Join the params in a unique string :S + wxString buffer = wxString(SvPV_nolen(ST(0)), pl2wx); + for(int i = 1; i < items; i++) { + buffer << _T(" ") << wxString(SvPV_nolen(ST(i)), pl2wx); + } + + if(PerlConsole::GetConsole()) { + // If there's a console echo to it + PerlConsole::Echo(buffer); + } + else { + // Otherwise print on stdout + PerlIO_printf(PerlIO_stdout(), "%s\n", buffer.mb_str(wxConvLocal).data()); + // (through perl io system) + } + } + + /* Universal loader */ EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); - // Copypasted from somewhere + /* XS registration */ EXTERN_C void xs_perl_main(pTHX) { dXSUB_SYS; @@ -57,9 +322,172 @@ namespace Automation4 { newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); // My XSUBS ^^ - xs_perl_script(aTHX); - xs_perl_misc(aTHX); - xs_perl_console(aTHX); + newXS("Aegisub::log", perl_log, __FILE__); + newXS("Aegisub::warn", perl_warning, __FILE__); + newXS("Aegisub::text_extents", perl_text_extents, __FILE__); + newXS("Aegisub::Script::set_info", perl_script_set_info, __FILE__); + newXS("Aegisub::Script::register_macro", perl_script_register_macro, __FILE__); + newXS("Aegisub::Progress::set_progress", perl_progress_set, __FILE__); + newXS("Aegisub::Progress::set_task", perl_progress_task, __FILE__); + newXS("Aegisub::Progress::set_title", perl_progress_title, __FILE__); + newXS("Aegisub::Progress::is_cancelled", perl_progress_cancelled, __FILE__); + newXS("Aegisub::PerlConsole::echo", perl_console_echo, __FILE__); + newXS("Aegisub::PerlConsole::register_console", perl_console_register, __FILE__); + } + + +///////////// +// PerlLog +// + void PerlLog(unsigned int level, const wxString &msg) + { + PerlProgressSink *ps = PerlProgressSink::GetProgressSink(); + if(!(level & 0x8) && ps) { + wxString _msg; + // Prepend a description of the log line + switch(level) { + case 0: _msg = _("Fatal error: "); + break; + case 1: _msg = _("Error: "); + break; + case 2: _msg = _("Warning: "); + break; + case 3: _msg = _("Hint: "); + break; + case 4: _msg = _("Debug: "); + break; + case 5: _msg = _("Trace: "); + } + // Print onto the progress window + ps->Log(level >= 6 ? -1 : level, _msg+msg+_T("\n")); + } + else { + level &= 0x7; + // Use the wx log functions + switch(level) { + case 0: wxLogFatalError(msg); + break; + case 1: wxLogError(msg); + break; + case 2: wxLogWarning(msg); + break; + case 3: wxLogVerbose(msg); + break; + case 4: wxLogDebug(msg); + break; + case 5: wxLogTrace(wxTRACE_AutoPerl, msg); + break; + default: + case 6: wxLogMessage(msg); + } + } + } + + +//////////////// +// PerlThread +// + + PerlThread::PerlThread(): + wxThread(wxTHREAD_JOINABLE) + { + pv = NULL; sv = NULL; + } + + PerlThread::PerlThread(const char *sub_name, I32 flags, bool type): + wxThread(wxTHREAD_JOINABLE) + { + wxTRACE_METH(PerlThread); + if(type == CALL) Call(sub_name, flags); + if(type == EVAL) Eval(sub_name, flags); + } + + PerlThread::PerlThread(SV *sv, I32 flags, bool type): + wxThread(wxTHREAD_JOINABLE) + { + wxTRACE_METH(PerlThread); + if(type == CALL) Call(sv, flags); + if(type == EVAL) Eval(sv, flags); + } + + wxThreadError PerlThread::launch() + { + wxThreadError e = Create(); + if(e != wxTHREAD_NO_ERROR) return e; + + switch(Options.AsInt(_T("Automation Thread Priority"))) { + case 2: SetPriority(10); + break; + case 1: SetPriority(30); + break; + default: + case 0: SetPriority(50); // fallback normal + } + + wxTRACE_RET(PerlThread); + return Run(); + } + + wxThreadError PerlThread::Call(const char *sub_name, I32 _flags) + { + type = CALL; pv = sub_name; flags = _flags; + wxLogTrace(wxTRACE_AutoPerl, _T("type = CALL, pv = '%s', flags = %u"), wxString(pv, pl2wx).c_str(), flags); + return launch(); + } + wxThreadError PerlThread::Call(SV *_sv, I32 _flags) + { + type = CALL; sv = _sv; flags = _flags; + wxLogTrace(wxTRACE_AutoPerl, _T("type = CALL, sv = %p, flags = %u"), sv, flags); + return launch(); + } + + wxThreadError PerlThread::Eval(const char* p, I32 croak_on_error) + { + type = EVAL; pv = p; flags = croak_on_error; + wxLogTrace(wxTRACE_AutoPerl, _T("type = EVAL, pv = '%s', flags = %u"), wxString(pv, pl2wx).c_str(), flags); + return launch(); + } + wxThreadError PerlThread::Eval(SV* _sv, I32 _flags) + { + type = EVAL; sv = _sv; flags = _flags; + wxLogTrace(wxTRACE_AutoPerl, _T("type = EVAL, sv = %p, flags = %u"), sv, flags); + return launch(); + } + + wxThread::ExitCode PerlThread::Entry() + { + wxTRACE_METH(Entry); + + PerlProgressSink *ps; + if(ps = PerlProgressSink::GetProgressSink()) { + // If there's a progress sink... + while(!ps->has_inited); + // ...wait for it to have inited + } + + ExitCode ec = NULL; + switch(type) { + case CALL: + if(sv) ec = (ExitCode)call_sv(sv, flags); + else if(pv) ec = (ExitCode)call_pv(pv, flags); + break; + case EVAL: + if(sv) ec = (ExitCode)eval_sv(sv, flags); + else if(pv) ec = (ExitCode)eval_pv(pv, flags); + } + + if(SvTRUE(ERRSV)) { + // Log $@ in case of error + PerlLogError(wxString(SvPV_nolen(ERRSV), pl2wx)); + } + + if(ps) { + ps->script_finished = true; + wxWakeUpIdle(); + } + + wxTRACE_RET(Entry); + return ec; } @@ -73,7 +501,12 @@ namespace Automation4 { public: PerlScriptFactory() - { + { +#ifdef WXTRACE_AUTOPERL + // Add tracing of perl engine operations + wxLog::AddTraceMask(wxTRACE_AutoPerl); +#endif + // Script engine properties loaded = false; engine_name = _T("Perl"); @@ -88,13 +521,11 @@ namespace Automation4 { #endif // Perl interpreter initialization (ONE FOR ALL THE SCRIPTS) - char** env = NULL; int argc = 3; char *argv[3] = { "aegisub", "-e", "0" }; -#ifdef __VISUALC__ - char **argv2 = (char**) argv; + char** env = NULL; + char **argv2 = (char**) argv; // VC++ wants this °_° PERL_SYS_INIT3(&argc,&argv2,&env); -#endif parser = perl_alloc(); perl_construct(parser); perl_parse(parser, xs_perl_main, @@ -114,9 +545,7 @@ namespace Automation4 { if (loaded) { perl_destruct(parser); perl_free(parser); -#ifdef __VISUALC__ PERL_SYS_TERM(); -#endif } } diff --git a/aegisub/auto4_perl.h b/aegisub/auto4_perl.h index 1a40c618d..693a4a20b 100644 --- a/aegisub/auto4_perl.h +++ b/aegisub/auto4_perl.h @@ -33,6 +33,7 @@ // Contact: mailto:jiifurusu@gmail.com // + #pragma once #ifndef _AUTO4_PERL_H #define _AUTO4_PERL_H @@ -43,17 +44,16 @@ #include #include "ass_file.h" -//#include "ass_dialogue.h" #undef _ #include #include #include -#include "auto4_perldata.inc" // Parl variables manipulation macros +#include "auto4_perldata.inc" // Perl variables manipulation macros #undef bool -// the fucking perl.h redefines _() -.- please disregard warnings during compilation +// the fucking perl.h redefines _() -.- #undef _ #define _(s) wxGetTranslation(_T(s)) @@ -66,20 +66,82 @@ #define PERL_SCRIPT_EXTENSION ".pl" /* TODO maybe: make it multi-extension */ +// Debug support +/* define the following to activate tracing for the perl engine */ +//#define WXTRACE_AUTOPERL +#define wxTRACE_AutoPerl _T("auto4_perl") + +#define wxTRACE_METH(name) \ + wxLogTrace(wxTRACE_AutoPerl, _T("\t=== %p::%s() ==="), this, _T(#name)) + +#define wxTRACE_FUNC(name) \ + wxLogTrace(wxTRACE_AutoPerl, _T("\t=== %s() ==="), _T(#name)) + +#define wxTRACE_RET(name) \ + wxLogTrace(wxTRACE_AutoPerl, _T("\t___ %s() returned ___"), _T(#name)) + + namespace Automation4 { -/////////// -// XSUBS + +///////////// +// PerlLog // - void xs_perl_script(pTHX); - void xs_perl_misc(pTHX); - void xs_perl_console(pTHX); +#define LOG_FATAL 0 +#define LOG_ERROR 1 +#define LOG_WARNING 2 +#define LOG_HINT 3 +#define LOG_DEBUG 4 +#define LOG_TRACE 5 +#define LOG_MESSAGE 6 + +#define LOG_WX 8 + +#define PerlLogFatal(str) PerlLog(LOG_FATAL, str) +#define PerlLogFatalError(str) PerlLog(LOG_FATAL, str) +#define PerlLogError(str) PerlLog(LOG_ERROR, str) +#define PerlLogWarning(str) PerlLog(LOG_WARNING, str) +#define PerlLogHint(str) PerlLog(LOG_HINT, str) +#define PerlLogVerbose(str) PerlLog(LOG_HINT, str) +#define PerlLogDebug(str) PerlLog(LOG_DEBUG, str) +#define PerlLogTrace(str) PerlLog(LOG_TRACE, str) +#define PerlLogMessage(str) PerlLog(LOG_MESSAGE, str) + + void PerlLog(unsigned int level, const wxString &msg); + + +//////////////// +// PerlThread +// + class PerlThread : public wxThread { + private: + const char *pv; + SV *sv; + I32 flags; + + bool type; + + wxThreadError launch(); + + public: + enum { EVAL = 0, CALL = 1 }; + + PerlThread(); + PerlThread(const char *sub_name, I32 flags, bool type = CALL); + PerlThread(SV *sv, I32 flags, bool type = CALL); + + wxThreadError Call(const char *sub_name, I32 flags); + wxThreadError Call(SV *sv, I32 flags); + wxThreadError Eval(const char* p, I32 croak_on_error); + wxThreadError Eval(SV* sv, I32 flags); + + virtual ExitCode Entry(); + }; /////////////////// // Script object // - class PerlFeatureMacro; class PerlScript : public Script { private: static PerlScript *active; // The active script (at any given time) @@ -93,40 +155,33 @@ namespace Automation4 { void load(); // It doas all the script initialization void unload(); // It does all the script disposing - static void activate(PerlScript *script); // Set the active script /* TODO: add @INC hacking */ + static void activate(PerlScript *script); // Set the active script static void deactivate(); // Unset the active script public: PerlScript(const wxString &filename); virtual ~PerlScript(); + static PerlScript *GetScript() { return active; } // Query the value of the active script virtual void Reload(); // Reloading of a loaded script void Activate() { activate(this); } // Set the script as active void Deactivate() const { deactivate(); } // Unset the active script - const wxString& GetPackage() const { return package; } // The perl package containing script code - static PerlScript *GetScript() { return active; } // Query the value of the active script - - /* TODO maybe: change these into tying of scalars */ + /* TODO maybe: move to tied scalars */ void ReadVars(); // Sync the script's vars from perl package to script object void WriteVars() const; // Sync the script's vars from script object to perl package - /* TODO: add c++ equivalents */ void AddFeature(Feature *feature); void DeleteFeature(Feature *feature); - static PerlScript *GetActive() { return active; } + const wxString& GetPackage() const { return package; } // The perl package containing script code void SetName(const wxString &str) { name = str; } void SetDescription(const wxString &str) { description = str; } void SetAuthor(const wxString &str) { author = str; } void SetVersion(const wxString &str) { version = str; } }; - XS(set_info); // Aegisub::Script::set_info() - XS(register_macro); // Aegisub::Script::register_macro() - XS(register_console); // Aegisub::Script::register_console() /* TODO: move this into PerlConsole class */ - ////////////////// // Macro object @@ -148,6 +203,22 @@ namespace Automation4 { }; +////////////////////// +// PerlProgressSink +// + class PerlProgressSink : public ProgressSink { + private: + static PerlProgressSink *sink; + public: + PerlProgressSink(wxWindow *parent, const wxString &title = _T("...")); + ~PerlProgressSink(); + static PerlProgressSink *GetProgressSink() { return sink; } + + bool IsCancelled() const { return cancelled; } + void Log(int level, const wxString &message) { if(level <= trace_level) AddDebugOutput(message); } + }; + + /////////////////////////////////////////////////// // Conversion between aegisub data and perl data // @@ -169,17 +240,6 @@ namespace Automation4 { }; -///////////////////////// -// Misc utility functions -// - class PerlLog { - public: - }; - - XS(log_warning); // Aegisub::warn() - XS(text_extents); // Aegisub::text_extents() - - }; diff --git a/aegisub/auto4_perl_ass.cpp b/aegisub/auto4_perl_ass.cpp index 6c0be586c..009e3aab0 100644 --- a/aegisub/auto4_perl_ass.cpp +++ b/aegisub/auto4_perl_ass.cpp @@ -75,24 +75,24 @@ namespace Automation4 { wxString PerlAss::GetEntryClass(AssEntry *entry) { - wxString data = entry->GetEntryData(); - - if(entry->GetType() == ENTRY_DIALOGUE) return _T("dialogue"); - - if(entry->GetType() == ENTRY_STYLE) { + switch(entry->GetType()) { + case ENTRY_DIALOGUE: return _T("dialogue"); + case ENTRY_STYLE: return _T("style"); /* TODO: add stylex recognition */ - } - - if(entry->GetType() == ENTRY_BASE) { + break; + case ENTRY_ATTACHMENT: return _T("attachment"); + default: + case ENTRY_BASE: + wxString data(entry->GetEntryData()); if(entry->group == _T("[Script Info]") && data.Matches(_T("*:*"))) return _T("info"); - + if(data == entry->group) return _T("head"); - + if(data.StartsWith(_T("Format:"))) return _T("format"); - + if(data.IsEmpty()) return _T("clear"); - + if(data.Trim(left).StartsWith(_T(";"))) return _T("comment"); } @@ -103,13 +103,15 @@ namespace Automation4 { HV *PerlAss::MakeHasshEntry(AssEntry *e) { - switch((int)e->GetType()) { + switch(e->GetType()) { case ENTRY_DIALOGUE: return MakeHasshDialogue(AssEntry::GetAsDialogue(e)); case ENTRY_STYLE: return MakeHasshStyle(AssEntry::GetAsStyle(e)); + case ENTRY_ATTACHMENT: + default: case ENTRY_BASE: dHV; @@ -296,12 +298,16 @@ namespace Automation4 { // It seems to be a style, let's call the specialized function return MakeAssStyle(entry); } + else if(cl == _T("attachment")) { + /* TODO */ + return NULL; + } else { + // A base entry AssEntry *e = new AssEntry(); ASS_BASIC_INIT(entry, e); - // A base entry if(cl == _T("info")) { wxString key, value; HV_FETCH(entry, "key", 3) { diff --git a/aegisub/auto4_perl_console.cpp b/aegisub/auto4_perl_console.cpp index 0cc2cf3e5..43132abda 100644 --- a/aegisub/auto4_perl_console.cpp +++ b/aegisub/auto4_perl_console.cpp @@ -47,13 +47,6 @@ namespace Automation4 { - void xs_perl_console(pTHX) - { - newXS("Aegisub::PerlConsole::echo", echo, __FILE__); - newXS("Aegisub::PerlConsole::register_console", register_console, __FILE__); - } - - //////////////////////////////////// // PerlConsole::Dialog // @@ -114,12 +107,6 @@ namespace Automation4 { } } - inline void PerlConsole::Dialog::Echo(const wxString &str) - { - if(txt_out) *txt_out << str << _T("\n"); - else PerlIO_printf(PerlIO_stdout(), "%s\n", str.mb_str(wxConvLocal).data()); - } - ////////////////////// // PerlConsole @@ -134,8 +121,10 @@ namespace Automation4 { parent_window = NULL; dialog = new Dialog(); - // Fuck off any previously registered console °_° - if(registered) delete registered; + // Remove any previously registered console °_° + if(registered) { + registered->script->DeleteFeature(registered); + } registered = this; } @@ -146,7 +135,7 @@ namespace Automation4 { /* TODO: Free something? */ // Delete the registered console - PerlConsole::registered = NULL; + registered = NULL; } void PerlConsole::Process(AssFile *subs, std::vector &selected, int active, wxWindow * const progress_parent) @@ -197,6 +186,9 @@ namespace Automation4 { code << str; // Evaluate the code SV *e = eval_pv(code.mb_str(wx2pl), 0); + /* TODO: use threaded calls */ + /*PerlThread eval(code.mb_str(wx2pl), 1, PerlThread::EVAL); + e = (SV*)eval.Wait();*/ /* TODO: check for errors */ script->ReadVars(); @@ -220,52 +212,28 @@ namespace Automation4 { return wxString(SvPV_nolen(e), pl2wx); } - XS(register_console) + wxString PerlConsole::Evaluate(const wxString &str) { - dXSARGS; - PerlScript *script = PerlScript::GetScript(); - if(script) { - wxString name = _T("Perl console"); - wxString desc = _T("Show the Perl console"); - switch (items) { - case 2: - desc = wxString(SvPV_nolen(ST(1)), pl2wx); - case 1: - name = wxString(SvPV_nolen(ST(0)), pl2wx); - } - - if(!PerlConsole::GetConsole()) - // If there's no registered console - script->AddFeature(new PerlConsole(name, desc, script)); - } - } - - XS(echo) - { - dXSARGS; - - // We should get some parameters - if(items == 0) XSRETURN_EMPTY; - - // Join the params in a unique string :S - wxString buffer = wxString(SvPV_nolen(ST(0)), pl2wx); - for(int i = 1; i < items; i++) { - buffer << _T(" ") << wxString(SvPV_nolen(ST(i)), pl2wx); - } - - if(PerlConsole::GetConsole()) { - // If there's a console echo to it - PerlConsole::GetConsole()->GetDialog()->Echo(buffer); + if(registered) { + return registered->evaluate(str); } else { - // Otherwise print on stdout - PerlIO_printf(PerlIO_stdout(), "%s\n", buffer.mb_str(wxConvLocal).data()); - // (through perl io system) + /* TODO: print error */ + return _T(""); } - - XSRETURN_EMPTY; } + void PerlConsole::Echo(const wxString &str) + { + if(registered && registered->dialog->txt_out) { + *(registered->dialog->txt_out) << str << _T("\n"); + } + else { + PerlIO_printf(PerlIO_stdout(), "%s\n", str.c_str()); + } + } + + }; diff --git a/aegisub/auto4_perl_console.h b/aegisub/auto4_perl_console.h index d40ebc628..3b42efebb 100644 --- a/aegisub/auto4_perl_console.h +++ b/aegisub/auto4_perl_console.h @@ -45,6 +45,10 @@ namespace Automation4 { + +///////////////// +// PerlConsole +// class PerlConsole : public PerlFeatureMacro { private: static PerlConsole *registered; @@ -52,6 +56,7 @@ namespace Automation4 { // Nested classes are messy, therefore we use them :) class Dialog : public wxDialog { private: + friend class PerlConsole; wxTextCtrl *txt_out, *txt_hist, *txt_in; public: @@ -62,13 +67,11 @@ namespace Automation4 { long style = wxDEFAULT_DIALOG_STYLE, const wxString& name = _T("console_dialog")); void InputEnter(wxCommandEvent& evt); - void Echo(const wxString &str); }; Dialog *dialog; wxWindow *parent_window; - SV *cout; wxString evaluate(const wxString &str); public: @@ -76,16 +79,15 @@ namespace Automation4 { virtual ~PerlConsole(); static PerlConsole *GetConsole() { return registered; } - Dialog *GetDialog() { return dialog; } virtual bool Validate(AssFile *subs, const std::vector &selected, int active) { return true; } virtual void Process(AssFile *subs, std::vector &selected, int active, wxWindow * const progress_parent); - static wxString Evaluate(const wxString &str) { if(registered) return registered->evaluate(str); else return _T(""); } + static wxString Evaluate(const wxString &str); + static void Echo(const wxString &str); }; - XS(register_console); - XS(echo); + }; diff --git a/aegisub/auto4_perl_misc.cpp b/aegisub/auto4_perl_dialogs.cpp similarity index 54% rename from aegisub/auto4_perl_misc.cpp rename to aegisub/auto4_perl_dialogs.cpp index 42f666be4..1a139cbc2 100644 --- a/aegisub/auto4_perl_misc.cpp +++ b/aegisub/auto4_perl_dialogs.cpp @@ -43,92 +43,27 @@ namespace Automation4 { - void xs_perl_misc(pTHX) - { - newXS("Aegisub::warn", log_warning, __FILE__); - newXS("Aegisub::text_extents", text_extents, __FILE__); - } - - -///////////// -// PerlLog +////////////////////// +// PerlProgressSink // + PerlProgressSink *PerlProgressSink::sink; - XS(log_warning) + PerlProgressSink::PerlProgressSink(wxWindow* parent, const wxString &title): + ProgressSink(parent) { - dXSARGS; - wxString buffer; - if(items >= 1) { - buffer = wxString(SvPV_nolen(ST(0)), wx2pl); - for(I32 i = 1; i < items; i++) { - buffer << _T(" ") << wxString(SvPV_nolen(ST(i)), wx2pl); - } + if(sink) { + sink->Destroy(); } - wxLogWarning(buffer); + sink = this; + SetTitle(_("Executing ") + title); + } + + PerlProgressSink::~PerlProgressSink() + { + sink = NULL; } -//////////// -// Others -// - - XS(text_extents) - { - /* TODO badly: rewrite this shit */ - dXSARGS; - - // Read the parameters - SV *style; wxString text; - if(items >= 2) { - // Enough of them - style = sv_mortalcopy(ST(0)); - text = wxString(SvPV_nolen(ST(1)), pl2wx); - } - else { - // We needed 2 parameters at least! - XSRETURN_UNDEF; - } - - // Get the AssStyle - AssStyle *s; - if(SvROK(style)) { - // Create one from the hassh - s = PerlAss::MakeAssStyle((HV*)SvRV(style)); - } - else { - // It's the name of the style - wxString sn(SvPV_nolen(style), pl2wx); - // We get it from the AssFile::top - s = AssFile::top->GetStyle(sn); - /* TODO: make it dig from the current hassh's styles */ - } - - // The return parameters - double width, height, descent, extlead; - // The actual calculation - if(!CalculateTextExtents(s, text, width, height, descent, extlead)) { - /* TODO: diagnose error */ - XSRETURN_EMPTY; - } - - // Returns - switch(GIMME_V) { - case G_ARRAY: - // List context - EXTEND(SP, 4); - XST_mNV(0, width); - XST_mNV(1, height); - XST_mNV(2, descent); - XST_mNV(3, extlead); - XSRETURN(4); - break; - case G_SCALAR: - // Scalar context - XSRETURN_NV(width); - } - } - - }; diff --git a/aegisub/auto4_perl_macro.cpp b/aegisub/auto4_perl_macro.cpp deleted file mode 100644 index fac42aa82..000000000 --- a/aegisub/auto4_perl_macro.cpp +++ /dev/null @@ -1,192 +0,0 @@ -// Copyright (c) 2008, Simone Cociancich -// All rights reserved. -// -// Redistribution and use in source and binary forms, with or without -// modification, are permitted provided that the following conditions are met: -// -// * Redistributions of source code must retain the above copyright notice, -// this list of conditions and the following disclaimer. -// * Redistributions in binary form must reproduce the above copyright notice, -// this list of conditions and the following disclaimer in the documentation -// and/or other materials provided with the distribution. -// * Neither the name of the Aegisub Group nor the names of its contributors -// may be used to endorse or promote products derived from this software -// without specific prior written permission. -// -// THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -// AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -// IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -// ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE -// LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -// CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -// SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -// INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -// CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -// ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -// POSSIBILITY OF SUCH DAMAGE. -// -// ----------------------------------------------------------------------------- -// -// AEGISUB -// -// Website: http://aegisub.cellosoft.com -// Contact: mailto:jiifurusu@gmail.com -// - - -#ifdef WITH_PERL - - -#include "auto4_perl.h" -#include "ass_file.h" - - -#ifdef __VISUALC__ -#pragma warning(disable: 4800) -#endif - - -namespace Automation4 { - - -////////////////////// -// PerlFeatureMacro -// - - PerlFeatureMacro::PerlFeatureMacro(const wxString &name, const wxString &description, PerlScript *own_script, SV *proc_sub, SV *val_sub): - Feature(SCRIPTFEATURE_MACRO, name), - FeatureMacro(name, description) - { - // We know what script we belong to ^_^ - script = own_script; - - // And not surprisingly we have some callbacks too - processing_sub = newSVsv(proc_sub); - validation_sub = newSVsv(val_sub); - } - - PerlFeatureMacro::~PerlFeatureMacro() { - // The macro subroutines get undefined - /* This is crappy and creepy at the same time */ - /* TODO: thoroughly recheck the code */ - CV *cv = Nullcv; - HV *hv = NULL; - GV *gv = NULL; - if(processing_sub) { - cv = sv_2cv(processing_sub, &hv, &gv, 1); - cv_undef(cv); - if(hv) hv_undef(hv); - } - if(validation_sub) { - cv = sv_2cv(validation_sub, &hv, &gv, 1); - cv_undef(cv); - if(hv) hv_undef(hv); - } - }; - - bool PerlFeatureMacro::Validate(AssFile *subs, const std::vector &selected, int active) - { - // If there's no validation subroutine defined simply return true - if(!validation_sub) return true; - // otherwise... - - // Sub lines - AV *lines = PerlAss::MakeHasshLines(NULL, subs); - // Selection array - AV *selected_av = newAV(); - VECTOR_AV(selected, selected_av, int, iv); - - // Sync script's vars with package's - script->Activate(); - - bool ret = false; - int c = 0; - - // Prepare the stack - dSP; - - ENTER; - SAVETMPS; - - // Push the parameters on the stack - PUSHMARK(SP); - XPUSHs(sv_2mortal(newRV_noinc((SV*)lines))); - XPUSHs(sv_2mortal(newRV_noinc((SV*)selected_av))); - XPUSHs(sv_2mortal(newSViv(active))); - PUTBACK; - - // Call back the callback - c = call_sv(validation_sub, G_EVAL | G_SCALAR); - SPAGAIN; - - if(SvTRUE(ERRSV)) { - wxLogVerbose(wxString(SvPV_nolen(ERRSV), pl2wx)); - ret = false; - } - else { - SV *wtf = sv_mortalcopy(POPs); - ret = SvTRUE(wtf); - } - - // Tidy up everything - PUTBACK; - FREETMPS; - LEAVE; - - script->Deactivate(); - - return ret; - } - - void PerlFeatureMacro::Process(AssFile *subs, std::vector &selected, int active, wxWindow * const progress_parent) - { - // Reference to the hassh (lines) - AV *lines = PerlAss::MakeHasshLines(NULL, subs); - // Selection array - 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 - PUSHMARK(SP); - XPUSHs(sv_2mortal(newRV_noinc((SV*)lines))); - XPUSHs(sv_2mortal(newRV_noinc((SV*)selected_av))); - XPUSHs(sv_2mortal(newSViv(active))); - PUTBACK; - - // Call back the callback :) - call_sv(processing_sub, G_EVAL | G_VOID); - - if(SvTRUE(ERRSV)) { - // Error - wxLogError(wxString(SvPV_nolen(ERRSV), pl2wx)); - } - else { - // Non-error: recreate the hassh :S - subs->FlagAsModified(GetName()); - PerlAss::MakeAssLines(subs, lines); - // And reset selection vector - selected.clear(); - AV_VECTOR(selected_av, selected, IV); - CHOP_SELECTED(subs, selected); - } - - // Clean everything - FREETMPS; - LEAVE; - - script->Deactivate(); - } - - -}; - - -#endif //WITH_PERL diff --git a/aegisub/auto4_perl_script.cpp b/aegisub/auto4_perl_script.cpp index c6d436065..96ed302a2 100644 --- a/aegisub/auto4_perl_script.cpp +++ b/aegisub/auto4_perl_script.cpp @@ -38,26 +38,20 @@ #include "auto4_perl.h" -#include "auto4_perl_console.h" #include "version.h" #include "standard_paths.h" #include #include + #ifdef __VISUALC__ #pragma warning(disable: 4800) #endif + namespace Automation4 { - void xs_perl_script(pTHX) - { - newXS("Aegisub::Script::set_info", set_info, __FILE__); - newXS("Aegisub::Script::register_macro", register_macro, __FILE__); - } - - ////////////////////// // PerlScript class // @@ -69,12 +63,14 @@ namespace Automation4 { // Create a package name for the script package.Printf(_T("Aegisub::Script::p%lx"), this); + // local @INC; # lol inc_saved = newAV(); + // Buggy reload = false; mtime = 0; - // Load the code + // Load the script load(); } @@ -92,7 +88,8 @@ namespace Automation4 { void PerlScript::load() { - wxLogTrace(_T("Loading %*s inside %s"), 0, GetFilename().c_str(), package.c_str()); + wxTRACE_METH(load); + wxLogTrace(wxTRACE_AutoPerl, _T("filename = '%s', package = '%s'"), GetFilename().c_str(), package.c_str()); // Feed some defaults into the script info name = GetPrettyFilename().BeforeLast(_T('.')); @@ -100,10 +97,6 @@ namespace Automation4 { author = wxGetUserId(); version = GetAegisubShortVersionString(); - // Get file's mtime - //struct stat s; - //stat(GetFilename().mb_str(wxConvLibc), &s); - //mtime = s.st_mtime; wxFileName fn(GetFilename()); wxDateTime mod; fn.GetTimes(NULL,&mod,NULL); @@ -125,8 +118,10 @@ namespace Automation4 { // Let's eval the 'boxed' script eval_pv(_script.mb_str(wx2pl), 0); + // and check on errors if(SvTRUE(ERRSV)) { - wxLogError(wxString(SvPV_nolen(ERRSV), pl2wx)); + description = wxString(SvPV_nolen(ERRSV), pl2wx); + wxLogError(description); // Remove? loaded = false; } else { @@ -135,10 +130,13 @@ namespace Automation4 { // The script has done loading (running) deactivate(); + + wxTRACE_RET(load); } void PerlScript::unload() { - wxLogTrace(_T("Unloading %*s(%s)"), 0, name, package.c_str()); + wxTRACE_METH(unload); + wxLogTrace(wxTRACE_AutoPerl, _T("name = '%s' package = '%s'"), name.c_str(), package.c_str()); // Deinstantiate(?) all features and clear the vector for(; !features.empty(); features.pop_back()) { @@ -150,14 +148,18 @@ namespace Automation4 { hv_undef((HV*)gv_stashpv(package.mb_str(wx2pl), 0)); // Officially finished with unloading + wxLogDebug(_T("'%s' (%s) unloaded"), name.c_str(), package.c_str()); loaded = false; + wxTRACE_RET(unload); } void PerlScript::activate(PerlScript *script) { - wxLogTrace(_T("Activating %*s(%s)"), 0, script->GetName(), script->GetPackage().c_str()); + 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); @@ -165,14 +167,13 @@ namespace Automation4 { wxDateTime mod; fn.GetTimes(NULL,&mod,NULL); if(script->mtime != mod.GetTicks()) { - printf("%d != %d !\n", script->mtime, mod.GetTicks()); - wxLogVerbose(_("Reloading %s because the file on disk (%s) changed"), script->GetName().c_str(), script->GetFilename().c_str()); + 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(_T("Hooking $SIG{__WARN__}"), 0); + wxLogTrace(wxTRACE_AutoPerl, _T("$SIG{__WARN__} = \\&Aegisub::warn")); eval_pv("$SIG{__WARN__} = \\&Aegisub::warn", 1); // Add the script's includes to @INC @@ -186,27 +187,34 @@ namespace Automation4 { // Make room in @INC I32 inc_count = script->include_path.GetCount(); av_unshift(inc_av, inc_count); - // Add the include paths + // Add the automation include paths for(I32 i = 0; i < inc_count; i++) { - wxLogDebug(_T("Adding %d to @INC"), script->include_path.Item(i).c_str()); + wxLogTrace(wxTRACE_AutoPerl, _T("$INC[%d] = '%s'"), i, script->include_path.Item(i).c_str()); AV_TOUCH(inc_av, i) AV_STORE(newSVpv(script->include_path.Item(i).mb_str(wx2pl), 0)); } - wxLogTrace(_T("@INC = ( %*s )"), 0, SvPV_nolen(eval_pv("\"@INC\"", 1))); + wxLogDebug(_T("@INC = ( %s )"), wxString(SvPV_nolen(eval_pv("\"@INC\"", 1)), pl2wx).c_str()); } else { - wxLogWarning(_("Unable to add the automation include path(s) to @INC, you may have problems running the script.")); + 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(); + active = script; - wxLogDebug(_T("%s(%p) activated"), active->GetName().c_str(), active); + wxLogDebug(_T("'%s' (%p) activated"), active->GetName().c_str(), active); } void PerlScript::deactivate() { - wxLogTrace(_T("Deactivating %*s (%s)"), 0, active->GetName().c_str(), active->GetPackage().c_str()); + wxTRACE_FUNC(PerlScript::deactivate); + wxLogTrace(wxTRACE_AutoPerl, _T("name = '%s', package = '%s'"), active->GetName().c_str(), active->GetPackage().c_str()); // Revert @INC to its value before the script activation AV *inc_av = get_av("main::INC", 0); @@ -217,7 +225,7 @@ namespace Automation4 { if(av_len(active->inc_saved) >= 0) { // If there's a saved one AV_COPY(active->inc_saved, inc_av); - wxLogTrace(_T("@INC = ( %*s )"), 0, SvPV_nolen(eval_pv("\"@INC\"", 1))); + wxLogDebug(_T("@INC = ( %s )"), wxString(SvPV_nolen(eval_pv("\"@INC\"", 1)), pl2wx).c_str()); av_clear(active->inc_saved); } } @@ -225,8 +233,8 @@ namespace Automation4 { // Read the values of script vars active->ReadVars(); - // Unooking $SIG{__WARN__} - wxLogTrace(_T("Releasing $SIG{__WARN__} hook"), 0); + // Unhooking $SIG{__WARN__} + wxLogTrace(wxTRACE_AutoPerl, _T("undef $SIG{__WARN__}")); eval_pv("undef $SIG{__WARN__}", 1); wxLogDebug(_T("%s(%p) deactivated"), active->GetName().c_str(), active); @@ -235,22 +243,25 @@ namespace Automation4 { void PerlScript::AddFeature(Feature *feature) { + wxTRACE_METH(AddFeature); features.push_back(feature); - wxLogDebug(_T("Added %s to %s(%s)'s features"), feature->GetName(), name, package); + wxLogDebug(_T("Added '%s' to '%s'(%s)'s features"), feature->GetName().c_str(), name.c_str(), package.c_str()); } void PerlScript::DeleteFeature(Feature *feature) { + wxTRACE_METH(DeleteFeature); for(std::vector::iterator it = features.begin(); it != features.end(); it++) if(*it == feature) { delete feature; - wxLogDebug(_T("Deleted %s from %s(%s)'s features"), feature->GetName(), name, package); + wxLogDebug(_T("Deleted '%s' from '%s'(%s)'s features"), feature->GetName().c_str(), name.c_str(), package.c_str()); features.erase(it); } } void PerlScript::ReadVars() { + wxTRACE_METH(ReadVars); // This will get anything inside it °_° SV *whore = NULL; // All the vars' names will stick to it #_# @@ -279,6 +290,7 @@ namespace Automation4 { void PerlScript::WriteVars() const { + wxTRACE_METH(WriteVars); // Somewhat as above SV *whore = NULL; wxString bitch; @@ -312,52 +324,144 @@ namespace Automation4 { sv_setpv(whore, version.mb_str(wx2pl)); } - XS(set_info) + +////////////////////// +// PerlFeatureMacro +// + + PerlFeatureMacro::PerlFeatureMacro(const wxString &name, const wxString &description, PerlScript *own_script, SV *proc_sub, SV *val_sub): + Feature(SCRIPTFEATURE_MACRO, name), + FeatureMacro(name, description) { - dXSARGS; - PerlScript *active = PerlScript::GetActive(); - if(active) { - // Update the object's vars - active->ReadVars(); + // We know what script we belong to ^_^ + script = own_script; - // Set script info vars - switch (items) { - case 4: - active->SetVersion(wxString(SvPV_nolen(ST(3)), pl2wx)); - case 3: - active->SetAuthor(wxString(SvPV_nolen(ST(2)), pl2wx)); - case 2: - active->SetDescription(wxString(SvPV_nolen(ST(1)), pl2wx)); - case 1: - active->SetName(wxString(SvPV_nolen(ST(0)), pl2wx)); - } - - // Update the package's vars - active->WriteVars(); - } + // And not surprisingly we have some callbacks too + processing_sub = newSVsv(proc_sub); + validation_sub = newSVsv(val_sub); } - XS(register_macro) - { - dXSARGS; - PerlScript *active = PerlScript::GetActive(); - if(active && items >= 3) { - wxString name, description; - SV *proc_sub = NULL, *val_sub = NULL; - switch (items) { - case 4: - val_sub = sv_mortalcopy(ST(3)); - case 3: - proc_sub = sv_mortalcopy(ST(2)); - description = wxString(SvPV_nolen(ST(1)), pl2wx); - name = wxString(SvPV_nolen(ST(0)), pl2wx); - } - if(proc_sub) { - active->AddFeature(new PerlFeatureMacro(name, description, active, proc_sub, val_sub)); - XSRETURN_YES; - } + PerlFeatureMacro::~PerlFeatureMacro() { + // The macro subroutines get undefined + CV *cv = Nullcv; + HV *hv = NULL; + GV *gv = NULL; + if(processing_sub) { + cv = sv_2cv(processing_sub, &hv, &gv, 1); + cv_undef(cv); + if(hv) hv_undef(hv); } - XSRETURN_UNDEF; + if(validation_sub) { + cv = sv_2cv(validation_sub, &hv, &gv, 1); + cv_undef(cv); + if(hv) hv_undef(hv); + } + }; + + bool PerlFeatureMacro::Validate(AssFile *subs, const std::vector &selected, int active) + { + // If there's no validation subroutine defined simply return true + if(!validation_sub) return true; + // otherwise... + + // Sub lines + AV *lines = PerlAss::MakeHasshLines(NULL, subs); + // Selection array + AV *selected_av = newAV(); + VECTOR_AV(selected, selected_av, int, iv); + + // Activate the owner script + script->Activate(); + + bool ret = false; + int c = 0; + + // Prepare the stack + dSP; + + ENTER; + SAVETMPS; + + // Push the parameters on the stack + PUSHMARK(SP); + XPUSHs(sv_2mortal(newRV_noinc((SV*)lines))); + XPUSHs(sv_2mortal(newRV_noinc((SV*)selected_av))); + XPUSHs(sv_2mortal(newSViv(active))); + PUTBACK; + + // Call back the callback + c = call_sv(validation_sub, G_EVAL | G_SCALAR); + SPAGAIN; + + if(SvTRUE(ERRSV)) { + wxLogVerbose(wxString(SvPV_nolen(ERRSV), pl2wx)); + ret = false; + } + else { + SV *wtf = sv_mortalcopy(POPs); + ret = SvTRUE(wtf); + } + + // Tidy up everything + PUTBACK; + FREETMPS; + LEAVE; + + // Deactivate the script + script->Deactivate(); + + return ret; + } + + void PerlFeatureMacro::Process(AssFile *subs, std::vector &selected, int active, wxWindow * const progress_parent) + { + // Convert the AssFile::Line to perl stuff + AV *lines = PerlAss::MakeHasshLines(NULL, subs); + // Same with the selection array + 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 + PUSHMARK(SP); + XPUSHs(sv_2mortal(newRV_noinc((SV*)lines))); + XPUSHs(sv_2mortal(newRV_noinc((SV*)selected_av))); + XPUSHs(sv_2mortal(newSViv(active))); + PUTBACK; + + // Create a progress window + PerlProgressSink *ps = new PerlProgressSink(progress_parent, GetName()); + // Start the callback thread + PerlThread call(processing_sub, G_EVAL | G_VOID); + // Show the progress window + ps->ShowModal(); + // And wait unitl it's dismessed + delete ps; + // Now wait the thread to return + call.Wait(); + + if(!SvTRUE(ERRSV)) { + // Non-error: recreate the hassh :S + subs->FlagAsModified(GetName()); + PerlAss::MakeAssLines(subs, lines); + // And reset selection vector + selected.clear(); + AV_VECTOR(selected_av, selected, IV); + CHOP_SELECTED(subs, selected); + } + + // Clean everything + FREETMPS; + LEAVE; + + script->Deactivate(); } diff --git a/automation/include/Aegisub.pm b/automation/include/Aegisub.pm index 74e461b41..4eb97205f 100644 --- a/automation/include/Aegisub.pm +++ b/automation/include/Aegisub.pm @@ -1,7 +1,41 @@ package Aegisub; use Exporter 'import'; -@EXPORT = qw( text_extents ); -@EXPORT_OK = qw( warn ); +@EXPORT = qw( text_extents + log_fatal log_error log_warning log_hint log_debug log_trace log_message ); +@EXPORT_OK = qw( LOG_FATAL LOG_ERROR LOG_WARNING LOG_HINT LOG_DEBUG LOG_TRACE LOG_MESSAGE + LOG_WX + log warn ); + +# Constants +sub LOG_FATAL { 0 } +sub LOG_ERROR { 1 } +sub LOG_WARNING { 2 } +sub LOG_HINT { 3 } +sub LOG_DEBUG { 4 } +sub LOG_TRACE { 5 } +sub LOG_MESSAGE { 6 } + +sub LOG_WX { 8 } + +# Shortcut functions +sub log_fatal { Aegisub::log LOG_FATAL, @_; } +sub log_error { Aegisub::log LOG_ERROR, @_; } +sub log_warning { Aegisub::log LOG_WARNING, @_; } +sub log_hint { Aegisub::log LOG_HINT, @_; } +sub log_debug { Aegisub::log LOG_DEBUG, @_; } +sub log_trace { Aegisub::log LOG_TRACE, @_; } +sub log_message { Aegisub::log LOG_MESSAGE, @_; } + +# wxLog variety +sub wxlog { + if($_[0] =~ /^\d+$/) { + $_[0] |= 0x8; + } + else { + unshift @_, LOG_MESSAGE | LOG_WX; + } + Aegisub::log @_; +} 1; diff --git a/automation/include/Aegisub/Progress.pm b/automation/include/Aegisub/Progress.pm new file mode 100644 index 000000000..e99482c80 --- /dev/null +++ b/automation/include/Aegisub/Progress.pm @@ -0,0 +1,11 @@ +package Aegisub::Progress; +use Exporter 'import'; + +@EXPORT = qw( set_progress set_task set_title is_cancelled ); +@EXPORT_OK = qw( set task title ); + +sub set { set_progress @_ } +sub task { set_task @_ } +sub title { set_title @_ } + +1; diff --git a/automation/v4-docs/perl-api.txt b/automation/v4-docs/perl-api.txt index 8326f98ee..53e46a13d 100644 --- a/automation/v4-docs/perl-api.txt +++ b/automation/v4-docs/perl-api.txt @@ -2,18 +2,35 @@ Quick reference on Perl engine's API ------------------------------------ -Every symbol contained in this reference is automatically made visible to the -executing script. They are not however imported in the script's package, so -they must be referenced with their full name. (A mechanism to import them -through the canonical perl commands `use' and `import' will be deployed sooner -or later.) +All the packages that form the perl interface to Aegisub are automatically +loaded, however none of their symbols are exported initially. If you want to +import them you can use the usual 'use' mechanism; if you call it without a +list of imports it will import more or less everything (exceptions to this are +explicitely signaled in the docs) in your script's package. ==================================== package Aegisub +------------------------------------ +Constants defined: + <--EXPORTABLE--> + +LOG_FATAL == 0 +LOG_ERROR == 1 +LOG_WARNING == 2 +LOG_HINT == 3 +LOG_DEBUG == 4 +LOG_TRACE == 5 +LOG_MESSAGE == 6 + Log levels, to be used with the 'log' function. + +LOG_WX == 8 + Flag to force logging through wxWidgets facilites. + ------------------------------------ Subroutines defined: + <--EXPORTED--> text_extents STYLE, TEXT Computes the metric for a string of text, based on a specific style. @@ -22,16 +39,55 @@ text_extents STYLE, TEXT TEXT Text for which to compute the metrics. Returns: WIDTH The width of the text (if called in scalar context, only this is returned). - ASCENT The ascent, i.e. the distance from the baseline to the top. + ASCENT The ascent, i.e. the distance from the baseline to the top of the letters. DESCENT Descent, i.e. the distance from the baseline to the bottom. EXTLEADING External leading, i.e. the distance between to lines of text. +log_fatal LIST + ... +log_message LIST + These are shortcut for 'log(LOG_FATAL, LIST)' through 'log(LOG_MESSAGE, + LIST)' (see below). + + <--EXPORTABLE--> + +log LEVEL, LIST +log LIST + Prints a log message inside the progress window, if LEVEL is less or equal + to the tracelevel set inside automation options. If called from outside a + callback (i.e. during script loading) prints through the wxWidgets logging + mechanism. 'log(LIST)' is equal to 'log(LOG_MESSAGE, LIST)'. The short form + is used whenever there are at least two arguments and the first one cannot + be converted to an integer; it is always used when given only one argument. + This is not exported by default (review man perlfunc to understand why :). + Arguments: + LEVEL The debug level, may be one of the following (the descriptions are + indicative): + 0 Fatal error, for vital error; + 1 Error, for serious but not too much threatening errors; + 2 Warning, for something that's apparently going wrong; + 3 Hint, for indicating somthing peculiar is happening; + 4 Debug, for debugging; + 5 Trace, for really verbose debugging; + 6 Message, always printed. + If you OR one of these values with the flag LOG_WX the log message will + be delivered though wxWidgets regardless of wether there is a progress + window displayed (you won't normally need this feature, though). + LIST List of arguments to print. + warn LIST - Prints a warning through the GUI log facilities. It is automatically hooked - to the global `warn' function during script execution. + Prints a warning through the GUI log facilities (it is equivalent to + 'log(LOG_WARNING, LIST)'). It is automatically hooked to the global 'warn' + function during script execution, but it is not exported by default. Arguments: LIST List of arguments to print. + <--NOT EXPORTABLE--> + +wxlog LEVEL, LIST +wxlog LIST + Similar to 'log', with LOG_WX flag implicitely set. + ==================================== package Aegisub::PerlConsole @@ -41,10 +97,11 @@ use by normal users. They are shown here for completeness. ------------------------------------ Subroutines defined: + <--EXPORTED--> echo LIST Prints a list of arguments on the console, or on STDOUT if no console is - registered, a trailing \n is printed too + registered, a trailing \n is printed too. Arguments: LIST List of arguments to print. @@ -56,24 +113,82 @@ register_console NAME, DESC DESC Set the macro's description. (optional) +==================================== +package Aegisub::Progress +------------------------------------ + +This package provides an interface to the progress window automatically showed +during the execution of a feature. Its functions are somewhat different to +those available in lua because of clarity, however aliases are given. You can +see this in the following list: wherever a function has two names the first is +the 'official' one and is automatically exported with 'use Aegisub::Progress', +while if you want to use the second one you'll have to explicitely import them. + +------------------------------------ +Subroutines defined: + <--EXPORTED--> + +set_progress VALUE + Sets the value of the progress bar. It accepts values comprised in [0, 1] + OR (1, 100] (for instance, a value of 0.86 is equivalent to a value of 86: + they both represent '86%'). You should really always use values in the + range [0, 1] if you don't wanna be mocked by your friends and relatives + (and normally they're more immediately computable). + Arguments: + VALUE The value for the progress bar. + +set_task DESC + Sets the description for the current task inside progress window (just + below the progress bar). + Arguments: + DESC The description for the current task. + +set_title TITLE + Sets the title for the progress window (which is not actually the window's + title, but a flashier label below it). The default title is 'Executing ...' + (with the ellpsis possibly replaced by the feature's name). + Arguments: + TITLE The title to set. + +is_cancelled + Returns: A boolean indicating wether the cancel button on the progress + windw where pressed in the near past. + + <--EXPORTABLE--> + +set VALUE + Synonym for 'set_progress(VALUE)'. + +task DESC + Synonym for 'set_desc(DESC)', + +title TITLE + Synonym for 'set_title(TITLE)'. + + ==================================== package Aegisub::Script ------------------------------------ Subroutines defined: + <--EXPORTED--> register_macro NAME, DESC, PROC_SUB, VAL_SUB Register a new macro. Arguments: NAME The name of the macro. - DESC A dascription for the macro. + DESC A description for the macro. PROC_SUB A ref to a subroutine to be used as the macro processing function - (see the callbacks section). - VAL_SUB A ref to a subrotine to be used as the macro validation function + (see the callbacks section). Please, really use a reference and not + just the name of the sub, because of the script 'pacakging' described + below. + VAL_SUB A ref to a subroutine to be used as the macro validation function (see callbacks)(optional, if not defined will be considered as always true). set_info NAME, DESC, AUTHOR, VERSION - You can set all of the script's info values with a call to this function + You can set all of the script's info values with a call to this + function. (Otherwise you can set the corresponding predefined script + variables individually.) Arguments: see the parts about script variables, anything is optional. @@ -81,13 +196,13 @@ set_info NAME, DESC, AUTHOR, VERSION package Aegisub::Script::pxxxxxxxx ------------------------------------ Every script that's loaded gets its code evaluated inside a different package - -whose name is chosen at 'random', whereas the perl interpreter is unique, so -they all see the same global package, and can possibly access other -scripts'. Therefore is recommended to ALWAYS declare all of the script's local -variables with `my', if they have to reside outside any function body, and of -course to `use strict' to check on this. You can still define another package -for your script, the script's predefined variables will still be visible -[maybe?] from it, but this is discouraged. +whose name is chosen at 'random' - whereas the perl interpreter is unique, so +all the scripts see the same global package, and can possibly access other +scripts' packages. Therefore is recommended to ALWAYS declare all of the +script's local variables with 'my', and of course to 'use strict' to check on +this. You can still declare another package for your script; the script's +predefined variables should be still visible from it without any change in the +code (they're declared as 'our'), however this is discouraged. ------------------------------------ Variables defined: @@ -102,41 +217,56 @@ $script_name Holds the script's name. Default is the script's filename. $script_version - Holds the script's version. Default is current aegisub's version. + Holds the script's version. Default is current aegisub version. $_script_path - The full path to the script's file. Any change to this variable is ignored. + The full path to the script's file. Any change to this variable is ignored + and overwritten. $_script_package The full script package as a string. Any change to this variable is - currently ignored + currently ignored and overwritten, and may be so forever. $_script_reload [BROKEN] - When this is set to true. The script will automatically be reload before - any execution if its file changed on disk. Useful during the development. + When this is set to true, the script will automatically be reloaded before + any execution if its file changed on disk. (However, at present time, it is + just a shortcut to make aegisub crash.) ------------------------------------ Callbacks definable: macro_processing_function LINES, SELECTED, ACTIVE A function to be used as a callback for Aegisub::Script::register_macro(). - The first two arguments can be modified, and the modification will be - reflected in the subtitles file + This function will be called when the user selects the corresponding macro + in the Automation menu. The first two arguments can be modified, and the + modifications will be reflected in the subtitles file. Arguments: LINES A reference to the list containing the subtitle file lines. - Each element of the list is actually a hash with the name of the fields - as keys. See the Lua documentation; this is basically the same structure. - EXAMPLE: - my $l = $lines->[$linenumber]; # an entire line - my $text = $lines->[$linenumber]->{"text"} # the text field of a dialogue line - SELECTED A ref to an array of ints, showing the currently selected lines in - the file - ACTIVE Index of the currently active line in the subtitle file (sic) + Each element of the list is a reference to a hash that represents a + single subtitle line. For the hash keys refer to lua documentation, + they are basically the same. + Example: + + my $lines = $_[0]; # DON'T shift @_ (unless you reconstruct it + # afterwards) or you'll break everything and + # your hard disk be erased >:) + # The first selected line's index + my $first = $_[1][0]; + # An entire line + my $l = $lines->[$first]; + # The text field of a dialogue line + my $text = $lines->[$first]->{"text"}; + + SELECTED A ref to an array of ints, showing the currently selected + lines in the file. + ACTIVE Index of the currently active line in the subtitle file (sic). macro_validation_function LINES, SELECTED, ACTIVE A function to be used as a callback for Aegisub::Script::register_macro(). + This function will be called whenever the Automation menu is opened to + decide what macros are applyable to the current script. Arguments: same as macro_processing_function; however any change to the first two ones will be ignored upon function return. Returns: VALID A 'bolean' value to indicate if the macro is applicable to this - particualar subtitles file. + particular subtitles file. diff --git a/configure.ac b/configure.ac index 4339576a2..56bf8a8eb 100644 --- a/configure.ac +++ b/configure.ac @@ -73,6 +73,21 @@ fi AC_CHECK_LIB([hunspell], [main],, [with_hunspell=no]) AC_CHECK_LIB([ruby1.9], [ruby_init],, [with_ruby=no]) +dnl Perl engine +AC_ARG_ENABLE([auto4-perl], + [AS_HELP_STRING([--enable-auto4-perl],[enable automation4 perl engine (under development)@<:@default=no@:>@])],, + [enable_auto4_perl=no]) +if test "$enable_auto4_perl" != "no"; then + echo -n 'checking for perl version >= 5.004... ' + if perl -e 'require 5.004'; then + enable_auto4_perl=yes + echo 'yes' + else + enable_auto4_perl=no + fi +fi + + AC_CHECK_HEADER([wchar.h],,[ AC_MSG_XFAILURE([aegisub needs wide character support, find a wchar.h]) ]) @@ -208,6 +223,7 @@ AM_CONDITIONAL([HAVE_FFMPEG], [test "$with_ffmpeg" != "no"]) dnl FIXME: These three should probably get proper --with flags, dnl and Ruby also keep its detection (warn/fail if you have --with-ruby dnl but the lib isn't detected.) +AM_CONDITIONAL([WITH_AUTO4_PERL], [test "$enable_auto4_perl" != "no"]) AM_CONDITIONAL([WITH_AUTO4_RUBY], [test "$with_ruby" != "no"]) AM_CONDITIONAL([WITH_AUTO4_LUA], [true]) dnl TODO: Make the auto3 lib build on non-Win32 so this can be true