[Commits] perl_plugin.c 1.19.2.38 1.19.2.39

[holger at claws-mail.org]

Update of /home/claws-mail/plugins/perl/src
In directory srv:/tmp/cvs-serv15146/src

Modified Files:
      Tag: gtk2
	perl_plugin.c 
Log Message:
2012-12-29 [holger]	0.9.20cvs1

	* cm_perl.pod
	* src/perl_plugin.c
		Add tag actions analogous to the builtin filtering engine 

Index: perl_plugin.c
===================================================================
RCS file: /home/claws-mail/plugins/perl/src/perl_plugin.c,v
retrieving revision 1.19.2.38
retrieving revision 1.19.2.39
diff -u -d -r1.19.2.38 -r1.19.2.39
--- perl_plugin.c	18 Aug 2012 18:41:37 -0000	1.19.2.38
+++ perl_plugin.c	29 Dec 2012 01:39:41 -0000	1.19.2.39
@@ -39,11 +39,12 @@
 #include "addr_compl.h"
 #include "statusbar.h"
 #include "alertpanel.h"
-#include "hooks.h"
+#include "common/hooks.h"
 #include "prefs_common.h"
 #include "prefs_gtk.h"
-#include "log.h"
-#include "plugin.h"
+#include "common/log.h"
+#include "common/plugin.h"
+#include "common/tags.h"
 
 #include <EXTERN.h>
 #include <perl.h>
@@ -884,6 +885,69 @@
     XSRETURN_NO;
 }
 
+/* ClawsMail::C::set_tag(char*) */
+static XS(XS_ClawsMail_set_tag)
+{
+  gchar *tag_str;
+  gint tag_id;
+
+  dXSARGS;
+  if(items != 1) {
+    g_warning("Perl Plugin: Wrong number of arguments to ClawsMail::C::set_tag");
+    XSRETURN_UNDEF;
+  }
+
+  tag_str = SvPV_nolen(ST(0));
+  tag_id = tags_get_id_for_str(tag_str);
+  if(tag_id == -1) {
+    g_warning("Perl Plugin: set_tag requested setting of a non-existing tag");
+    XSRETURN_UNDEF;
+  }
+
+  procmsg_msginfo_update_tags(msginfo, TRUE, tag_id);
+
+  XSRETURN_YES;
+}
+
+/* ClawsMail::C::unset_tag(char*) */
+static XS(XS_ClawsMail_unset_tag)
+{
+  gchar *tag_str;
+  gint tag_id;
+
+  dXSARGS;
+  if(items != 1) {
+    g_warning("Perl Plugin: Wrong number of arguments to ClawsMail::C::unset_tag");
+    XSRETURN_UNDEF;
+  }
+
+  tag_str = SvPV_nolen(ST(0));
+  tag_id = tags_get_id_for_str(tag_str);
+  if(tag_id == -1) {
+    g_warning("Perl Plugin: unset_tag requested setting of a non-existing tag");
+    XSRETURN_UNDEF;
+  }
+
+  procmsg_msginfo_update_tags(msginfo, FALSE, tag_id);
+
+  XSRETURN_YES;
+}
+
+/* ClawsMail::C::clear_tags() */
+static XS(XS_ClawsMail_clear_tags)
+{
+  dXSARGS;
+  if(items != 0) {
+    g_warning("Perl Plugin: Wrong number of arguments to ClawsMail::C::clear_tags");
+    XSRETURN_UNDEF;
+  }
+
+  procmsg_msginfo_clear_tags(msginfo);
+  XSRETURN_YES;
+}
+
+
+
 /* ClawsMail::C::make_sure_folder_exists(char*) */
 static XS(XS_ClawsMail_make_sure_folder_exists)
 {
@@ -1409,6 +1473,9 @@
   newXS("ClawsMail::C::hide",         XS_ClawsMail_hide,         "ClawsMail::C");
   newXS("ClawsMail::C::forward",      XS_ClawsMail_forward,      "ClawsMail::C");
   newXS("ClawsMail::C::redirect",     XS_ClawsMail_redirect,     "ClawsMail::C");
+  newXS("ClawsMail::C::set_tag",      XS_ClawsMail_set_tag,      "ClawsMail::C");
+  newXS("ClawsMail::C::unset_tag",    XS_ClawsMail_unset_tag,    "ClawsMail::C");
+  newXS("ClawsMail::C::clear_tags",   XS_ClawsMail_clear_tags,   "ClawsMail::C");
   newXS("ClawsMail::C::make_sure_folder_exists",
 	XS_ClawsMail_make_sure_folder_exists,"ClawsMail::C");
   newXS("ClawsMail::C::addr_in_addressbook",
@@ -1904,6 +1971,7 @@
 "	       qw(lock unlock move copy color execute),\n"
 "	       qw(hide set_score change_score stop exit),\n"
 "	       qw(forward forward_as_attachment redirect),\n"
+"        qw(set_tag unset_tag clear_tags),\n"
 "	       );\n"
 "our %colors = ('none'     =>  0,'orange' =>  1,\n"
 "    	       'red'      =>  2,'pink'   =>  3,\n"
@@ -1954,6 +2022,9 @@
 "    $color = 0 if $color =~ m/\\D/;\n"
 "    ClawsMail::C::color($color);\n"
 "}\n"
+"sub set_tag { ClawsMail::C::set_tag(@_);}\n"
+"sub unset_tag { ClawsMail::C::unset_tag(@_);}\n"
+"sub clear_tags { ClawsMail::C::clear_tags(@_);}\n"
 "1;\n"
   };
   const char perl_utils[] = {