mirror of https://github.com/odrling/Aegisub
New and reorganized perl sources. Autotools patched accordingly. Win build must be fixed.
Originally committed to SVN as r1827.
This commit is contained in:
parent
260c2b5cb2
commit
b2518f9ca1
|
@ -47,6 +47,11 @@ if WITH_AUTO4_RUBY
|
||||||
AUTOMATION += auto4_ruby_assfile.cpp auto4_ruby.cpp auto4_ruby_dialog.cpp
|
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)
|
AM_CPPFLAGS += $(shell ruby -r rbconfig -e "p '-I' + Config::CONFIG['rubylibdir'] + '/' + Config::CONFIG['arch'] ") $(AM_CPPFLAGST)
|
||||||
endif
|
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
|
if HAVE_HUNSPELL
|
||||||
HUNSPELL=spellchecker_hunspell.cpp
|
HUNSPELL=spellchecker_hunspell.cpp
|
||||||
|
|
|
@ -38,6 +38,16 @@
|
||||||
|
|
||||||
|
|
||||||
#include "auto4_perl.h"
|
#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 {
|
namespace Automation4 {
|
||||||
|
@ -46,9 +56,264 @@ namespace Automation4 {
|
||||||
///////////////////////////////////
|
///////////////////////////////////
|
||||||
// Perl -> C++ interface (XSUBS)
|
// 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);
|
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
|
||||||
|
|
||||||
// Copypasted from somewhere
|
/* XS registration */
|
||||||
EXTERN_C void xs_perl_main(pTHX)
|
EXTERN_C void xs_perl_main(pTHX)
|
||||||
{
|
{
|
||||||
dXSUB_SYS;
|
dXSUB_SYS;
|
||||||
|
@ -57,9 +322,172 @@ namespace Automation4 {
|
||||||
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
|
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__);
|
||||||
|
|
||||||
// My XSUBS ^^
|
// My XSUBS ^^
|
||||||
xs_perl_script(aTHX);
|
newXS("Aegisub::log", perl_log, __FILE__);
|
||||||
xs_perl_misc(aTHX);
|
newXS("Aegisub::warn", perl_warning, __FILE__);
|
||||||
xs_perl_console(aTHX);
|
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:
|
public:
|
||||||
PerlScriptFactory()
|
PerlScriptFactory()
|
||||||
{
|
{
|
||||||
|
#ifdef WXTRACE_AUTOPERL
|
||||||
|
// Add tracing of perl engine operations
|
||||||
|
wxLog::AddTraceMask(wxTRACE_AutoPerl);
|
||||||
|
#endif
|
||||||
|
|
||||||
// Script engine properties
|
// Script engine properties
|
||||||
loaded = false;
|
loaded = false;
|
||||||
engine_name = _T("Perl");
|
engine_name = _T("Perl");
|
||||||
|
@ -88,13 +521,11 @@ namespace Automation4 {
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
// Perl interpreter initialization (ONE FOR ALL THE SCRIPTS)
|
// Perl interpreter initialization (ONE FOR ALL THE SCRIPTS)
|
||||||
char** env = NULL;
|
|
||||||
int argc = 3;
|
int argc = 3;
|
||||||
char *argv[3] = { "aegisub", "-e", "0" };
|
char *argv[3] = { "aegisub", "-e", "0" };
|
||||||
#ifdef __VISUALC__
|
char** env = NULL;
|
||||||
char **argv2 = (char**) argv;
|
char **argv2 = (char**) argv; // VC++ wants this °_°
|
||||||
PERL_SYS_INIT3(&argc,&argv2,&env);
|
PERL_SYS_INIT3(&argc,&argv2,&env);
|
||||||
#endif
|
|
||||||
parser = perl_alloc();
|
parser = perl_alloc();
|
||||||
perl_construct(parser);
|
perl_construct(parser);
|
||||||
perl_parse(parser, xs_perl_main,
|
perl_parse(parser, xs_perl_main,
|
||||||
|
@ -114,9 +545,7 @@ namespace Automation4 {
|
||||||
if (loaded) {
|
if (loaded) {
|
||||||
perl_destruct(parser);
|
perl_destruct(parser);
|
||||||
perl_free(parser);
|
perl_free(parser);
|
||||||
#ifdef __VISUALC__
|
|
||||||
PERL_SYS_TERM();
|
PERL_SYS_TERM();
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -33,6 +33,7 @@
|
||||||
// Contact: mailto:jiifurusu@gmail.com
|
// Contact: mailto:jiifurusu@gmail.com
|
||||||
//
|
//
|
||||||
|
|
||||||
|
|
||||||
#pragma once
|
#pragma once
|
||||||
#ifndef _AUTO4_PERL_H
|
#ifndef _AUTO4_PERL_H
|
||||||
#define _AUTO4_PERL_H
|
#define _AUTO4_PERL_H
|
||||||
|
@ -43,17 +44,16 @@
|
||||||
#include <wx/string.h>
|
#include <wx/string.h>
|
||||||
|
|
||||||
#include "ass_file.h"
|
#include "ass_file.h"
|
||||||
//#include "ass_dialogue.h"
|
|
||||||
|
|
||||||
#undef _
|
#undef _
|
||||||
#include <EXTERN.h>
|
#include <EXTERN.h>
|
||||||
#include <perl.h>
|
#include <perl.h>
|
||||||
#include <XSUB.h>
|
#include <XSUB.h>
|
||||||
|
|
||||||
#include "auto4_perldata.inc" // Parl variables manipulation macros
|
#include "auto4_perldata.inc" // Perl variables manipulation macros
|
||||||
#undef bool
|
#undef bool
|
||||||
|
|
||||||
// the fucking perl.h redefines _() -.- please disregard warnings during compilation
|
// the fucking perl.h redefines _() -.-
|
||||||
#undef _
|
#undef _
|
||||||
#define _(s) wxGetTranslation(_T(s))
|
#define _(s) wxGetTranslation(_T(s))
|
||||||
|
|
||||||
|
@ -66,20 +66,82 @@
|
||||||
#define PERL_SCRIPT_EXTENSION ".pl" /* TODO maybe: make it multi-extension */
|
#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 {
|
namespace Automation4 {
|
||||||
|
|
||||||
///////////
|
|
||||||
// XSUBS
|
/////////////
|
||||||
|
// PerlLog
|
||||||
//
|
//
|
||||||
void xs_perl_script(pTHX);
|
#define LOG_FATAL 0
|
||||||
void xs_perl_misc(pTHX);
|
#define LOG_ERROR 1
|
||||||
void xs_perl_console(pTHX);
|
#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
|
// Script object
|
||||||
//
|
//
|
||||||
class PerlFeatureMacro;
|
|
||||||
class PerlScript : public Script {
|
class PerlScript : public Script {
|
||||||
private:
|
private:
|
||||||
static PerlScript *active; // The active script (at any given time)
|
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 load(); // It doas all the script initialization
|
||||||
void unload(); // It does all the script disposing
|
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
|
static void deactivate(); // Unset the active script
|
||||||
|
|
||||||
public:
|
public:
|
||||||
PerlScript(const wxString &filename);
|
PerlScript(const wxString &filename);
|
||||||
virtual ~PerlScript();
|
virtual ~PerlScript();
|
||||||
|
static PerlScript *GetScript() { return active; } // Query the value of the active script
|
||||||
|
|
||||||
virtual void Reload(); // Reloading of a loaded script
|
virtual void Reload(); // Reloading of a loaded script
|
||||||
|
|
||||||
void Activate() { activate(this); } // Set the script as active
|
void Activate() { activate(this); } // Set the script as active
|
||||||
void Deactivate() const { deactivate(); } // Unset the active script
|
void Deactivate() const { deactivate(); } // Unset the active script
|
||||||
|
|
||||||
const wxString& GetPackage() const { return package; } // The perl package containing script code
|
/* TODO maybe: move to tied scalars */
|
||||||
static PerlScript *GetScript() { return active; } // Query the value of the active script
|
|
||||||
|
|
||||||
/* TODO maybe: change these into tying of scalars */
|
|
||||||
void ReadVars(); // Sync the script's vars from perl package to script object
|
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
|
void WriteVars() const; // Sync the script's vars from script object to perl package
|
||||||
|
|
||||||
/* TODO: add c++ equivalents */
|
|
||||||
void AddFeature(Feature *feature);
|
void AddFeature(Feature *feature);
|
||||||
void DeleteFeature(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 SetName(const wxString &str) { name = str; }
|
||||||
void SetDescription(const wxString &str) { description = str; }
|
void SetDescription(const wxString &str) { description = str; }
|
||||||
void SetAuthor(const wxString &str) { author = str; }
|
void SetAuthor(const wxString &str) { author = str; }
|
||||||
void SetVersion(const wxString &str) { version = 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
|
// 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
|
// 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()
|
|
||||||
|
|
||||||
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -75,24 +75,24 @@ namespace Automation4 {
|
||||||
|
|
||||||
wxString PerlAss::GetEntryClass(AssEntry *entry)
|
wxString PerlAss::GetEntryClass(AssEntry *entry)
|
||||||
{
|
{
|
||||||
wxString data = entry->GetEntryData();
|
switch(entry->GetType()) {
|
||||||
|
case ENTRY_DIALOGUE: return _T("dialogue");
|
||||||
if(entry->GetType() == ENTRY_DIALOGUE) return _T("dialogue");
|
case ENTRY_STYLE:
|
||||||
|
|
||||||
if(entry->GetType() == ENTRY_STYLE) {
|
|
||||||
return _T("style");
|
return _T("style");
|
||||||
/* TODO: add stylex recognition */
|
/* TODO: add stylex recognition */
|
||||||
}
|
break;
|
||||||
|
case ENTRY_ATTACHMENT: return _T("attachment");
|
||||||
if(entry->GetType() == ENTRY_BASE) {
|
default:
|
||||||
|
case ENTRY_BASE:
|
||||||
|
wxString data(entry->GetEntryData());
|
||||||
if(entry->group == _T("[Script Info]") && data.Matches(_T("*:*"))) return _T("info");
|
if(entry->group == _T("[Script Info]") && data.Matches(_T("*:*"))) return _T("info");
|
||||||
|
|
||||||
if(data == entry->group) return _T("head");
|
if(data == entry->group) return _T("head");
|
||||||
|
|
||||||
if(data.StartsWith(_T("Format:"))) return _T("format");
|
if(data.StartsWith(_T("Format:"))) return _T("format");
|
||||||
|
|
||||||
if(data.IsEmpty()) return _T("clear");
|
if(data.IsEmpty()) return _T("clear");
|
||||||
|
|
||||||
if(data.Trim(left).StartsWith(_T(";"))) return _T("comment");
|
if(data.Trim(left).StartsWith(_T(";"))) return _T("comment");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -103,13 +103,15 @@ namespace Automation4 {
|
||||||
|
|
||||||
HV *PerlAss::MakeHasshEntry(AssEntry *e)
|
HV *PerlAss::MakeHasshEntry(AssEntry *e)
|
||||||
{
|
{
|
||||||
switch((int)e->GetType()) {
|
switch(e->GetType()) {
|
||||||
case ENTRY_DIALOGUE:
|
case ENTRY_DIALOGUE:
|
||||||
return MakeHasshDialogue(AssEntry::GetAsDialogue(e));
|
return MakeHasshDialogue(AssEntry::GetAsDialogue(e));
|
||||||
|
|
||||||
case ENTRY_STYLE:
|
case ENTRY_STYLE:
|
||||||
return MakeHasshStyle(AssEntry::GetAsStyle(e));
|
return MakeHasshStyle(AssEntry::GetAsStyle(e));
|
||||||
|
|
||||||
|
case ENTRY_ATTACHMENT:
|
||||||
|
|
||||||
default:
|
default:
|
||||||
case ENTRY_BASE:
|
case ENTRY_BASE:
|
||||||
dHV;
|
dHV;
|
||||||
|
@ -296,12 +298,16 @@ namespace Automation4 {
|
||||||
// It seems to be a style, let's call the specialized function
|
// It seems to be a style, let's call the specialized function
|
||||||
return MakeAssStyle(entry);
|
return MakeAssStyle(entry);
|
||||||
}
|
}
|
||||||
|
else if(cl == _T("attachment")) {
|
||||||
|
/* TODO */
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
else {
|
else {
|
||||||
|
// A base entry
|
||||||
AssEntry *e = new AssEntry();
|
AssEntry *e = new AssEntry();
|
||||||
|
|
||||||
ASS_BASIC_INIT(entry, e);
|
ASS_BASIC_INIT(entry, e);
|
||||||
|
|
||||||
// A base entry
|
|
||||||
if(cl == _T("info")) {
|
if(cl == _T("info")) {
|
||||||
wxString key, value;
|
wxString key, value;
|
||||||
HV_FETCH(entry, "key", 3) {
|
HV_FETCH(entry, "key", 3) {
|
||||||
|
|
|
@ -47,13 +47,6 @@
|
||||||
namespace Automation4 {
|
namespace Automation4 {
|
||||||
|
|
||||||
|
|
||||||
void xs_perl_console(pTHX)
|
|
||||||
{
|
|
||||||
newXS("Aegisub::PerlConsole::echo", echo, __FILE__);
|
|
||||||
newXS("Aegisub::PerlConsole::register_console", register_console, __FILE__);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
////////////////////////////////////
|
////////////////////////////////////
|
||||||
// PerlConsole::Dialog
|
// 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
|
// PerlConsole
|
||||||
|
@ -134,8 +121,10 @@ namespace Automation4 {
|
||||||
parent_window = NULL;
|
parent_window = NULL;
|
||||||
dialog = new Dialog();
|
dialog = new Dialog();
|
||||||
|
|
||||||
// Fuck off any previously registered console °_°
|
// Remove any previously registered console °_°
|
||||||
if(registered) delete registered;
|
if(registered) {
|
||||||
|
registered->script->DeleteFeature(registered);
|
||||||
|
}
|
||||||
registered = this;
|
registered = this;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -146,7 +135,7 @@ namespace Automation4 {
|
||||||
/* TODO: Free something? */
|
/* TODO: Free something? */
|
||||||
|
|
||||||
// Delete the registered console
|
// Delete the registered console
|
||||||
PerlConsole::registered = NULL;
|
registered = NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
void PerlConsole::Process(AssFile *subs, std::vector<int> &selected, int active, wxWindow * const progress_parent)
|
void PerlConsole::Process(AssFile *subs, std::vector<int> &selected, int active, wxWindow * const progress_parent)
|
||||||
|
@ -197,6 +186,9 @@ namespace Automation4 {
|
||||||
code << str;
|
code << str;
|
||||||
// Evaluate the code
|
// Evaluate the code
|
||||||
SV *e = eval_pv(code.mb_str(wx2pl), 0);
|
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 */
|
/* TODO: check for errors */
|
||||||
script->ReadVars();
|
script->ReadVars();
|
||||||
|
|
||||||
|
@ -220,52 +212,28 @@ namespace Automation4 {
|
||||||
return wxString(SvPV_nolen(e), pl2wx);
|
return wxString(SvPV_nolen(e), pl2wx);
|
||||||
}
|
}
|
||||||
|
|
||||||
XS(register_console)
|
wxString PerlConsole::Evaluate(const wxString &str)
|
||||||
{
|
{
|
||||||
dXSARGS;
|
if(registered) {
|
||||||
PerlScript *script = PerlScript::GetScript();
|
return registered->evaluate(str);
|
||||||
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);
|
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
// Otherwise print on stdout
|
/* TODO: print error */
|
||||||
PerlIO_printf(PerlIO_stdout(), "%s\n", buffer.mb_str(wxConvLocal).data());
|
return _T("");
|
||||||
// (through perl io system)
|
|
||||||
}
|
}
|
||||||
|
|
||||||
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());
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -45,6 +45,10 @@
|
||||||
|
|
||||||
namespace Automation4 {
|
namespace Automation4 {
|
||||||
|
|
||||||
|
|
||||||
|
/////////////////
|
||||||
|
// PerlConsole
|
||||||
|
//
|
||||||
class PerlConsole : public PerlFeatureMacro {
|
class PerlConsole : public PerlFeatureMacro {
|
||||||
private:
|
private:
|
||||||
static PerlConsole *registered;
|
static PerlConsole *registered;
|
||||||
|
@ -52,6 +56,7 @@ namespace Automation4 {
|
||||||
// Nested classes are messy, therefore we use them :)
|
// Nested classes are messy, therefore we use them :)
|
||||||
class Dialog : public wxDialog {
|
class Dialog : public wxDialog {
|
||||||
private:
|
private:
|
||||||
|
friend class PerlConsole;
|
||||||
wxTextCtrl *txt_out, *txt_hist, *txt_in;
|
wxTextCtrl *txt_out, *txt_hist, *txt_in;
|
||||||
|
|
||||||
public:
|
public:
|
||||||
|
@ -62,13 +67,11 @@ namespace Automation4 {
|
||||||
long style = wxDEFAULT_DIALOG_STYLE, const wxString& name = _T("console_dialog"));
|
long style = wxDEFAULT_DIALOG_STYLE, const wxString& name = _T("console_dialog"));
|
||||||
|
|
||||||
void InputEnter(wxCommandEvent& evt);
|
void InputEnter(wxCommandEvent& evt);
|
||||||
void Echo(const wxString &str);
|
|
||||||
};
|
};
|
||||||
|
|
||||||
Dialog *dialog;
|
Dialog *dialog;
|
||||||
wxWindow *parent_window;
|
wxWindow *parent_window;
|
||||||
|
|
||||||
SV *cout;
|
|
||||||
wxString evaluate(const wxString &str);
|
wxString evaluate(const wxString &str);
|
||||||
|
|
||||||
public:
|
public:
|
||||||
|
@ -76,16 +79,15 @@ namespace Automation4 {
|
||||||
virtual ~PerlConsole();
|
virtual ~PerlConsole();
|
||||||
|
|
||||||
static PerlConsole *GetConsole() { return registered; }
|
static PerlConsole *GetConsole() { return registered; }
|
||||||
Dialog *GetDialog() { return dialog; }
|
|
||||||
|
|
||||||
virtual bool Validate(AssFile *subs, const std::vector<int> &selected, int active) { return true; }
|
virtual bool Validate(AssFile *subs, const std::vector<int> &selected, int active) { return true; }
|
||||||
virtual void Process(AssFile *subs, std::vector<int> &selected, int active, wxWindow * const progress_parent);
|
virtual void Process(AssFile *subs, std::vector<int> &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);
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -43,92 +43,27 @@
|
||||||
namespace Automation4 {
|
namespace Automation4 {
|
||||||
|
|
||||||
|
|
||||||
void xs_perl_misc(pTHX)
|
//////////////////////
|
||||||
{
|
// PerlProgressSink
|
||||||
newXS("Aegisub::warn", log_warning, __FILE__);
|
|
||||||
newXS("Aegisub::text_extents", text_extents, __FILE__);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/////////////
|
|
||||||
// PerlLog
|
|
||||||
//
|
//
|
||||||
|
PerlProgressSink *PerlProgressSink::sink;
|
||||||
|
|
||||||
XS(log_warning)
|
PerlProgressSink::PerlProgressSink(wxWindow* parent, const wxString &title):
|
||||||
|
ProgressSink(parent)
|
||||||
{
|
{
|
||||||
dXSARGS;
|
if(sink) {
|
||||||
wxString buffer;
|
sink->Destroy();
|
||||||
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);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
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);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
|
@ -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<int> &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<int> &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
|
|
|
@ -38,26 +38,20 @@
|
||||||
|
|
||||||
|
|
||||||
#include "auto4_perl.h"
|
#include "auto4_perl.h"
|
||||||
#include "auto4_perl_console.h"
|
|
||||||
#include "version.h"
|
#include "version.h"
|
||||||
#include "standard_paths.h"
|
#include "standard_paths.h"
|
||||||
#include <wx/filename.h>
|
#include <wx/filename.h>
|
||||||
#include <wx/utils.h>
|
#include <wx/utils.h>
|
||||||
|
|
||||||
|
|
||||||
#ifdef __VISUALC__
|
#ifdef __VISUALC__
|
||||||
#pragma warning(disable: 4800)
|
#pragma warning(disable: 4800)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
||||||
namespace Automation4 {
|
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
|
// PerlScript class
|
||||||
//
|
//
|
||||||
|
@ -69,12 +63,14 @@ namespace Automation4 {
|
||||||
// Create a package name for the script
|
// Create a package name for the script
|
||||||
package.Printf(_T("Aegisub::Script::p%lx"), this);
|
package.Printf(_T("Aegisub::Script::p%lx"), this);
|
||||||
|
|
||||||
|
// local @INC; # lol
|
||||||
inc_saved = newAV();
|
inc_saved = newAV();
|
||||||
|
|
||||||
|
// Buggy
|
||||||
reload = false;
|
reload = false;
|
||||||
mtime = 0;
|
mtime = 0;
|
||||||
|
|
||||||
// Load the code
|
// Load the script
|
||||||
load();
|
load();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -92,7 +88,8 @@ namespace Automation4 {
|
||||||
|
|
||||||
void PerlScript::load()
|
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
|
// Feed some defaults into the script info
|
||||||
name = GetPrettyFilename().BeforeLast(_T('.'));
|
name = GetPrettyFilename().BeforeLast(_T('.'));
|
||||||
|
@ -100,10 +97,6 @@ namespace Automation4 {
|
||||||
author = wxGetUserId();
|
author = wxGetUserId();
|
||||||
version = GetAegisubShortVersionString();
|
version = GetAegisubShortVersionString();
|
||||||
|
|
||||||
// Get file's mtime
|
|
||||||
//struct stat s;
|
|
||||||
//stat(GetFilename().mb_str(wxConvLibc), &s);
|
|
||||||
//mtime = s.st_mtime;
|
|
||||||
wxFileName fn(GetFilename());
|
wxFileName fn(GetFilename());
|
||||||
wxDateTime mod;
|
wxDateTime mod;
|
||||||
fn.GetTimes(NULL,&mod,NULL);
|
fn.GetTimes(NULL,&mod,NULL);
|
||||||
|
@ -125,8 +118,10 @@ namespace Automation4 {
|
||||||
|
|
||||||
// Let's eval the 'boxed' script
|
// Let's eval the 'boxed' script
|
||||||
eval_pv(_script.mb_str(wx2pl), 0);
|
eval_pv(_script.mb_str(wx2pl), 0);
|
||||||
|
// and check on errors
|
||||||
if(SvTRUE(ERRSV)) {
|
if(SvTRUE(ERRSV)) {
|
||||||
wxLogError(wxString(SvPV_nolen(ERRSV), pl2wx));
|
description = wxString(SvPV_nolen(ERRSV), pl2wx);
|
||||||
|
wxLogError(description); // Remove?
|
||||||
loaded = false;
|
loaded = false;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
|
@ -135,10 +130,13 @@ namespace Automation4 {
|
||||||
|
|
||||||
// The script has done loading (running)
|
// The script has done loading (running)
|
||||||
deactivate();
|
deactivate();
|
||||||
|
|
||||||
|
wxTRACE_RET(load);
|
||||||
}
|
}
|
||||||
|
|
||||||
void PerlScript::unload() {
|
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
|
// Deinstantiate(?) all features and clear the vector
|
||||||
for(; !features.empty(); features.pop_back()) {
|
for(; !features.empty(); features.pop_back()) {
|
||||||
|
@ -150,14 +148,18 @@ namespace Automation4 {
|
||||||
hv_undef((HV*)gv_stashpv(package.mb_str(wx2pl), 0));
|
hv_undef((HV*)gv_stashpv(package.mb_str(wx2pl), 0));
|
||||||
|
|
||||||
// Officially finished with unloading
|
// Officially finished with unloading
|
||||||
|
wxLogDebug(_T("'%s' (%s) unloaded"), name.c_str(), package.c_str());
|
||||||
loaded = false;
|
loaded = false;
|
||||||
|
wxTRACE_RET(unload);
|
||||||
}
|
}
|
||||||
|
|
||||||
void PerlScript::activate(PerlScript *script)
|
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
|
// Check if the source file is newer
|
||||||
|
/* FIX */
|
||||||
if(script->reload) {
|
if(script->reload) {
|
||||||
// struct stat s;
|
// struct stat s;
|
||||||
// stat(script->GetFilename().mb_str(wxConvLibc), &s);
|
// stat(script->GetFilename().mb_str(wxConvLibc), &s);
|
||||||
|
@ -165,14 +167,13 @@ namespace Automation4 {
|
||||||
wxDateTime mod;
|
wxDateTime mod;
|
||||||
fn.GetTimes(NULL,&mod,NULL);
|
fn.GetTimes(NULL,&mod,NULL);
|
||||||
if(script->mtime != mod.GetTicks()) {
|
if(script->mtime != mod.GetTicks()) {
|
||||||
printf("%d != %d !\n", script->mtime, mod.GetTicks());
|
PerlLogVerbose(wxString::Format(_("Reloading %s because the file on disk (%s) changed"), script->GetName().c_str(), script->GetFilename().c_str()));
|
||||||
wxLogVerbose(_("Reloading %s because the file on disk (%s) changed"), script->GetName().c_str(), script->GetFilename().c_str());
|
|
||||||
script->Reload();
|
script->Reload();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
// Hooking $SIG{__WARN__}
|
// Hooking $SIG{__WARN__}
|
||||||
wxLogTrace(_T("Hooking $SIG{__WARN__}"), 0);
|
wxLogTrace(wxTRACE_AutoPerl, _T("$SIG{__WARN__} = \\&Aegisub::warn"));
|
||||||
eval_pv("$SIG{__WARN__} = \\&Aegisub::warn", 1);
|
eval_pv("$SIG{__WARN__} = \\&Aegisub::warn", 1);
|
||||||
|
|
||||||
// Add the script's includes to @INC
|
// Add the script's includes to @INC
|
||||||
|
@ -186,27 +187,34 @@ namespace Automation4 {
|
||||||
// Make room in @INC
|
// Make room in @INC
|
||||||
I32 inc_count = script->include_path.GetCount();
|
I32 inc_count = script->include_path.GetCount();
|
||||||
av_unshift(inc_av, inc_count);
|
av_unshift(inc_av, inc_count);
|
||||||
// Add the include paths
|
// Add the automation include paths
|
||||||
for(I32 i = 0; i < inc_count; i++) {
|
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_TOUCH(inc_av, i)
|
||||||
AV_STORE(newSVpv(script->include_path.Item(i).mb_str(wx2pl), 0));
|
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 {
|
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
|
// Set the values of script vars
|
||||||
script->WriteVars();
|
script->WriteVars();
|
||||||
|
|
||||||
active = script;
|
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()
|
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
|
// Revert @INC to its value before the script activation
|
||||||
AV *inc_av = get_av("main::INC", 0);
|
AV *inc_av = get_av("main::INC", 0);
|
||||||
|
@ -217,7 +225,7 @@ namespace Automation4 {
|
||||||
if(av_len(active->inc_saved) >= 0) {
|
if(av_len(active->inc_saved) >= 0) {
|
||||||
// If there's a saved one
|
// If there's a saved one
|
||||||
AV_COPY(active->inc_saved, inc_av);
|
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);
|
av_clear(active->inc_saved);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -225,8 +233,8 @@ namespace Automation4 {
|
||||||
// Read the values of script vars
|
// Read the values of script vars
|
||||||
active->ReadVars();
|
active->ReadVars();
|
||||||
|
|
||||||
// Unooking $SIG{__WARN__}
|
// Unhooking $SIG{__WARN__}
|
||||||
wxLogTrace(_T("Releasing $SIG{__WARN__} hook"), 0);
|
wxLogTrace(wxTRACE_AutoPerl, _T("undef $SIG{__WARN__}"));
|
||||||
eval_pv("undef $SIG{__WARN__}", 1);
|
eval_pv("undef $SIG{__WARN__}", 1);
|
||||||
|
|
||||||
wxLogDebug(_T("%s(%p) deactivated"), active->GetName().c_str(), active);
|
wxLogDebug(_T("%s(%p) deactivated"), active->GetName().c_str(), active);
|
||||||
|
@ -235,22 +243,25 @@ namespace Automation4 {
|
||||||
|
|
||||||
void PerlScript::AddFeature(Feature *feature)
|
void PerlScript::AddFeature(Feature *feature)
|
||||||
{
|
{
|
||||||
|
wxTRACE_METH(AddFeature);
|
||||||
features.push_back(feature);
|
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)
|
void PerlScript::DeleteFeature(Feature *feature)
|
||||||
{
|
{
|
||||||
|
wxTRACE_METH(DeleteFeature);
|
||||||
for(std::vector<Feature*>::iterator it = features.begin(); it != features.end(); it++)
|
for(std::vector<Feature*>::iterator it = features.begin(); it != features.end(); it++)
|
||||||
if(*it == feature) {
|
if(*it == feature) {
|
||||||
delete 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);
|
features.erase(it);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void PerlScript::ReadVars()
|
void PerlScript::ReadVars()
|
||||||
{
|
{
|
||||||
|
wxTRACE_METH(ReadVars);
|
||||||
// This will get anything inside it °_°
|
// This will get anything inside it °_°
|
||||||
SV *whore = NULL;
|
SV *whore = NULL;
|
||||||
// All the vars' names will stick to it #_#
|
// All the vars' names will stick to it #_#
|
||||||
|
@ -279,6 +290,7 @@ namespace Automation4 {
|
||||||
|
|
||||||
void PerlScript::WriteVars() const
|
void PerlScript::WriteVars() const
|
||||||
{
|
{
|
||||||
|
wxTRACE_METH(WriteVars);
|
||||||
// Somewhat as above
|
// Somewhat as above
|
||||||
SV *whore = NULL;
|
SV *whore = NULL;
|
||||||
wxString bitch;
|
wxString bitch;
|
||||||
|
@ -312,52 +324,144 @@ namespace Automation4 {
|
||||||
sv_setpv(whore, version.mb_str(wx2pl));
|
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;
|
// We know what script we belong to ^_^
|
||||||
PerlScript *active = PerlScript::GetActive();
|
script = own_script;
|
||||||
if(active) {
|
|
||||||
// Update the object's vars
|
|
||||||
active->ReadVars();
|
|
||||||
|
|
||||||
// Set script info vars
|
// And not surprisingly we have some callbacks too
|
||||||
switch (items) {
|
processing_sub = newSVsv(proc_sub);
|
||||||
case 4:
|
validation_sub = newSVsv(val_sub);
|
||||||
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(register_macro)
|
PerlFeatureMacro::~PerlFeatureMacro() {
|
||||||
{
|
// The macro subroutines get undefined
|
||||||
dXSARGS;
|
CV *cv = Nullcv;
|
||||||
PerlScript *active = PerlScript::GetActive();
|
HV *hv = NULL;
|
||||||
if(active && items >= 3) {
|
GV *gv = NULL;
|
||||||
wxString name, description;
|
if(processing_sub) {
|
||||||
SV *proc_sub = NULL, *val_sub = NULL;
|
cv = sv_2cv(processing_sub, &hv, &gv, 1);
|
||||||
switch (items) {
|
cv_undef(cv);
|
||||||
case 4:
|
if(hv) hv_undef(hv);
|
||||||
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;
|
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<int> &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<int> &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();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,41 @@
|
||||||
package Aegisub;
|
package Aegisub;
|
||||||
use Exporter 'import';
|
use Exporter 'import';
|
||||||
|
|
||||||
@EXPORT = qw( text_extents );
|
@EXPORT = qw( text_extents
|
||||||
@EXPORT_OK = qw( warn );
|
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;
|
1;
|
||||||
|
|
|
@ -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;
|
|
@ -2,18 +2,35 @@
|
||||||
Quick reference on Perl engine's API
|
Quick reference on Perl engine's API
|
||||||
------------------------------------
|
------------------------------------
|
||||||
|
|
||||||
Every symbol contained in this reference is automatically made visible to the
|
All the packages that form the perl interface to Aegisub are automatically
|
||||||
executing script. They are not however imported in the script's package, so
|
loaded, however none of their symbols are exported initially. If you want to
|
||||||
they must be referenced with their full name. (A mechanism to import them
|
import them you can use the usual 'use' mechanism; if you call it without a
|
||||||
through the canonical perl commands `use' and `import' will be deployed sooner
|
list of imports it will import more or less everything (exceptions to this are
|
||||||
or later.)
|
explicitely signaled in the docs) in your script's package.
|
||||||
|
|
||||||
|
|
||||||
====================================
|
====================================
|
||||||
package Aegisub
|
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:
|
Subroutines defined:
|
||||||
|
<--EXPORTED-->
|
||||||
|
|
||||||
text_extents STYLE, TEXT
|
text_extents STYLE, TEXT
|
||||||
Computes the metric for a string of text, based on a specific style.
|
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.
|
TEXT Text for which to compute the metrics.
|
||||||
Returns:
|
Returns:
|
||||||
WIDTH The width of the text (if called in scalar context, only this is returned).
|
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.
|
DESCENT Descent, i.e. the distance from the baseline to the bottom.
|
||||||
EXTLEADING External leading, i.e. the distance between to lines of text.
|
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
|
warn LIST
|
||||||
Prints a warning through the GUI log facilities. It is automatically hooked
|
Prints a warning through the GUI log facilities (it is equivalent to
|
||||||
to the global `warn' function during script execution.
|
'log(LOG_WARNING, LIST)'). It is automatically hooked to the global 'warn'
|
||||||
|
function during script execution, but it is not exported by default.
|
||||||
Arguments:
|
Arguments:
|
||||||
LIST List of arguments to print.
|
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
|
package Aegisub::PerlConsole
|
||||||
|
@ -41,10 +97,11 @@ use by normal users. They are shown here for completeness.
|
||||||
|
|
||||||
------------------------------------
|
------------------------------------
|
||||||
Subroutines defined:
|
Subroutines defined:
|
||||||
|
<--EXPORTED-->
|
||||||
|
|
||||||
echo LIST
|
echo LIST
|
||||||
Prints a list of arguments on the console, or on STDOUT if no console is
|
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:
|
Arguments:
|
||||||
LIST List of arguments to print.
|
LIST List of arguments to print.
|
||||||
|
|
||||||
|
@ -56,24 +113,82 @@ register_console NAME, DESC
|
||||||
DESC Set the macro's description. (optional)
|
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
|
package Aegisub::Script
|
||||||
|
|
||||||
------------------------------------
|
------------------------------------
|
||||||
Subroutines defined:
|
Subroutines defined:
|
||||||
|
<--EXPORTED-->
|
||||||
|
|
||||||
register_macro NAME, DESC, PROC_SUB, VAL_SUB
|
register_macro NAME, DESC, PROC_SUB, VAL_SUB
|
||||||
Register a new macro.
|
Register a new macro.
|
||||||
Arguments:
|
Arguments:
|
||||||
NAME The name of the macro.
|
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
|
PROC_SUB A ref to a subroutine to be used as the macro processing function
|
||||||
(see the callbacks section).
|
(see the callbacks section). Please, really use a reference and not
|
||||||
VAL_SUB A ref to a subrotine to be used as the macro validation function
|
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).
|
(see callbacks)(optional, if not defined will be considered as always true).
|
||||||
|
|
||||||
set_info NAME, DESC, AUTHOR, VERSION
|
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.
|
Arguments: see the parts about script variables, anything is optional.
|
||||||
|
|
||||||
|
|
||||||
|
@ -81,13 +196,13 @@ set_info NAME, DESC, AUTHOR, VERSION
|
||||||
package Aegisub::Script::pxxxxxxxx
|
package Aegisub::Script::pxxxxxxxx
|
||||||
------------------------------------
|
------------------------------------
|
||||||
Every script that's loaded gets its code evaluated inside a different package -
|
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
|
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
|
all the scripts see the same global package, and can possibly access other
|
||||||
scripts'. Therefore is recommended to ALWAYS declare all of the script's local
|
scripts' packages. Therefore is recommended to ALWAYS declare all of the
|
||||||
variables with `my', if they have to reside outside any function body, and of
|
script's local variables with 'my', and of course to 'use strict' to check on
|
||||||
course to `use strict' to check on this. You can still define another package
|
this. You can still declare another package for your script; the script's
|
||||||
for your script, the script's predefined variables will still be visible
|
predefined variables should be still visible from it without any change in the
|
||||||
[maybe?] from it, but this is discouraged.
|
code (they're declared as 'our'), however this is discouraged.
|
||||||
|
|
||||||
------------------------------------
|
------------------------------------
|
||||||
Variables defined:
|
Variables defined:
|
||||||
|
@ -102,41 +217,56 @@ $script_name
|
||||||
Holds the script's name. Default is the script's filename.
|
Holds the script's name. Default is the script's filename.
|
||||||
|
|
||||||
$script_version
|
$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
|
$_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
|
$_script_package
|
||||||
The full script package as a string. Any change to this variable is
|
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]
|
$_script_reload [BROKEN]
|
||||||
When this is set to true. The script will automatically be reload before
|
When this is set to true, the script will automatically be reloaded before
|
||||||
any execution if its file changed on disk. Useful during the development.
|
any execution if its file changed on disk. (However, at present time, it is
|
||||||
|
just a shortcut to make aegisub crash.)
|
||||||
|
|
||||||
------------------------------------
|
------------------------------------
|
||||||
Callbacks definable:
|
Callbacks definable:
|
||||||
|
|
||||||
macro_processing_function LINES, SELECTED, ACTIVE
|
macro_processing_function LINES, SELECTED, ACTIVE
|
||||||
A function to be used as a callback for Aegisub::Script::register_macro().
|
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
|
This function will be called when the user selects the corresponding macro
|
||||||
reflected in the subtitles file
|
in the Automation menu. The first two arguments can be modified, and the
|
||||||
|
modifications will be reflected in the subtitles file.
|
||||||
Arguments:
|
Arguments:
|
||||||
LINES A reference to the list containing the subtitle file lines.
|
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
|
Each element of the list is a reference to a hash that represents a
|
||||||
as keys. See the Lua documentation; this is basically the same structure.
|
single subtitle line. For the hash keys refer to lua documentation,
|
||||||
EXAMPLE:
|
they are basically the same.
|
||||||
my $l = $lines->[$linenumber]; # an entire line
|
Example:
|
||||||
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
|
my $lines = $_[0]; # DON'T shift @_ (unless you reconstruct it
|
||||||
the file
|
# afterwards) or you'll break everything and
|
||||||
ACTIVE Index of the currently active line in the subtitle file (sic)
|
# 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
|
macro_validation_function LINES, SELECTED, ACTIVE
|
||||||
A function to be used as a callback for Aegisub::Script::register_macro().
|
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
|
Arguments: same as macro_processing_function; however any change to the
|
||||||
first two ones will be ignored upon function return.
|
first two ones will be ignored upon function return.
|
||||||
Returns:
|
Returns:
|
||||||
VALID A 'bolean' value to indicate if the macro is applicable to this
|
VALID A 'bolean' value to indicate if the macro is applicable to this
|
||||||
particualar subtitles file.
|
particular subtitles file.
|
||||||
|
|
16
configure.ac
16
configure.ac
|
@ -73,6 +73,21 @@ fi
|
||||||
AC_CHECK_LIB([hunspell], [main],, [with_hunspell=no])
|
AC_CHECK_LIB([hunspell], [main],, [with_hunspell=no])
|
||||||
AC_CHECK_LIB([ruby1.9], [ruby_init],, [with_ruby=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_CHECK_HEADER([wchar.h],,[
|
||||||
AC_MSG_XFAILURE([aegisub needs wide character support, find a 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 FIXME: These three should probably get proper --with flags,
|
||||||
dnl and Ruby also keep its detection (warn/fail if you have --with-ruby
|
dnl and Ruby also keep its detection (warn/fail if you have --with-ruby
|
||||||
dnl but the lib isn't detected.)
|
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_RUBY], [test "$with_ruby" != "no"])
|
||||||
AM_CONDITIONAL([WITH_AUTO4_LUA], [true])
|
AM_CONDITIONAL([WITH_AUTO4_LUA], [true])
|
||||||
dnl TODO: Make the auto3 lib build on non-Win32 so this can be true
|
dnl TODO: Make the auto3 lib build on non-Win32 so this can be true
|
||||||
|
|
Loading…
Reference in New Issue