src/perl.c

changeset 2370
722a3374b5cf
parent 2355
3bf7d403faa6
child 2397
432ccc0c7f18
equal deleted inserted replaced
2369:65cbc00bf992 2370:722a3374b5cf
46 #include <fcntl.h> 46 #include <fcntl.h>
47 #undef PACKAGE 47 #undef PACKAGE
48 #include <stdio.h> 48 #include <stdio.h>
49 #include <dirent.h> 49 #include <dirent.h>
50 #include <string.h> 50 #include <string.h>
51 #include <gtk/gtk.h>
52 51
53 52
54 /* perl module support */ 53 /* perl module support */
55 extern void xs_init _((void)); 54 extern void xs_init _((void));
56 extern void boot_DynaLoader _((CV * cv)); /* perl is so wacky */ 55 extern void boot_DynaLoader _((CV * cv)); /* perl is so wacky */
80 79
81 static GList *perl_list = NULL; /* should probably extern this at some point */ 80 static GList *perl_list = NULL; /* should probably extern this at some point */
82 static GList *perl_timeout_handlers = NULL; 81 static GList *perl_timeout_handlers = NULL;
83 static GList *perl_event_handlers = NULL; 82 static GList *perl_event_handlers = NULL;
84 static PerlInterpreter *my_perl = NULL; 83 static PerlInterpreter *my_perl = NULL;
85 static char* last_dir = NULL;
86 static void perl_init(); 84 static void perl_init();
87 85
88 /* dealing with gaim */ 86 /* dealing with gaim */
89 XS(XS_GAIM_register); /* set up hooks for script */ 87 XS(XS_GAIM_register); /* set up hooks for script */
90 XS(XS_GAIM_get_info); /* version, last to attempt signon, protocol */ 88 XS(XS_GAIM_get_info); /* version, last to attempt signon, protocol */
255 } 253 }
256 254
257 while (perl_timeout_handlers) { 255 while (perl_timeout_handlers) {
258 thn = perl_timeout_handlers->data; 256 thn = perl_timeout_handlers->data;
259 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn); 257 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, thn);
260 gtk_timeout_remove(thn->iotag); 258 g_source_remove(thn->iotag);
261 g_free(thn->handler_name); 259 g_free(thn->handler_name);
262 g_free(thn); 260 g_free(thn);
263 } 261 }
264 262
265 while (perl_event_handlers) { 263 while (perl_event_handlers) {
679 perl_event_handlers = g_list_append(perl_event_handlers, handler); 677 perl_event_handlers = g_list_append(perl_event_handlers, handler);
680 debug_printf("registered perl event handler for %s\n", handler->event_type); 678 debug_printf("registered perl event handler for %s\n", handler->event_type);
681 XSRETURN_EMPTY; 679 XSRETURN_EMPTY;
682 } 680 }
683 681
684 static int perl_timeout(struct _perl_timeout_handlers *handler) 682 static int perl_timeout(gpointer data)
685 { 683 {
684 struct _perl_timeout_handlers *handler = data;
686 execute_perl(handler->handler_name, ""); 685 execute_perl(handler->handler_name, "");
687 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, handler); 686 perl_timeout_handlers = g_list_remove(perl_timeout_handlers, handler);
688 g_free(handler->handler_name); 687 g_free(handler->handler_name);
689 g_free(handler); 688 g_free(handler);
690 689
702 handler = g_new0(struct _perl_timeout_handlers, 1); 701 handler = g_new0(struct _perl_timeout_handlers, 1);
703 timeout = 1000 * SvIV(ST(0)); 702 timeout = 1000 * SvIV(ST(0));
704 debug_printf("Adding timeout for %d seconds.\n", timeout/1000); 703 debug_printf("Adding timeout for %d seconds.\n", timeout/1000);
705 handler->handler_name = g_strdup(SvPV(ST(1), junk)); 704 handler->handler_name = g_strdup(SvPV(ST(1), junk));
706 perl_timeout_handlers = g_list_append(perl_timeout_handlers, handler); 705 perl_timeout_handlers = g_list_append(perl_timeout_handlers, handler);
707 handler->iotag = gtk_timeout_add(timeout, (GtkFunction)perl_timeout, handler); 706 handler->iotag = g_timeout_add(timeout, perl_timeout, handler);
708 XSRETURN_EMPTY; 707 XSRETURN_EMPTY;
709 } 708 }
710 709
711 static GtkWidget *config = NULL; 710 extern void unload_perl_scripts()
712
713 static void cfdes(GtkWidget *m, gpointer n) {
714 if (config) gtk_widget_destroy(config);
715 config = NULL;
716 }
717
718 static void do_load(GtkWidget *m, gpointer n) {
719 const char *file = gtk_file_selection_get_filename(GTK_FILE_SELECTION(config));
720 gchar *f = NULL;
721 if (!file || !strlen(file)) {
722 perl_end();
723 perl_init();
724 return;
725 }
726
727 if (file_is_dir(file, config)) {
728 return;
729 }
730
731 if (last_dir) {
732 g_free(last_dir);
733 }
734 last_dir = g_dirname(file);
735
736 debug_printf("Loading perl script: %s\n", file);
737
738 f = g_strdup(file);
739 perl_load_file(f);
740 g_free(f);
741 cfdes(config, NULL);
742 }
743
744 void load_perl_script(GtkWidget *w, gpointer d)
745 {
746 char *buf, *temp;
747
748 if (config) {
749 gtk_widget_show(config);
750 gdk_window_raise(config->window);
751 return;
752 }
753
754 /* Below is basically stolen from plugins.c */
755 config = gtk_file_selection_new(_("Gaim - Select Perl Script"));
756
757 gtk_file_selection_hide_fileop_buttons(GTK_FILE_SELECTION(config));
758
759 if (!last_dir) {
760 temp = gaim_user_dir();
761 buf = g_strconcat(temp, G_DIR_SEPARATOR_S, NULL);
762 g_free(temp);
763 } else {
764 buf = g_strconcat(last_dir, G_DIR_SEPARATOR_S, NULL);
765 }
766
767 gtk_file_selection_set_filename(GTK_FILE_SELECTION(config), buf);
768 gtk_file_selection_complete(GTK_FILE_SELECTION(config), "*.pl");
769 gtk_signal_connect(GTK_OBJECT(config), "destroy", GTK_SIGNAL_FUNC(cfdes),
770 config);
771
772 gtk_signal_connect(GTK_OBJECT(GTK_FILE_SELECTION(config)->ok_button),
773 "clicked", GTK_SIGNAL_FUNC(do_load), NULL);
774
775 gtk_signal_connect(GTK_OBJECT(GTK_FILE_SELECTION(config)->cancel_button),
776 "clicked", GTK_SIGNAL_FUNC(cfdes), NULL);
777
778 g_free(buf);
779 gtk_widget_show(config);
780 gdk_window_raise(config->window);
781 }
782
783 extern void unload_perl_scripts(GtkWidget *w, gpointer d)
784 { 711 {
785 perl_end(); 712 perl_end();
786 perl_init(); 713 perl_init();
787 } 714 }
788 715
789 extern void list_perl_scripts(GtkWidget *w, gpointer d) 716 extern void list_perl_scripts()
790 { 717 {
791 GList *s = perl_list; 718 GList *s = perl_list;
792 struct perlscript *p; 719 struct perlscript *p;
793 char buf[BUF_LONG * 4]; 720 char buf[BUF_LONG * 4];
794 int at = 0; 721 int at = 0;

mercurial