diff --git a/guile/Makefile.am b/guile/Makefile.am index 888d27f3..be6758f6 100644 --- a/guile/Makefile.am +++ b/guile/Makefile.am @@ -36,14 +36,17 @@ lib_LTLIBRARIES= \ libguile_mu_la_SOURCES= \ mu-guile.c \ - mu-guile.h + mu-guile.h \ + mu-guile-message.c \ + mu-guile-message.h libguile_mu_la_LIBADD= \ ${top_builddir}/src/libmu.la \ ${GUILE_LIBS} XFILES= \ - mu-guile.x + mu-guile.x \ + mu-guile-message.x info_TEXINFOS= \ mu-guile.texi diff --git a/guile/mu-guile-message.c b/guile/mu-guile-message.c new file mode 100644 index 00000000..88d9152d --- /dev/null +++ b/guile/mu-guile-message.c @@ -0,0 +1,543 @@ +/* +** Copyright (C) 2011 Dirk-Jan C. Binnema +** +** This program is free software; you can redistribute it and/or modify it +** under the terms of the GNU General Public License as published by the +** Free Software Foundation; either version 3, or (at your option) any +** later version. +** +** This program is distributed in the hope that it will be useful, +** but WITHOUT ANY WARRANTY; without even the implied warranty of +** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +** GNU General Public License for more details. +** +** You should have received a copy of the GNU General Public License +** along with this program; if not, write to the Free Software Foundation, +** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +** +*/ + +#if HAVE_CONFIG_H +#include +#endif /*HAVE_CONFIG_H*/ + +#include +#include + +#include "mu-guile.h" + +#include +#include +#include +#include + + +struct _MuMsgWrapper { + MuMsg *_msg; + gboolean _unrefme; +}; +typedef struct _MuMsgWrapper MuMsgWrapper; +static long MSG_TAG; + +static gboolean +mu_guile_scm_is_msg (SCM scm) +{ + return SCM_NIMP(scm) && (long)SCM_CAR(scm) == MSG_TAG; +} + +SCM +mu_guile_msg_to_scm (MuMsg *msg) +{ + MuMsgWrapper *msgwrap; + + g_return_val_if_fail (msg, SCM_UNDEFINED); + + msgwrap = scm_gc_malloc (sizeof (MuMsgWrapper), "msg"); + msgwrap->_msg = msg; + msgwrap->_unrefme = FALSE; + + SCM_RETURN_NEWSMOB (MSG_TAG, msgwrap); +} + +static SCM +msg_mark (SCM msg_smob) +{ + MuMsgWrapper *msgwrap; + msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob); + + msgwrap->_unrefme = TRUE; + + return SCM_UNSPECIFIED; +} + +static size_t +msg_free (SCM msg_smob) +{ + MuMsgWrapper *msgwrap; + msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob); + + if (msgwrap->_unrefme) + mu_msg_unref (msgwrap->_msg); + + return sizeof (MuMsgWrapper); +} + +static int +msg_print (SCM msg_smob, SCM port, scm_print_state * pstate) +{ + MuMsgWrapper *msgwrap; + msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob); + + scm_puts ("#_msg), + port); + + scm_puts (">", port); + + return 1; +} + + + +/* SCM_DEFINE_PUBLIC (msg_make_from_file, "mu:msg:make-from-file", 1, 0, 0, */ +/* (SCM PATH), */ +/* "Create a message object based on the message in PATH.\n") */ +/* #define FUNC_NAME s_msg_make_from_file */ +/* { */ +/* MuMsg *msg; */ +/* GError *err; */ + +/* SCM_ASSERT (scm_is_string (PATH), PATH, SCM_ARG1, FUNC_NAME); */ + +/* err = NULL; */ +/* msg = mu_msg_new_from_file (scm_to_utf8_string (PATH), NULL, &err); */ + +/* if (err) { */ +/* mu_guile_g_error (FUNC_NAME, err); */ +/* g_error_free (err); */ +/* } */ + +/* return msg ? mu_guile_msg_to_scm (msg) : SCM_UNDEFINED; */ +/* } */ +/* #undef FUNC_NAME */ + + +/* SCM_DEFINE_PUBLIC (msg_move, "mu:msg:move-to-maildir", 2, 0, 0, */ +/* (SCM MSG, SCM TARGETMDIR), */ +/* "Move message to another maildir TARGETMDIR. Note that this the " */ +/* "base-level Maildir, ie. /home/user/Maildir/archive, and must" */ +/* " _not_ include the 'cur' or 'new' part. mu_msg_move_to_maildir " */ +/* "will make sure that the copy is from new/ to new/ and cur/ to " */ +/* "cur/. Also note that the target maildir must be on the same " */ +/* "filesystem. Returns #t if it worked, #f otherwise.\n") */ +/* #define FUNC_NAME s_msg_move */ +/* { */ +/* GError *err; */ +/* MuMsgWrapper *msgwrap; */ +/* gboolean rv; */ +/* MuFlags flags; */ + +/* SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); */ +/* SCM_ASSERT (scm_is_string (TARGETMDIR), TARGETMDIR, SCM_ARG2, FUNC_NAME); */ + +/* msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); */ + +/* err = NULL; */ +/* flags = mu_msg_get_flags (msgwrap->_msg); */ +/* rv = mu_msg_move_to_maildir (msgwrap->_msg, */ +/* scm_to_utf8_string (TARGETMDIR), flags, */ +/* FALSE, &err); */ +/* if (!rv && err) { */ +/* mu_guile_g_error (FUNC_NAME, err); */ +/* g_error_free (err); */ +/* } */ + +/* return rv ? SCM_BOOL_T : SCM_BOOL_F; */ +/* } */ +/* #undef FUNC_NAME */ + + + +struct _FlagData { + MuFlags flags; + SCM lst; +}; +typedef struct _FlagData FlagData; + + +static void +check_flag (MuFlags flag, FlagData *fdata) +{ + SCM item; + char *flagsym; + + if (!(fdata->flags & flag)) + return; + + flagsym = g_strconcat ("mu:", mu_flag_name(flag), NULL); + item = scm_list_1 (scm_from_locale_symbol(flagsym)); + + g_free (flagsym); + + fdata->lst = scm_append_x (scm_list_2(fdata->lst, item)); +} + + +static SCM +get_flags_scm (MuMsg *msg) +{ + FlagData fdata; + + fdata.flags = mu_msg_get_flags (msg); + fdata.lst = SCM_EOL; + + mu_flags_foreach ((MuFlagsForeachFunc)check_flag, &fdata); + + return fdata.lst; +} + + +static SCM +get_prio_scm (MuMsg *msg) +{ + switch (mu_msg_get_prio (msg)) { + + case MU_MSG_PRIO_LOW: + return scm_from_locale_symbol("mu:low"); + case MU_MSG_PRIO_NORMAL: + return scm_from_locale_symbol("mu:normal"); + case MU_MSG_PRIO_HIGH: + return scm_from_locale_symbol("mu:high"); + default: + g_return_val_if_reached (SCM_UNDEFINED); + } +} + +static SCM +msg_string_list_field (MuMsg *msg, MuMsgFieldId mfid) +{ + SCM scmlst; + const GSList *lst; + + lst = mu_msg_get_field_string_list (msg, mfid); + + for (scmlst = SCM_EOL; lst; + lst = g_slist_next(lst)) { + SCM item; + item = scm_list_1 + (scm_from_string_or_null((const char*)lst->data)); + scmlst = scm_append_x (scm_list_2(scmlst, item)); + } + + return scmlst; +} + + +SCM_DEFINE_PUBLIC(get_field, "mu:get-field", 2, 0, 0, + (SCM MSG, SCM FIELD), + "Get the field FIELD from message MSG.\n") +#define FUNC_NAME s_get_field +{ + MuMsgWrapper *msgwrap; + MuMsgFieldId mfid; + msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); + + SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_integer_p(FIELD), FIELD, SCM_ARG2, FUNC_NAME); + + mfid = scm_to_int (FIELD); + SCM_ASSERT (mfid < MU_MSG_FIELD_ID_NUM, FIELD, SCM_ARG2, FUNC_NAME); + + switch (mfid) { + case MU_MSG_FIELD_ID_PRIO: return get_prio_scm (msgwrap->_msg); + case MU_MSG_FIELD_ID_FLAGS: return get_flags_scm (msgwrap->_msg); + default: break; + } + + switch (mu_msg_field_type (mfid)) { + case MU_MSG_FIELD_TYPE_STRING: + return scm_from_string_or_null + (mu_msg_get_field_string(msgwrap->_msg, mfid)); + case MU_MSG_FIELD_TYPE_BYTESIZE: + case MU_MSG_FIELD_TYPE_TIME_T: + return scm_from_uint ( + mu_msg_get_field_numeric (msgwrap->_msg, mfid)); + case MU_MSG_FIELD_TYPE_INT: + return scm_from_int ( + mu_msg_get_field_numeric (msgwrap->_msg, mfid)); + case MU_MSG_FIELD_TYPE_STRING_LIST: + return msg_string_list_field (msgwrap->_msg, mfid); + default: + SCM_ASSERT (0, FIELD, SCM_ARG2, FUNC_NAME); + } +} +#undef FUNC_NAME + + + +struct _EachContactData { + SCM lst; + MuMsgContactType ctype; +}; +typedef struct _EachContactData EachContactData; + +static void +contacts_to_list (MuMsgContact *contact, EachContactData *ecdata) +{ + if (ecdata->ctype == MU_MSG_CONTACT_TYPE_ALL || + mu_msg_contact_type (contact) == ecdata->ctype) { + + SCM item; + const char *addr, *name; + + addr = mu_msg_contact_address (contact); + name = mu_msg_contact_name (contact); + + item = scm_list_1 + (scm_cons ( + scm_from_string_or_null(name), + scm_from_string_or_null(addr))); + + ecdata->lst = scm_append_x (scm_list_2(ecdata->lst, item)); + } +} + + + +SCM_DEFINE_PUBLIC (get_contacts, "mu:get-contacts", 2, 0, 0, + (SCM MSG, SCM CONTACT_TYPE), + "Get a list of contact information pairs.\n") +#define FUNC_NAME s_get_contacts +{ + MuMsgWrapper *msgwrap; + EachContactData ecdata; + + SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_integer_p (CONTACT_TYPE) || scm_is_bool(CONTACT_TYPE), + CONTACT_TYPE, SCM_ARG2, FUNC_NAME); + + if (CONTACT_TYPE == SCM_BOOL_F) + return SCM_UNSPECIFIED; /* nothing to do */ + else if (CONTACT_TYPE == SCM_BOOL_T) + ecdata.ctype = MU_MSG_CONTACT_TYPE_ALL; + else { + MuMsgFieldId mfid; + mfid = scm_to_uint (CONTACT_TYPE); + switch (mfid) { + case MU_MSG_FIELD_ID_TO: ecdata.ctype = MU_MSG_CONTACT_TYPE_TO; break; + case MU_MSG_FIELD_ID_FROM: ecdata.ctype = MU_MSG_CONTACT_TYPE_FROM; break; + case MU_MSG_FIELD_ID_CC: ecdata.ctype = MU_MSG_CONTACT_TYPE_CC; break; + case MU_MSG_FIELD_ID_BCC: ecdata.ctype = MU_MSG_CONTACT_TYPE_BCC; break; + default: g_return_val_if_reached (SCM_UNDEFINED); + } + } + + ecdata.lst = SCM_EOL; + msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); + mu_msg_contact_foreach (msgwrap->_msg, + (MuMsgContactForeachFunc)contacts_to_list, + &ecdata); + return ecdata.lst; +} +#undef FUNC_NAME + + + +SCM_DEFINE_PUBLIC (get_header, "mu:get-header", 2, 0, 0, + (SCM MSG, SCM HEADER), + "Get an arbitary HEADER from MSG.\n") +#define FUNC_NAME s_get_header +{ + MuMsgWrapper *msgwrap; + const char *header; + const char *val; + + SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_string (HEADER)||HEADER==SCM_UNDEFINED, + HEADER, SCM_ARG2, FUNC_NAME); + + msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); + header = scm_to_utf8_string (HEADER); + val = mu_msg_get_header(msgwrap->_msg, header); + + return val ? scm_from_string_or_null(val) : SCM_BOOL_F; +} +#undef FUNC_NAME + + + + + +static struct { + const char* name; + unsigned val; +} SYMPAIRS[] = { + + { "mu:high", MU_MSG_PRIO_HIGH }, + { "mu:low", MU_MSG_PRIO_LOW }, + { "mu:normal", MU_MSG_PRIO_NORMAL }, + + { "mu:new", MU_FLAG_NEW }, + { "mu:passed", MU_FLAG_PASSED }, + { "mu:replied", MU_FLAG_REPLIED }, + { "mu:seen", MU_FLAG_SEEN }, + { "mu:trashed", MU_FLAG_TRASHED }, + { "mu:draft", MU_FLAG_DRAFT }, + { "mu:flagged", MU_FLAG_FLAGGED }, + { "mu:signed", MU_FLAG_SIGNED }, + { "mu:encrypted", MU_FLAG_ENCRYPTED }, + { "mu:has-attach", MU_FLAG_HAS_ATTACH }, + { "mu:unread", MU_FLAG_UNREAD }, + + { "mu:bcc", MU_MSG_FIELD_ID_BCC }, + { "mu:body-html", MU_MSG_FIELD_ID_BODY_HTML }, + { "mu:body-txt", MU_MSG_FIELD_ID_BODY_TEXT }, + { "mu:cc", MU_MSG_FIELD_ID_CC }, + { "mu:date", MU_MSG_FIELD_ID_DATE }, + { "mu:flags", MU_MSG_FIELD_ID_FLAGS }, + { "mu:from", MU_MSG_FIELD_ID_FROM }, + { "mu:maildir", MU_MSG_FIELD_ID_MAILDIR }, + { "mu:message-id", MU_MSG_FIELD_ID_MSGID }, + { "mu:path", MU_MSG_FIELD_ID_PATH }, + { "mu:prio", MU_MSG_FIELD_ID_PRIO }, + { "mu:refs", MU_MSG_FIELD_ID_REFS }, + { "mu:size", MU_MSG_FIELD_ID_SIZE }, + { "mu:subject", MU_MSG_FIELD_ID_SUBJECT }, + { "mu:tags", MU_MSG_FIELD_ID_TAGS }, + { "mu:to", MU_MSG_FIELD_ID_TO }, +}; + + +static void +define_symbols (void) +{ + unsigned u; + + for (u = 0; u != G_N_ELEMENTS(SYMPAIRS); ++u) { + scm_c_define (SYMPAIRS[u].name, + scm_from_uint (SYMPAIRS[u].val)); + scm_c_export (SYMPAIRS[u].name, NULL); + } +} + + +/* gboolean */ +/* mu_guile_msg_load_current (const char *path) */ +/* { */ +/* MuMsg *msg; */ +/* GError *err; */ +/* SCM msgsmob; */ + +/* err = NULL; */ +/* msg = mu_msg_new_from_file (path, NULL, &err); */ + +/* if (!msg) { */ +/* g_printerr ("error creating message for '%s'", path); */ +/* if (err) { */ +/* g_printerr (": %s", err->message); */ +/* g_error_free (err); */ +/* } */ +/* g_printerr ("\n"); */ +/* return FALSE; */ +/* } */ + +/* msgsmob = mu_guile_msg_to_scm (msg); */ +/* scm_c_define ("mu:current-msg", msgsmob); */ + +/* return TRUE; */ +/* } */ + +static void +call_func (SCM FUNC, MuMsgIter *iter, const char* func_name) +{ + SCM msgsmob; + MuMsg *msg; + + msg = mu_msg_iter_get_msg_floating (iter); /* don't unref */ + + msgsmob = mu_guile_msg_to_scm (mu_msg_ref(msg)); + scm_call_1 (FUNC, msgsmob); +} + + +static MuMsgIter* +get_query_iter (MuQuery *query, const char* expr) +{ + MuMsgIter *iter; + GError *err; + + err = NULL; + iter = mu_query_run (query, expr, + FALSE, MU_MSG_FIELD_ID_NONE, TRUE, -1, &err); + if (!iter) { + mu_guile_g_error ("", err); + g_clear_error (&err); + } + + return iter; +} + + +SCM_DEFINE_PUBLIC (for_each_msg_internal, "mu:for-each-msg-internal", 2, 0, 0, + (SCM FUNC, SCM EXPR), +"Call FUNC for each msg in the message store matching EXPR. EXPR is " +"either a string containing a mu search expression or a boolean; in the former " +"case, limit the messages to only those matching the expression, in the " +"latter case, match /all/ messages if the EXPR equals #t, and match " +"none if EXPR equals #f. Note -- function for internal use.") +#define FUNC_NAME s_for_each_msg_internal +{ + MuMsgIter *iter; + const char* expr; + + SCM_ASSERT (scm_procedure_p (FUNC), FUNC, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_bool(EXPR) || scm_is_string (EXPR), + EXPR, SCM_ARG2, FUNC_NAME); + + if (!mu_guile_initialized()) + return mu_guile_error (FUNC_NAME, 0, "mu not initialized", + SCM_UNSPECIFIED); + + if (EXPR == SCM_BOOL_F) + return SCM_UNSPECIFIED; /* nothing to do */ + + if (EXPR == SCM_BOOL_T) + expr = ""; /* note, "" matches *all* messages */ + else + expr = scm_to_utf8_string(EXPR); + + iter = get_query_iter (mu_guile_instance()->query, expr); + if (!iter) + return SCM_UNSPECIFIED; + + while (!mu_msg_iter_is_done(iter)) { + + call_func (FUNC, iter, FUNC_NAME); + mu_msg_iter_next (iter); + } + + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME + + + +void* +mu_guile_message_init (void *data) +{ + MSG_TAG = scm_make_smob_type ("msg", sizeof(MuMsgWrapper)); + + scm_set_smob_mark (MSG_TAG, msg_mark); + scm_set_smob_free (MSG_TAG, msg_free); + scm_set_smob_print (MSG_TAG, msg_print); + + define_symbols (); + +#include "mu-guile-message.x" + + return NULL; +} diff --git a/guile/mu-guile-message.h b/guile/mu-guile-message.h new file mode 100644 index 00000000..5ce1130b --- /dev/null +++ b/guile/mu-guile-message.h @@ -0,0 +1,39 @@ +/* +** Copyright (C) 2011 Dirk-Jan C. Binnema +** +** This program is free software; you can redistribute it and/or modify it +** under the terms of the GNU General Public License as published by the +** Free Software Foundation; either version 3, or (at your option) any +** later version. +** +** This program is distributed in the hope that it will be useful, +** but WITHOUT ANY WARRANTY; without even the implied warranty of +** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +** GNU General Public License for more details. +** +** You should have received a copy of the GNU General Public License +** along with this program; if not, write to the Free Software Foundation, +** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. +** +*/ + +#ifndef __MU_GUILE_MESSAGE_H__ +#define __MU_GUILE_MESSAGE_H__ + +#include + +G_BEGIN_DECLS + +/** + * Initialize this mu guile module. + * + * @param data + * + * @return + */ +void* mu_guile_message_init (void *data); + + +G_END_DECLS + +#endif /*__MU_GUILE_MESSAGE_H__*/ diff --git a/guile/mu-guile.c b/guile/mu-guile.c index 78ae82a3..d6d63323 100644 --- a/guile/mu-guile.c +++ b/guile/mu-guile.c @@ -24,24 +24,26 @@ #include #include +#include +#include #include #include #include #include -#include -#include -struct _MuMsgWrapper { - MuMsg *_msg; - gboolean _unrefme; -}; -typedef struct _MuMsgWrapper MuMsgWrapper; - -static long MSG_TAG; +#include "mu-guile.h" -static SCM -mu_guile_util_error (const char *func_name, int status, + +SCM +scm_from_string_or_null (const char *str) +{ + return str ? scm_from_utf8_string (str) : SCM_BOOL_F; +} + + +SCM +mu_guile_error (const char *func_name, int status, const char *fmt, SCM args) { scm_error_scm (scm_from_locale_symbol ("MuError"), @@ -52,8 +54,8 @@ mu_guile_util_error (const char *func_name, int status, return SCM_UNSPECIFIED; } -static SCM -mu_guile_util_g_error (const char *func_name, GError *err) +SCM +mu_guile_g_error (const char *func_name, GError *err) { scm_error_scm (scm_from_locale_symbol ("MuError"), scm_from_utf8_string (func_name), @@ -64,438 +66,24 @@ mu_guile_util_g_error (const char *func_name, GError *err) } -static gboolean -mu_guile_scm_is_msg (SCM scm) -{ - return SCM_NIMP(scm) && (long)SCM_CAR(scm) == MSG_TAG; -} - -SCM -mu_guile_msg_to_scm (MuMsg *msg) -{ - MuMsgWrapper *msgwrap; - - g_return_val_if_fail (msg, SCM_UNDEFINED); - - msgwrap = scm_gc_malloc (sizeof (MuMsgWrapper), "msg"); - msgwrap->_msg = msg; - msgwrap->_unrefme = FALSE; - - SCM_RETURN_NEWSMOB (MSG_TAG, msgwrap); -} - -SCM_DEFINE_PUBLIC (msg_make_from_file, "mu:msg:make-from-file", 1, 0, 0, - (SCM PATH), - "Create a message object based on the message in PATH.\n") -#define FUNC_NAME s_msg_make_from_file -{ - MuMsg *msg; - GError *err; - - SCM_ASSERT (scm_is_string (PATH), PATH, SCM_ARG1, FUNC_NAME); - - err = NULL; - msg = mu_msg_new_from_file (scm_to_utf8_string (PATH), NULL, &err); - - if (err) { - mu_guile_util_g_error (FUNC_NAME, err); - g_error_free (err); - } - - return msg ? mu_guile_msg_to_scm (msg) : SCM_UNDEFINED; -} -#undef FUNC_NAME - - -/* SCM_DEFINE_PUBLIC (msg_move, "mu:msg:move-to-maildir", 2, 0, 0, */ -/* (SCM MSG, SCM TARGETMDIR), */ -/* "Move message to another maildir TARGETMDIR. Note that this the " */ -/* "base-level Maildir, ie. /home/user/Maildir/archive, and must" */ -/* " _not_ include the 'cur' or 'new' part. mu_msg_move_to_maildir " */ -/* "will make sure that the copy is from new/ to new/ and cur/ to " */ -/* "cur/. Also note that the target maildir must be on the same " */ -/* "filesystem. Returns #t if it worked, #f otherwise.\n") */ -/* #define FUNC_NAME s_msg_move */ -/* { */ -/* GError *err; */ -/* MuMsgWrapper *msgwrap; */ -/* gboolean rv; */ -/* MuFlags flags; */ - -/* SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); */ -/* SCM_ASSERT (scm_is_string (TARGETMDIR), TARGETMDIR, SCM_ARG2, FUNC_NAME); */ - -/* msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); */ - -/* err = NULL; */ -/* flags = mu_msg_get_flags (msgwrap->_msg); */ -/* rv = mu_msg_move_to_maildir (msgwrap->_msg, */ -/* scm_to_utf8_string (TARGETMDIR), flags, */ -/* FALSE, &err); */ -/* if (!rv && err) { */ -/* mu_guile_util_g_error (FUNC_NAME, err); */ -/* g_error_free (err); */ -/* } */ - -/* return rv ? SCM_BOOL_T : SCM_BOOL_F; */ -/* } */ -/* #undef FUNC_NAME */ - - -static SCM -scm_from_string_or_null (const char *str) -{ - return str ? scm_from_utf8_string (str) : SCM_BOOL_F; -} - - -struct _FlagData { - MuFlags flags; - SCM lst; -}; -typedef struct _FlagData FlagData; - - -static void -check_flag (MuFlags flag, FlagData *fdata) -{ - if (fdata->flags & flag) { - SCM item; - char *flagsym; - - flagsym = g_strconcat ("mu:", mu_flag_name(flag), NULL); - item = scm_list_1 (scm_from_locale_symbol(flagsym)); - g_free (flagsym); - - fdata->lst = scm_append_x (scm_list_2(fdata->lst, item)); - } -} - - -static SCM -get_flags_scm (MuMsg *msg) -{ - FlagData fdata; - - fdata.flags = mu_msg_get_flags (msg); - fdata.lst = SCM_EOL; - mu_flags_foreach ((MuFlagsForeachFunc)check_flag, &fdata); - - return fdata.lst; -} - - -static SCM -get_prio_scm (MuMsg *msg) -{ - switch (mu_msg_get_prio (msg)) { - case MU_MSG_PRIO_LOW: return scm_from_locale_symbol("mu:low"); - case MU_MSG_PRIO_NORMAL: return scm_from_locale_symbol("mu:normal"); - case MU_MSG_PRIO_HIGH: return scm_from_locale_symbol("mu:high"); - default: g_return_val_if_reached (SCM_UNDEFINED); - } -} - -static SCM -msg_string_list_field (MuMsg *msg, MuMsgFieldId mfid) -{ - SCM scmlst; - const GSList *lst; - - lst = mu_msg_get_field_string_list (msg, mfid); - - for (scmlst = SCM_EOL; lst; - lst = g_slist_next(lst)) { - SCM item; - item = scm_list_1 - (scm_from_string_or_null((const char*)lst->data)); - scmlst = scm_append_x (scm_list_2(scmlst, item)); - } - - return scmlst; -} - - -SCM_DEFINE_PUBLIC(msg_field, "mu:msg:field", 2, 0, 0, - (SCM MSG, SCM FIELD), - "Get the field FIELD from message MSG.\n") -#define FUNC_NAME s_msg_field -{ - MuMsgWrapper *msgwrap; - MuMsgFieldId mfid; - msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); - - SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); - SCM_ASSERT (scm_integer_p(FIELD), FIELD, SCM_ARG2, FUNC_NAME); - - mfid = scm_to_int (FIELD); - SCM_ASSERT (mfid < MU_MSG_FIELD_ID_NUM, FIELD, SCM_ARG2, FUNC_NAME); - - switch (mfid) { - case MU_MSG_FIELD_ID_PRIO: return get_prio_scm (msgwrap->_msg); - case MU_MSG_FIELD_ID_FLAGS: return get_flags_scm (msgwrap->_msg); - default: break; - } - - switch (mu_msg_field_type (mfid)) { - case MU_MSG_FIELD_TYPE_STRING: - return scm_from_string_or_null - (mu_msg_get_field_string(msgwrap->_msg, mfid)); - case MU_MSG_FIELD_TYPE_BYTESIZE: - case MU_MSG_FIELD_TYPE_TIME_T: - return scm_from_uint ( - mu_msg_get_field_numeric (msgwrap->_msg, mfid)); - case MU_MSG_FIELD_TYPE_INT: - return scm_from_int ( - mu_msg_get_field_numeric (msgwrap->_msg, mfid)); - case MU_MSG_FIELD_TYPE_STRING_LIST: - return msg_string_list_field (msgwrap->_msg, mfid); - default: - SCM_ASSERT (0, FIELD, SCM_ARG2, FUNC_NAME); - } -} -#undef FUNC_NAME - - - -struct _EachContactData { - SCM lst; - MuMsgContactType ctype; -}; -typedef struct _EachContactData EachContactData; - -static void -contacts_to_list (MuMsgContact *contact, EachContactData *ecdata) -{ - if (ecdata->ctype == MU_MSG_CONTACT_TYPE_ALL || - mu_msg_contact_type (contact) == ecdata->ctype) { - - SCM item; - const char *addr, *name; - - addr = mu_msg_contact_address (contact); - name = mu_msg_contact_name (contact); - - item = scm_list_1 - (scm_cons ( - scm_from_string_or_null(name), - scm_from_string_or_null(addr))); - - ecdata->lst = scm_append_x (scm_list_2(ecdata->lst, item)); - } -} - - - -SCM_DEFINE_PUBLIC (msg_contacts, "mu:msg:contacts", 2, 0, 0, - (SCM MSG, SCM CONTACT_TYPE), "Get a list of contact information pairs.\n") -#define FUNC_NAME s_msg_contacts -{ - MuMsgWrapper *msgwrap; - EachContactData ecdata; - - SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); - SCM_ASSERT (scm_integer_p (CONTACT_TYPE) || scm_is_bool(CONTACT_TYPE), - CONTACT_TYPE, SCM_ARG2, FUNC_NAME); - - if (CONTACT_TYPE == SCM_BOOL_F) - return SCM_UNSPECIFIED; /* nothing to do */ - else if (CONTACT_TYPE == SCM_BOOL_T) - ecdata.ctype = MU_MSG_CONTACT_TYPE_ALL; - else { - MuMsgFieldId mfid; - mfid = scm_to_uint (CONTACT_TYPE); - switch (mfid) { - case MU_MSG_FIELD_ID_TO: ecdata.ctype = MU_MSG_CONTACT_TYPE_TO; break; - case MU_MSG_FIELD_ID_FROM: ecdata.ctype = MU_MSG_CONTACT_TYPE_FROM; break; - case MU_MSG_FIELD_ID_CC: ecdata.ctype = MU_MSG_CONTACT_TYPE_CC; break; - case MU_MSG_FIELD_ID_BCC: ecdata.ctype = MU_MSG_CONTACT_TYPE_BCC; break; - default: g_return_val_if_reached (SCM_UNDEFINED); - } - } - - ecdata.lst = SCM_EOL; - msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); - mu_msg_contact_foreach (msgwrap->_msg, - (MuMsgContactForeachFunc)contacts_to_list, - &ecdata); - return ecdata.lst; -} -#undef FUNC_NAME - - - -SCM_DEFINE_PUBLIC (msg_header, "mu:msg:header", 2, 0, 0, - (SCM MSG, SCM HEADER), "Get an arbitary HEADER from MSG.\n") -#define FUNC_NAME s_msg_header -{ - MuMsgWrapper *msgwrap; - const char *header; - const char *val; - - SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); - SCM_ASSERT (scm_is_string (HEADER)||HEADER==SCM_UNDEFINED, - HEADER, SCM_ARG2, FUNC_NAME); - - msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); - header = scm_to_utf8_string (HEADER); - val = mu_msg_get_header(msgwrap->_msg, header); - - return val ? scm_from_string_or_null(val) : SCM_BOOL_F; -} -#undef FUNC_NAME - - - -static SCM -msg_mark (SCM msg_smob) -{ - MuMsgWrapper *msgwrap; - msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob); - - msgwrap->_unrefme = TRUE; - - return SCM_UNSPECIFIED; -} - -static size_t -msg_free (SCM msg_smob) -{ - MuMsgWrapper *msgwrap; - msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob); - - if (msgwrap->_unrefme) - mu_msg_unref (msgwrap->_msg); - - return sizeof (MuMsgWrapper); -} - -static int -msg_print (SCM msg_smob, SCM port, scm_print_state * pstate) -{ - MuMsgWrapper *msgwrap; - msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob); - - scm_puts ("#_msg), - port); - - scm_puts (">", port); - - return 1; -} - - -static struct { - const char* name; - unsigned val; -} SYMPAIRS[] = { - { "mu:high", MU_MSG_PRIO_HIGH }, - { "mu:low", MU_MSG_PRIO_LOW }, - { "mu:normal", MU_MSG_PRIO_NORMAL }, - - { "mu:new", MU_FLAG_NEW }, - { "mu:passed", MU_FLAG_PASSED }, - { "mu:replied", MU_FLAG_REPLIED }, - { "mu:seen", MU_FLAG_SEEN }, - { "mu:trashed", MU_FLAG_TRASHED }, - { "mu:draft", MU_FLAG_DRAFT }, - { "mu:flagged", MU_FLAG_FLAGGED }, - { "mu:signed", MU_FLAG_SIGNED }, - { "mu:encrypted", MU_FLAG_ENCRYPTED }, - { "mu:has-attach", MU_FLAG_HAS_ATTACH }, - { "mu:unread", MU_FLAG_UNREAD }, - - /* { "mu:embedded-text", MU_MSG_FIELD_ID_EMBEDDED_TEXT }, */ - /* { "mu:file", MU_MSG_FIELD_ID_FILE }, */ - /* { "mu:mime", MU_MSG_FIELD_ID_MIME }, */ - { "mu:bcc", MU_MSG_FIELD_ID_BCC }, - { "mu:body-html", MU_MSG_FIELD_ID_BODY_HTML }, - { "mu:body-txt", MU_MSG_FIELD_ID_BODY_TEXT }, - { "mu:cc", MU_MSG_FIELD_ID_CC }, - { "mu:date", MU_MSG_FIELD_ID_DATE }, - { "mu:flags", MU_MSG_FIELD_ID_FLAGS }, - { "mu:from", MU_MSG_FIELD_ID_FROM }, - { "mu:maildir", MU_MSG_FIELD_ID_MAILDIR }, - { "mu:message-id", MU_MSG_FIELD_ID_MSGID }, - { "mu:path", MU_MSG_FIELD_ID_PATH }, - { "mu:prio", MU_MSG_FIELD_ID_PRIO }, - { "mu:refs", MU_MSG_FIELD_ID_REFS }, - { "mu:size", MU_MSG_FIELD_ID_SIZE }, - { "mu:subject", MU_MSG_FIELD_ID_SUBJECT }, - { "mu:tags", MU_MSG_FIELD_ID_TAGS }, - { "mu:to", MU_MSG_FIELD_ID_TO }, -}; - - -static void -define_symbols (void) -{ - unsigned u; - - for (u = 0; u != G_N_ELEMENTS(SYMPAIRS); ++u) { - scm_c_define (SYMPAIRS[u].name, - scm_from_uint (SYMPAIRS[u].val)); - scm_c_export (SYMPAIRS[u].name, NULL); - } -} - - -/* gboolean */ -/* mu_guile_msg_load_current (const char *path) */ -/* { */ -/* MuMsg *msg; */ -/* GError *err; */ -/* SCM msgsmob; */ - -/* err = NULL; */ -/* msg = mu_msg_new_from_file (path, NULL, &err); */ - -/* if (!msg) { */ -/* g_printerr ("error creating message for '%s'", path); */ -/* if (err) { */ -/* g_printerr (": %s", err->message); */ -/* g_error_free (err); */ -/* } */ -/* g_printerr ("\n"); */ -/* return FALSE; */ -/* } */ - -/* msgsmob = mu_guile_msg_to_scm (msg); */ -/* scm_c_define ("mu:current-msg", msgsmob); */ - -/* return TRUE; */ -/* } */ - - -struct _MuData { - MuQuery *_query; -}; -typedef struct _MuData MuData; - -static MuData *MU_DATA = NULL; +/* there can be only one */ +static MuGuile *_singleton = NULL; static gboolean -init_mu (const char *muhome) +mu_guile_init_instance (const char *muhome) { MuStore *store; MuQuery *query; GError *err; - g_return_val_if_fail (!MU_DATA, FALSE); - if (!mu_runtime_init (muhome, "guile")) return FALSE; store = mu_store_new_read_only (mu_runtime_path(MU_RUNTIME_PATH_XAPIANDB), &err); if (!store) { - mu_guile_util_g_error (__FUNCTION__, err); + mu_guile_g_error (__FUNCTION__, err); g_clear_error (&err); return FALSE; } @@ -503,58 +91,76 @@ init_mu (const char *muhome) query = mu_query_new (store, &err); mu_store_unref (store); if (!query) { - mu_guile_util_g_error (__FUNCTION__, err); + mu_guile_g_error (__FUNCTION__, err); g_clear_error (&err); return FALSE; } - MU_DATA = g_new0 (MuData, 1); - MU_DATA->_query = query; + _singleton = g_new0 (MuGuile, 1); + _singleton->query = query; return TRUE; } static void -uninit_mu (void) +mu_guile_uninit_instance (void) { - g_return_if_fail (MU_DATA); + g_return_if_fail (_singleton); - mu_query_destroy (MU_DATA->_query); - g_free (MU_DATA); + mu_query_destroy (_singleton->query); + g_free (_singleton); - MU_DATA = NULL; + _singleton = NULL; mu_runtime_uninit (); } -SCM_DEFINE_PUBLIC (mu_initialize, "mu:initialize", 0, 1, 0, - (SCM MUHOME), - "Initialize mu - needed before you call any of the other " - "functions. Optionally, you can provide MUHOME which " - "should be an absolute path to your mu home directory " - "(typically, the default, ~/.mu, should be just fine)") +MuGuile* +mu_guile_instance (void) +{ + g_return_val_if_fail (_singleton, NULL); + return _singleton; +} + +gboolean +mu_guile_initialized (void) +{ + return _singleton != NULL; +} + + + +SCM_DEFINE_PUBLIC (mu_initialize, "mu:initialize", 0, 2, 0, + (SCM PARAM, SCM MUHOME), +"Initialize mu - needed before you call any of the other " +"functions. Optionally, you can provide PARAM (must be #t for now if " +"provided, for future use) and MUHOME which should be an absolute path " +"to your mu home directory " +"-- typically, the default, ~/.mu, should be just fine\n.") #define FUNC_NAME s_mu_initialize { const char *muhome; + SCM_ASSERT (PARAM == SCM_BOOL_T || SCM_UNBNDP(PARAM), + PARAM, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_string (MUHOME) || MUHOME == SCM_BOOL_F || SCM_UNBNDP(MUHOME), - MUHOME, SCM_ARG1, FUNC_NAME); + MUHOME, SCM_ARG2, FUNC_NAME); - if (MU_DATA) - return mu_guile_util_error (FUNC_NAME, 0, "Already initialized", - SCM_BOOL_F); + if (mu_guile_initialized()) + return mu_guile_error (FUNC_NAME, 0, "Already initialized", + SCM_UNSPECIFIED); if (SCM_UNBNDP(MUHOME) || MUHOME == SCM_BOOL_F) muhome = NULL; else muhome = scm_to_utf8_string (MUHOME); - if (!init_mu (muhome)) - return mu_guile_util_error (FUNC_NAME, 0, "Failed to initialize mu", - SCM_BOOL_F); + if (!mu_guile_init_instance(muhome)) + return mu_guile_error (FUNC_NAME, 0, "Failed to initialize mu", + SCM_UNSPECIFIED); /* cleanup when we're exiting */ - g_atexit (uninit_mu); + g_atexit (mu_guile_uninit_instance); return SCM_UNSPECIFIED; } @@ -565,92 +171,14 @@ SCM_DEFINE_PUBLIC (mu_initialized_p, "mu:initialized?", 0, 0, 0, (void), "Whether mu is initialized or not.\n") #define FUNC_NAME s_mu_initialized_p { - return MU_DATA ? SCM_BOOL_T : SCM_BOOL_F; + return mu_guile_initialized() ? SCM_BOOL_T : SCM_BOOL_F; } #undef FUNC_NAME -static MuMsgIter* -get_query_iter (MuQuery *query, const char* expr) -{ - MuMsgIter *iter; - GError *err; - - err = NULL; - iter = mu_query_run (query, expr, - FALSE, MU_MSG_FIELD_ID_NONE, TRUE, -1, &err); - if (!iter) { - mu_guile_util_g_error ("", err); - g_clear_error (&err); - } - - return iter; -} - - -static void -call_func (SCM FUNC, MuMsgIter *iter, const char* func_name) -{ - SCM msgsmob; - MuMsg *msg; - - msg = mu_msg_iter_get_msg_floating (iter); /* don't unref */ - - msgsmob = mu_guile_msg_to_scm (mu_msg_ref(msg)); - scm_call_1 (FUNC, msgsmob); -} - - -SCM_DEFINE_PUBLIC (for_each_message, "mu:internal:for-each-message", 2, 0, 0, - (SCM FUNC, SCM EXPR), - "Call FUNC for each message in the message store. EXPR is either a " -"string containing a mu search expression or a boolean; in the former " -"case, limit the messages to only those matching the expression, in the " -"latter case, match /all/ messages if the EXPR equals #t, and match " -"none if EXPR equals #f.") -#define FUNC_NAME s_for_each_message -{ - MuMsgIter *iter; - const char* expr; - - SCM_ASSERT (scm_procedure_p (FUNC), FUNC, SCM_ARG1, FUNC_NAME); - SCM_ASSERT (scm_is_bool(EXPR) || scm_is_string (EXPR), - EXPR, SCM_ARG2, FUNC_NAME); - - if (!MU_DATA) - return mu_guile_util_error (FUNC_NAME, 0, "mu not initialized", - SCM_UNDEFINED); - if (EXPR == SCM_BOOL_F) - return SCM_UNSPECIFIED; /* nothing to do */ - else if (EXPR == SCM_BOOL_T) - expr = ""; /* note, "" matches *all* messages */ - else - expr = scm_to_utf8_string(EXPR); - - iter = get_query_iter (MU_DATA->_query, expr); - if (!iter) - return SCM_UNSPECIFIED; - - while (!mu_msg_iter_is_done(iter)) { - call_func (FUNC, iter, FUNC_NAME); - mu_msg_iter_next (iter); - } - - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - - -enum _LogType { - LOG_INFO, - LOG_WARNING, - LOG_CRITICAL -}; -typedef enum _LogType LogType; - static SCM -write_log (LogType logtype, SCM FRM, SCM ARGS) +write_log (GLogLevelFlags level, SCM FRM, SCM ARGS) #define FUNC_NAME __FUNCTION__ { SCM str; @@ -664,12 +192,7 @@ write_log (LogType logtype, SCM FRM, SCM ARGS) gchar *output; output = scm_to_utf8_string (str); - - switch (logtype) { - case LOG_INFO: g_message ("%s", output); break; - case LOG_WARNING: g_warning ("%s", output); break; - case LOG_CRITICAL: g_critical ("%s", output); break; - } + g_log (G_LOG_DOMAIN, level, "%s", output); } return SCM_UNSPECIFIED; @@ -678,47 +201,37 @@ write_log (LogType logtype, SCM FRM, SCM ARGS) } -SCM_DEFINE_PUBLIC (log_info, "mu:log", 1, 0, 1, (SCM FRM, SCM ARGS), +SCM_DEFINE_PUBLIC (log_info, "mu:log-info", 1, 0, 1, (SCM FRM, SCM ARGS), "log some message using a list of ARGS applied to FRM " "(in 'simple-format' notation).\n") #define FUNC_NAME s_info { - return write_log (LOG_INFO, FRM, ARGS); + return write_log (G_LOG_LEVEL_INFO, FRM, ARGS); } #undef FUNC_NAME -SCM_DEFINE_PUBLIC (log_warning, "mu:warning", 1, 0, 1, (SCM FRM, SCM ARGS), +SCM_DEFINE_PUBLIC (log_warning, "mu:log-warning", 1, 0, 1, (SCM FRM, SCM ARGS), "log some warning using a list of ARGS applied to FRM (in 'simple-format' " "notation).\n") #define FUNC_NAME s_warning { - return write_log (LOG_WARNING, FRM, ARGS); + return write_log (G_LOG_LEVEL_WARNING, FRM, ARGS); } #undef FUNC_NAME -SCM_DEFINE_PUBLIC (log_critical, "mu:critical", 1, 0, 1, (SCM FRM, SCM ARGS), +SCM_DEFINE_PUBLIC (log_critical, "mu:log-critical", 1, 0, 1, (SCM FRM, SCM ARGS), "log some critical message using a list of ARGS applied to FRM " "(in 'simple-format' notation).\n") #define FUNC_NAME s_critical { - return write_log (LOG_CRITICAL, FRM, ARGS); + return write_log (G_LOG_LEVEL_CRITICAL, FRM, ARGS); } #undef FUNC_NAME - void* mu_guile_init (void *data) { - MSG_TAG = scm_make_smob_type ("msg", sizeof(MuMsgWrapper)); - - scm_set_smob_mark (MSG_TAG, msg_mark); - scm_set_smob_free (MSG_TAG, msg_free); - scm_set_smob_print (MSG_TAG, msg_print); - - define_symbols (); - #include "mu-guile.x" - return NULL; } diff --git a/guile/mu-guile.h b/guile/mu-guile.h index 3904c144..8dfd959e 100644 --- a/guile/mu-guile.h +++ b/guile/mu-guile.h @@ -21,9 +21,68 @@ #define __MU_GUILE_H__ #include +#include G_BEGIN_DECLS + +struct _MuGuile { + MuQuery *query; +}; +typedef struct _MuGuile MuGuile; + +/** + * get the single MuGuile instance + * + * @return the instance or NULL in case of error + */ +MuGuile *mu_guile_instance (void); + + +/** + * whether mu-guile is initialized + * + * @return TRUE if MuGuile is Initialized, FALSE otherwise + */ +gboolean mu_guile_initialized (void); + + +/** + * raise a guile error (based on a GError) + * + * @param func_name function name + * @param err the error + * + * @return SCM_UNSPECIFIED + */ +SCM mu_guile_g_error (const char *func_name, GError *err); + + +/** + * raise a guile error + * + * @param func_name function + * @param status err code + * @param fmt format string for error msg + * @param args params for format string + * + * @return SCM_UNSPECIFIED + */ +SCM mu_guile_error (const char *func_name, int status, + const char *fmt, SCM args); + + +/** + * convert a const char* into an SCM -- either a string or, if str == + * NULL, #f + * + * @param str a string or NULL + * + * @return a guile string or #f + */ +SCM scm_from_string_or_null (const char *str); + + /** * Initialize this mu guile module. * diff --git a/guile/mu.scm b/guile/mu.scm index 5658ceb7..84ce4bc7 100644 --- a/guile/mu.scm +++ b/guile/mu.scm @@ -17,106 +17,25 @@ ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. (define-module (mu) - :use-module (oop goops) - :use-module (mu message) - :use-module (mu contact) :export - (mu:for-each-contact - mu:for-each-message - mu:message-list - mu:tabulate-messages - mu:average-messages)) + ( mu:initialize)) + +;; :use-module (oop goops) + ;; :export + ;; (mu:for-each-contact + ;; mu:for-each-message + ;; mu:message-list + ;; mu:tabulate-messages + ;; mu:average-messages + ;; + ;; ;; message funcs + ;; body + ;; header + ;; contacts + + ;; ;; classes + ;; + ;; ;; contact methods + ;; name email timestamp frequency last-seen (load-extension "libguile-mu" "mu_guile_init") - -(define* (mu:for-each-contact proc #:optional (expr #t)) - "Execute PROC for each contact. PROC receives a instance -as parameter. If EXPR is specified, only consider contacts in messages -matching EXPR." - (let ((c-hash (make-hash-table 4096))) - (mu:for-each-message - (lambda (msg) - (for-each - (lambda (name-addr) - (let ((contact (make - #:name (car name-addr) - #:email (cdr name-addr) - #:timestamp (date msg)))) - (update-contacts-hash c-hash contact))) - (contacts msg #t))) - expr) - ;; c-hash now contains a map of email->contact - (hash-for-each - (lambda (email contact) (proc contact)) c-hash))) - -(define-method (update-contacts-hash c-hash (nc )) - "Update the contacts hash with a new and/or existing contact." - ;; xc: existing-contact, nc: new contact - (let ((xc (hash-ref c-hash (email nc)))) - (if (not xc) ;; no existing contact with this email address? - (hash-set! c-hash (email nc) nc) ;; store the new contact. - ;; otherwise: - (begin - ;; 1) update the frequency for the existing contact - (set! (frequency xc) (1+ (frequency xc))) - ;; 2) update the name if the new one is not empty and its timestamp is newer - ;; in that case, also update the timestamp - (if (and (name nc) (> (string-length (name nc))) - (> (timestamp nc) (timestamp xc))) - (set! (name xc) (name nc)) - (set! (timestamp xc) (timestamp nc))) - ;; 3) update last-seen with timestamp, if x's timestamp is newer - (if (> (timestamp nc) (last-seen xc)) - (set! (last-seen xc) (timestamp nc))) - ;; okay --> now xc has been updated; but it back in the hash - (hash-set! c-hash (email xc) xc))))) - -(define* (mu:for-each-message func #:optional (expr #t)) - "Execute function FUNC for each message that matches mu search expression EXPR. -If EXPR is not provided, match /all/ messages in the store." - (let ((my-func - (lambda (msg) - (func (make #:msg msg))))) - (mu:internal:for-each-message my-func expr))) - -(define* (mu:message-list #:optional (expr #t)) - "Return a list of all messages matching mu search expression -EXPR. If EXPR is not provided, return a list of /all/ messages in the store." - (let ((lst '())) - (mu:for-each-message - (lambda (m) - (set! lst (append! lst (list m)))) expr) - lst)) - -(define* (mu:tabulate-messages func #:optional (expr #t)) - "Execute FUNC for each message matching EXPR, and return an alist -with maps each result of FUNC to its frequency. FUNC is a function -takes a instance as its argument. For example, to tabulate messages by weekday, -one could use: - (mu:tabulate-messages (lambda(msg) (tm:wday (localtime (date msg))))) -." - (let ((table '())) - (mu:for-each-message - (lambda(msg) - (let* ((val (func msg)) - (old-freq (or (assoc-ref table val) 0))) - (set! table (assoc-set! table val (1+ old-freq))))) - expr) - table)) - - -(define* (mu:average-messages func #:optional (expr #t)) - "Execute FUNC for each message matching EXPR, and return the average value of the results of FUNC. - FUNC is a function that takes a instance as its -argument, and returns some number. For example, to get the average message size of messages related to icecream: - (mu:average (lambda(msg) (size msg)) \"icecream\" ." -(let ((count 0) (sum 0)) - (mu:for-each-message - (lambda (msg) - (set! count (+1 count)) - (set! sum (+ sum (func msg)))) - expr) - (if (= count 0) - 0 - (exact->inexact (/ sum count))))) - diff --git a/guile/mu/contact.scm b/guile/mu/contact.scm index cf943d0b..9c2c1231 100644 --- a/guile/mu/contact.scm +++ b/guile/mu/contact.scm @@ -21,6 +21,7 @@ (define-module (mu contact) :use-module (oop goops) + :use-module (mu message) :export ( ;; classes ;; contact methods @@ -33,3 +34,46 @@ (tstamp #:init-value 0 #:accessor timestamp #:init-keyword #:timestamp) (last-seen #:init-value 0 #:accessor last-seen) (freq #:init-value 1 #:accessor frequency)) + + +(define* (mu:for-each-contact proc #:optional (expr #t)) + "Execute PROC for each contact. PROC receives a instance +as parameter. If EXPR is specified, only consider contacts in messages +matching EXPR." + (let ((c-hash (make-hash-table 4096))) + (mu:for-each-message + (lambda (msg) + (for-each + (lambda (name-addr) + (let ((contact (make + #:name (car name-addr) + #:email (cdr name-addr) + #:timestamp (date msg)))) + (update-contacts-hash c-hash contact))) + (contacts msg #t))) + expr) + ;; c-hash now contains a map of email->contact + (hash-for-each + (lambda (email contact) (proc contact)) c-hash))) + +(define-method (update-contacts-hash c-hash (nc )) + "Update the contacts hash with a new and/or existing contact." + ;; xc: existing-contact, nc: new contact + (let ((xc (hash-ref c-hash (email nc)))) + (if (not xc) ;; no existing contact with this email address? + (hash-set! c-hash (email nc) nc) ;; store the new contact. + ;; otherwise: + (begin + ;; 1) update the frequency for the existing contact + (set! (frequency xc) (1+ (frequency xc))) + ;; 2) update the name if the new one is not empty and its timestamp is newer + ;; in that case, also update the timestamp + (if (and (name nc) (> (string-length (name nc))) + (> (timestamp nc) (timestamp xc))) + (set! (name xc) (name nc)) + (set! (timestamp xc) (timestamp nc))) + ;; 3) update last-seen with timestamp, if x's timestamp is newer + (if (> (timestamp nc) (last-seen xc)) + (set! (last-seen xc) (timestamp nc))) + ;; okay --> now xc has been updated; but it back in the hash + (hash-set! c-hash (email xc) xc))))) diff --git a/guile/mu/message.scm b/guile/mu/message.scm index e317c4c2..5265f3b4 100644 --- a/guile/mu/message.scm +++ b/guile/mu/message.scm @@ -18,13 +18,38 @@ (define-module (mu message) :use-module (oop goops) - :use-module (mu) - :export ( + :export ( ;; classes + mu:for-each-message + mu:for-each-contact + ;; internal + mu:for-each-msg-internal + mu:get-contacts + mu:get-header + mu:get-field + ;; message funcs body header contacts - )) + ;; other symbols + mu:bcc + mu:body-html + mu:body-txt + mu:cc + mu:date + mu:flags + mu:from + mu:maildir + mu:message-id + mu:path + mu:prio + mu:refs + mu:size + mu:subject + mu:tags + mu:to)) + +(load-extension "libguile-mu" "mu_guile_message_init") (define-class () (msg #:init-keyword #:msg)) ;; the MuMsg-smob we're wrapping @@ -34,32 +59,78 @@ ((define-getter method-name field) (begin (define-method (method-name (msg )) - (mu:msg:field (slot-ref msg 'msg) field)) + (mu:get-field (slot-ref msg 'msg) field)) (export method-name))))) -(define-getter bcc mu:bcc) +(define-getter bcc mu:bcc) (define-getter body-html mu:body-html) -(define-getter body-txt mu:body-txt) -(define-getter cc mu:cc) -(define-getter date mu:date) -(define-getter flags mu:flags) -(define-getter from mu:from) -(define-getter maildir mu:maildir) +(define-getter body-txt mu:body-txt) +(define-getter cc mu:cc) +(define-getter date mu:date) +(define-getter flags mu:flags) +(define-getter from mu:from) +(define-getter maildir mu:maildir) (define-getter message-id mu:message-id) -(define-getter path mu:path) -(define-getter priority mu:prio) +(define-getter path mu:path) +(define-getter priority mu:prio) (define-getter references mu:refs) -(define-getter size mu:size) -(define-getter subject mu:subject) -(define-getter tags mu:tags) -(define-getter to mu:to) - -(define-method (body (msg )) - (or (body-txt msg) (body-html msg))) +(define-getter size mu:size) +(define-getter subject mu:subject) +(define-getter tags mu:tags) +(define-getter to mu:to) (define-method (header (msg ) (hdr )) "Get an arbitrary header HDR from message MSG." - (mu:msg:header (slot-ref msg 'msg) hdr)) + (mu:get-header (slot-ref msg 'msg) hdr)) (define-method (contacts (msg ) contact-type) - (mu:msg:contacts (slot-ref msg 'msg) contact-type)) + (mu:get-contacts (slot-ref msg 'msg) contact-type)) + +(define* (mu:for-each-message func #:optional (expr #t)) + "Execute function FUNC for each message that matches mu search expression EXPR. +If EXPR is not provided, match /all/ messages in the store." + (let ((my-func + (lambda (msg) + (func (make #:msg msg))))) + (mu:for-each-msg-internal my-func expr))) + +(define* (mu:message-list #:optional (expr #t)) + "Return a list of all messages matching mu search expression +EXPR. If EXPR is not provided, return a list of /all/ messages in the store." + (let ((lst '())) + (mu:for-each-message + (lambda (m) + (set! lst (append! lst (list m)))) expr) + lst)) + +(define* (mu:tabulate-messages func #:optional (expr #t)) + "Execute FUNC for each message matching EXPR, and return an alist +with maps each result of FUNC to its frequency. FUNC is a function +takes a instance as its argument. For example, to +tabulate messages by weekday, one could use: + (mu:tabulate-messages (lambda(msg) (tm:wday (localtime (date msg)))))." + (let ((table '())) + (mu:for-each-message + (lambda(msg) + (let* ((val (func msg)) + (old-freq (or (assoc-ref table val) 0))) + (set! table (assoc-set! table val (1+ old-freq))))) + expr) + table)) + + +(define* (mu:average-messages func #:optional (expr #t)) + "Execute FUNC for each message matching EXPR, and return the average +value of the results of FUNC. FUNC is a function that takes a + instance as its argument, and returns some number. For +example, to get the average message size of messages related to +icecream: (mu:average (lambda(msg) (size msg)) \"icecream\" ." +(let ((count 0) (sum 0)) + (mu:for-each-message + (lambda (msg) + (set! count (+1 count)) + (set! sum (+ sum (func msg)))) + expr) + (if (= count 0) + 0 + (exact->inexact (/ sum count)))))