mia/Aegisub
1
0
Fork 1
Code Issues Pull requests Projects Releases Wiki Activity

New and reorganized perl sources. Autotools patched accordingly. Win build must be fixed.

Browse source 
Originally committed to SVN as r1827.
This commit is contained in:
shb 2008-01-24 17:20:47 +00:00
parent 260c2b5cb2
commit b2518f9ca1
13 changed files with 1007 additions and 499 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
aegisub/Makefile.am
View file

@ -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

449
aegisub/auto4_perl.cpp
View file

@ -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;
}
@ -74,6 +502,11 @@ 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
}
}

122
aegisub/auto4_perl.h
View file

@ -33,6 +33,7 @@
// Contact: mailto:jiifurusu@gmail.com
//
#pragma once
#ifndef _AUTO4_PERL_H
#define _AUTO4_PERL_H
@ -43,17 +44,16 @@
#include <wx/string.h>
#include "ass_file.h"
//#include "ass_dialogue.h"
#undef _
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#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()
};

26
aegisub/auto4_perl_ass.cpp
View file

@ -75,16 +75,16 @@ 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");
@ -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) {

78
aegisub/auto4_perl_console.cpp
View file

@ -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<int> &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,51 +212,27 @@ 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());
}
}
};

14
aegisub/auto4_perl_console.h
View file

@ -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<int> &selected, int active) { return true; }
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);
};

87
aegisub/auto4_perl_misc.cpp → aegisub/auto4_perl_dialogs.cpp
View file

@ -43,89 +43,24 @@
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);
}
////////////
// Others
//
XS(text_extents)
PerlProgressSink::~PerlProgressSink()
{
/* 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);
}
sink = NULL;
}

192
aegisub/auto4_perl_macro.cpp
View file

@ -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

236
aegisub/auto4_perl_script.cpp
View file

@ -38,26 +38,20 @@
#include "auto4_perl.h"
#include "auto4_perl_console.h"
#include "version.h"
#include "standard_paths.h"
#include <wx/filename.h>
#include <wx/utils.h>
#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<Feature*>::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));
// And not surprisingly we have some callbacks too
processing_sub = newSVsv(proc_sub);
validation_sub = newSVsv(val_sub);
}
// Update the package's vars
active->WriteVars();
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);
}
if(validation_sub) {
cv = sv_2cv(validation_sub, &hv, &gv, 1);
cv_undef(cv);
if(hv) hv_undef(hv);
}
};
XS(register_macro)
bool PerlFeatureMacro::Validate(AssFile *subs, const std::vector<int> &selected, int active)
{
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 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;
}
if(proc_sub) {
active->AddFeature(new PerlFeatureMacro(name, description, active, proc_sub, val_sub));
XSRETURN_YES;
else {
SV *wtf = sv_mortalcopy(POPs);
ret = SvTRUE(wtf);
}
// Tidy up everything
PUTBACK;
FREETMPS;
LEAVE;
// Deactivate the script
script->Deactivate();
return ret;
}
XSRETURN_UNDEF;
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();
}

38
automation/include/Aegisub.pm
View file

@ -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;

11
automation/include/Aegisub/Progress.pm Normal file
View file

@ -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;

202
automation/v4-docs/perl-api.txt
View file

@ -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.

16
configure.ac
View file

@ -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