summary refs log blame commit diff stats
path: root/src/common/textevents.in
blob: 3631e36397dfe429a624cf09b5a130d1a713a025 (plain) (tree)
generated by cgit-pink 1.4.1 (git 2.36.1) at 2025-02-03 08:11:10 +0000
">*list; const char *const *fields; int count = 0; /* return value for scalar context */ dXSARGS; if (items != 1) { hexchat_print (ph, "Usage: Xchat::get_list(name)"); } else { SP -= items; /*remove the argument list from the stack */ name = ST (0); list = hexchat_list_get (ph, SvPV_nolen (name)); if (list == NULL) { XSRETURN_EMPTY; } if (GIMME_V == G_SCALAR) { while (hexchat_list_next (ph, list)) { count++; } hexchat_list_free (ph, list); XSRETURN_IV ((IV) count); } fields = hexchat_list_fields (ph, SvPV_nolen (name)); while (hexchat_list_next (ph, list)) { XPUSHs (list_item_to_sv (list, fields)); } hexchat_list_free (ph, list); PUTBACK; return; } } static XS (XS_Xchat_Embed_plugingui_remove) { void *gui_entry; dXSARGS; if (items != 1) { hexchat_print (ph, "Usage: Xchat::Embed::plugingui_remove(handle)"); } else { gui_entry = INT2PTR (void *, SvUV (ST (0))); hexchat_plugingui_remove (ph, gui_entry); } XSRETURN_EMPTY; } /* xs_init is the second argument perl_parse. As the name hints, it initializes XS subroutines (see the perlembed manpage) */ static void xs_init (pTHX) { HV *stash; SV *version; /* This one allows dynamic loading of perl modules in perl scripts by the 'use perlmod;' construction */ newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__); /* load up all the custom IRC perl functions */ newXS ("Xchat::Internal::register", XS_Xchat_register, __FILE__); newXS ("Xchat::Internal::hook_server", XS_Xchat_hook_server, __FILE__); newXS ("Xchat::Internal::hook_command", XS_Xchat_hook_command, __FILE__); newXS ("Xchat::Internal::hook_print", XS_Xchat_hook_print, __FILE__); newXS ("Xchat::Internal::hook_timer", XS_Xchat_hook_timer, __FILE__); newXS ("Xchat::Internal::hook_fd", XS_Xchat_hook_fd, __FILE__); newXS ("Xchat::Internal::unhook", XS_Xchat_unhook, __FILE__); newXS ("Xchat::Internal::print", XS_Xchat_print, __FILE__); newXS ("Xchat::Internal::command", XS_Xchat_command, __FILE__); newXS ("Xchat::Internal::set_context", XS_Xchat_set_context, __FILE__); newXS ("Xchat::Internal::get_info", XS_Xchat_get_info, __FILE__); newXS ("Xchat::Internal::context_info", XS_Xchat_context_info, __FILE__); newXS ("Xchat::Internal::get_list", XS_Xchat_get_list, __FILE__); newXS ("Xchat::find_context", XS_Xchat_find_context, __FILE__); newXS ("Xchat::get_context", XS_Xchat_get_context, __FILE__); newXS ("Xchat::get_prefs", XS_Xchat_get_prefs, __FILE__); newXS ("Xchat::emit_print", XS_Xchat_emit_print, __FILE__); newXS ("Xchat::send_modes", XS_Xchat_send_modes, __FILE__); newXS ("Xchat::nickcmp", XS_Xchat_nickcmp, __FILE__); newXS ("Xchat::Embed::plugingui_remove", XS_Xchat_Embed_plugingui_remove, __FILE__); stash = get_hv ("Xchat::", TRUE); if (stash == NULL) { exit (1); } newCONSTSUB (stash, "PRI_HIGHEST", newSViv (HEXCHAT_PRI_HIGHEST)); newCONSTSUB (stash, "PRI_HIGH", newSViv (HEXCHAT_PRI_HIGH)); newCONSTSUB (stash, "PRI_NORM", newSViv (HEXCHAT_PRI_NORM)); newCONSTSUB (stash, "PRI_LOW", newSViv (HEXCHAT_PRI_LOW)); newCONSTSUB (stash, "PRI_LOWEST", newSViv (HEXCHAT_PRI_LOWEST)); newCONSTSUB (stash, "EAT_NONE", newSViv (HEXCHAT_EAT_NONE)); newCONSTSUB (stash, "EAT_XCHAT", newSViv (HEXCHAT_EAT_HEXCHAT)); newCONSTSUB (stash, "EAT_PLUGIN", newSViv (HEXCHAT_EAT_PLUGIN)); newCONSTSUB (stash, "EAT_ALL", newSViv (HEXCHAT_EAT_ALL)); newCONSTSUB (stash, "FD_READ", newSViv (HEXCHAT_FD_READ)); newCONSTSUB (stash, "FD_WRITE", newSViv (HEXCHAT_FD_WRITE)); newCONSTSUB (stash, "FD_EXCEPTION", newSViv (HEXCHAT_FD_EXCEPTION)); newCONSTSUB (stash, "FD_NOTSOCKET", newSViv (HEXCHAT_FD_NOTSOCKET)); newCONSTSUB (stash, "KEEP", newSViv (1)); newCONSTSUB (stash, "REMOVE", newSViv (0)); version = get_sv( "Xchat::VERSION", 1 ); sv_setpv( version, PACKAGE_VERSION ); } static void perl_init (void) { int warn; int arg_count; char *perl_args[] = { "", "-e", "0", "-w" }; char *env[] = { "" }; static const char xchat_definitions[] = { /* Redefine the $SIG{__WARN__} handler to have HexChat printing warnings in the main window. (TheHobbit) */ #include "xchat.pm.h" }; #ifdef OLD_PERL static const char irc_definitions[] = { #include "irc.pm.h" }; #endif #ifdef ENABLE_NLS /* Problem is, dynamicaly loaded modules check out the $] var. It appears that in the embedded interpreter we get 5,00503 as soon as the LC_NUMERIC locale calls for a comma instead of a point in separating integer and decimal parts. I realy can't understant why... The following appears to be an awful workaround... But it'll do until I (or someone else :)) found the "right way" to solve this nasty problem. (TheHobbit <thehobbit@altern.org>) */ setlocale (LC_NUMERIC, "C"); #endif warn = 0; hexchat_get_prefs (ph, "perl_warnings", NULL, &warn); arg_count = warn ? 4 : 3; PERL_SYS_INIT3 (&arg_count, (char ***)&perl_args, (char ***)&env); my_perl = perl_alloc (); perl_construct (my_perl); PL_exit_flags |= PERL_EXIT_DESTRUCT_END; perl_parse (my_perl, xs_init, arg_count, perl_args, (char **)NULL); /* Now initialising the perl interpreter by loading the perl_definition array. */ eval_pv (xchat_definitions, TRUE); #ifdef OLD_PERL eval_pv (irc_definitions, TRUE); #endif } static int perl_load_file (char *filename) { #ifdef WIN32 static HMODULE lib = NULL; if (!lib) { lib = LoadLibraryA (PERL_DLL); if (!lib) { if (GetLastError () == ERROR_BAD_EXE_FORMAT) /* http://forum.xchat.org/viewtopic.php?t=3277 */ thread_mbox ("Cannot use this " PERL_DLL "\n\n" #ifdef _WIN64 "64-bit Strawberry Perl is required."); #else "32-bit Strawberry Perl is required."); #endif else { /* a lot of people install this old version */ lib = LoadLibraryA ("perl56.dll"); if (lib) { FreeLibrary (lib); lib = NULL; thread_mbox ("Cannot open " PERL_DLL "!\n\n" "You must have a Visual C++ build of Perl " PERL_REQUIRED_VERSION " installed in order to\n" "run Perl scripts. A reboot may be required.\n\n" "http://hexchat.org/downloads.html\n\n" "I have found Perl 5.6, but that is too old."); } else { thread_mbox ("Cannot open " PERL_DLL "!\n\n" "You must have a Visual C++ build of Perl " PERL_REQUIRED_VERSION " installed in order to\n" "run Perl scripts. A reboot may be required.\n\n" "http://hexchat.org/downloads.html\n\n" "Make sure Perl's bin directory is in your PATH."); } } /* failure */ return FALSE; } /* success */ FreeLibrary (lib); } #endif if (my_perl == NULL) { perl_init (); } return execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::load", 0)), filename); } static void perl_end (void) { if (my_perl != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), ""); PL_perl_destruct_level = 1; perl_destruct (my_perl); perl_free (my_perl); PERL_SYS_TERM(); my_perl = NULL; } } static int perl_command_unloadall (char *word[], char *word_eol[], void *userdata) { if (my_perl != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload_all", 0)), ""); return HEXCHAT_EAT_HEXCHAT; } return HEXCHAT_EAT_HEXCHAT; } static int perl_command_reloadall (char *word[], char *word_eol[], void *userdata) { if (my_perl != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload_all", 0)), ""); return HEXCHAT_EAT_HEXCHAT; } else { perl_auto_load( NULL ); } return HEXCHAT_EAT_HEXCHAT; } static int perl_command_load (char *word[], char *word_eol[], void *userdata) { char *file = get_filename (word, word_eol); if (file != NULL ) { perl_load_file (file); return HEXCHAT_EAT_HEXCHAT; } return HEXCHAT_EAT_NONE; } static int perl_command_unload (char *word[], char *word_eol[], void *userdata) { char *file = get_filename (word, word_eol); if (my_perl != NULL && file != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::unload", 0)), file); return HEXCHAT_EAT_HEXCHAT; } return HEXCHAT_EAT_NONE; } static int perl_command_reload (char *word[], char *word_eol[], void *userdata) { char *file = get_filename (word, word_eol); if (my_perl != NULL && file != NULL) { execute_perl (sv_2mortal (newSVpv ("Xchat::Embed::reload", 0)), file); return HEXCHAT_EAT_HEXCHAT; } return HEXCHAT_EAT_HEXCHAT; } void hexchat_plugin_get_info (char **name, char **desc, char **version, void **reserved) { *name = "Perl"; *desc = "Perl scripting interface"; *version = PACKAGE_VERSION; if (reserved) *reserved = NULL; } /* Reinit safeguard */ static int initialized = 0; int hexchat_plugin_init (hexchat_plugin * plugin_handle, char **plugin_name, char **plugin_desc, char **plugin_version, char *arg) { if (initialized != 0) { hexchat_print (plugin_handle, "Perl interface already loaded\n"); return 0; } ph = plugin_handle; initialized = 1; *plugin_name = "Perl"; *plugin_desc = "Perl scripting interface"; *plugin_version = PACKAGE_VERSION; hexchat_hook_command (ph, "load", HEXCHAT_PRI_NORM, perl_command_load, 0, 0); hexchat_hook_command (ph, "unload", HEXCHAT_PRI_NORM, perl_command_unload, 0, 0); hexchat_hook_command (ph, "reload", HEXCHAT_PRI_NORM, perl_command_reload, 0, 0); hexchat_hook_command (ph, "pl_reload", HEXCHAT_PRI_NORM, perl_command_reload, 0, 0); hexchat_hook_command (ph, "unloadall", HEXCHAT_PRI_NORM, perl_command_unloadall, 0, 0); hexchat_hook_command (ph, "reloadall", HEXCHAT_PRI_NORM, perl_command_reloadall, 0, 0); /*perl_init (); */ hexchat_hook_timer (ph, 0, perl_auto_load, NULL ); hexchat_print (ph, "Perl interface loaded\n"); return 1; } int hexchat_plugin_deinit (hexchat_plugin * plugin_handle) { perl_end (); initialized = 0; hexchat_print (plugin_handle, "Perl interface unloaded\n"); return 1; }