From 8e3fbe380ec071303c1f6dba557c280fcd45d511 Mon Sep 17 00:00:00 2001 From: djcb Date: Sat, 14 Jul 2012 12:32:15 +0300 Subject: [PATCH] * guile: some general improvements / cleanups in module loading, object visibilty. turn some integers (such as message priority, log level, contact type) into symbols. --- guile/Makefile.am | 18 +- guile/mu-guile-message.c | 465 ++++++++++++++-------------------- guile/mu-guile.c | 92 +++---- guile/mu.scm | 284 ++++++++++++++++++++- guile/mu/Makefile.am | 7 +- guile/mu/contact.scm | 143 +---------- guile/mu/message.scm | 109 +------- guile/mu/part.scm | 73 +----- guile/mu/stats.scm | 25 +- guile/tests/test-mu-guile.scm | 31 ++- 10 files changed, 576 insertions(+), 671 deletions(-) diff --git a/guile/Makefile.am b/guile/Makefile.am index 3851db60..be73d08d 100644 --- a/guile/Makefile.am +++ b/guile/Makefile.am @@ -44,6 +44,8 @@ libguile_mu_la_LIBADD= \ ${top_builddir}/lib/libmu.la \ ${GUILE_LIBS} +libguile_mu_la_LDFLAGS= -export-dynamic + XFILES= \ mu-guile.x \ mu-guile-message.x @@ -53,13 +55,6 @@ info_TEXINFOS= \ mu_guile_TEXINFOS= \ fdl.texi -# FIXME: GUILE_SITEDIR would be better, but that -# breaks 'make distcheck' -scmdir=${prefix}/share/guile/site/2.0/ - -scm_DATA= \ - mu.scm - BUILT_SOURCES=$(XFILES) snarfcppopts= $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) $(INCLUDES) @@ -67,9 +62,14 @@ SUFFIXES = .x .doc .c.x: $(GUILE_SNARF) -o $@ $< $(snarfcppopts) +# FIXME: GUILE_SITEDIR would be better, but that +# breaks 'make distcheck' +scmdir=${prefix}/share/guile/site/2.0/ +scm_DATA=mu.scm + +EXTRA_DIST=$(scm_DATA) + ## Add -MG to make the .x magic work with auto-dep code. MKDEP = $(CC) -M -MG $(snarfcppopts) DISTCLEANFILES=$(XFILES) - -EXTRA_DIST=$(scm_DATA) diff --git a/guile/mu-guile-message.c b/guile/mu-guile-message.c index ea9a3ee1..388b5274 100644 --- a/guile/mu-guile-message.c +++ b/guile/mu-guile-message.c @@ -32,6 +32,17 @@ #include #include +/* pseudo field, not in Xapian */ +#define MU_GUILE_MSG_FIELD_ID_TIMESTAMP (MU_MSG_FIELD_ID_NUM + 1) + +/* some symbols */ +static SCM SYMB_PRIO_LOW, SYMB_PRIO_NORMAL, SYMB_PRIO_HIGH; +static SCM SYMB_FLAG_NEW, SYMB_FLAG_PASSED, SYMB_FLAG_REPLIED, + SYMB_FLAG_SEEN, SYMB_FLAG_TRASHED, SYMB_FLAG_DRAFT, + SYMB_FLAG_FLAGGED, SYMB_FLAG_SIGNED, SYMB_FLAG_ENCRYPTED, + SYMB_FLAG_HAS_ATTACH, SYMB_FLAG_UNREAD; +static SCM SYMB_CONTACT_TO, SYMB_CONTACT_CC, SYMB_CONTACT_BCC, + SYMB_CONTACT_FROM; struct _MuMsgWrapper { MuMsg *_msg; @@ -40,10 +51,6 @@ struct _MuMsgWrapper { typedef struct _MuMsgWrapper MuMsgWrapper; static long MSG_TAG; -/* pseudo field, not in Xapian */ -#define MU_GUILE_MSG_FIELD_ID_TIMESTAMP (MU_MSG_FIELD_ID_NUM + 1) - - static gboolean mu_guile_scm_is_msg (SCM scm) { @@ -64,109 +71,6 @@ mu_guile_msg_to_scm (MuMsg *msg) 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; @@ -174,23 +78,37 @@ struct _FlagData { typedef struct _FlagData FlagData; + + + static void check_flag (MuFlags flag, FlagData *fdata) { - SCM item; - char *flagsym; + SCM flag_scm; if (!(fdata->flags & flag)) return; - flagsym = g_strconcat ("mu:", mu_flag_name(flag), NULL); - item = scm_list_1 (scm_from_utf8_symbol(flagsym)); - g_free (flagsym); + switch (flag) { + case MU_FLAG_NEW: flag_scm = SYMB_FLAG_NEW; break; + case MU_FLAG_PASSED: flag_scm = SYMB_FLAG_PASSED; break; + case MU_FLAG_REPLIED: flag_scm = SYMB_FLAG_REPLIED; break; + case MU_FLAG_SEEN: flag_scm = SYMB_FLAG_SEEN; break; + case MU_FLAG_TRASHED: flag_scm = SYMB_FLAG_TRASHED; break; + case MU_FLAG_SIGNED: flag_scm = SYMB_FLAG_SIGNED; break; + case MU_FLAG_DRAFT: flag_scm = SYMB_FLAG_DRAFT; break; + case MU_FLAG_FLAGGED: flag_scm = SYMB_FLAG_FLAGGED; break; + case MU_FLAG_ENCRYPTED: flag_scm = SYMB_FLAG_ENCRYPTED; break; + case MU_FLAG_HAS_ATTACH: flag_scm = SYMB_FLAG_HAS_ATTACH; break; + case MU_FLAG_UNREAD: flag_scm = SYMB_FLAG_UNREAD; break; + default: flag_scm = SCM_UNDEFINED; + } - fdata->lst = scm_append_x (scm_list_2(fdata->lst, item)); + fdata->lst = scm_append_x + (scm_list_2(fdata->lst, + scm_list_1 (flag_scm))); } - static SCM get_flags_scm (MuMsg *msg) { @@ -210,12 +128,10 @@ get_prio_scm (MuMsg *msg) { switch (mu_msg_get_prio (msg)) { - case MU_MSG_PRIO_LOW: - return scm_from_utf8_symbol("mu:low"); - case MU_MSG_PRIO_NORMAL: - return scm_from_utf8_symbol("mu:normal"); - case MU_MSG_PRIO_HIGH: - return scm_from_utf8_symbol("mu:high"); + case MU_MSG_PRIO_LOW: return SYMB_PRIO_LOW; + case MU_MSG_PRIO_NORMAL: return SYMB_PRIO_NORMAL; + case MU_MSG_PRIO_HIGH: return SYMB_PRIO_HIGH; + default: g_return_val_if_reached (SCM_UNDEFINED); } @@ -241,9 +157,9 @@ msg_string_list_field (MuMsg *msg, MuMsgFieldId mfid) } -SCM_DEFINE_PUBLIC(get_field, "mu:get-field", 2, 0, 0, - (SCM MSG, SCM FIELD), - "Get the field FIELD from message MSG.\n") +SCM_DEFINE (get_field, "mu:c: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; @@ -326,17 +242,16 @@ contacts_to_list (MuMsgContact *contact, EachContactData *ecdata) } - -SCM_DEFINE_PUBLIC (get_contacts, "mu:get-contacts", 2, 0, 0, - (SCM MSG, SCM CONTACT_TYPE), - "Get a list of contact information pairs.\n") +SCM_DEFINE (get_contacts, "mu:c: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), + SCM_ASSERT (scm_symbol_p (CONTACT_TYPE) || scm_is_bool(CONTACT_TYPE), CONTACT_TYPE, SCM_ARG2, FUNC_NAME); if (CONTACT_TYPE == SCM_BOOL_F) @@ -344,15 +259,17 @@ SCM_DEFINE_PUBLIC (get_contacts, "mu:get-contacts", 2, 0, 0, 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); - } + if (scm_is_eq (CONTACT_TYPE, SYMB_CONTACT_TO)) + ecdata.ctype = MU_MSG_CONTACT_TYPE_TO; + else if (scm_is_eq (CONTACT_TYPE, SYMB_CONTACT_CC)) + ecdata.ctype = MU_MSG_CONTACT_TYPE_CC; + else if (scm_is_eq (CONTACT_TYPE, SYMB_CONTACT_BCC)) + ecdata.ctype = MU_MSG_CONTACT_TYPE_BCC; + else if (scm_is_eq (CONTACT_TYPE, SYMB_CONTACT_FROM)) + ecdata.ctype = MU_MSG_CONTACT_TYPE_FROM; + else + /* FIXME: rais error */ + g_return_val_if_reached (SCM_UNDEFINED); } ecdata.lst = SCM_EOL; @@ -360,8 +277,7 @@ SCM_DEFINE_PUBLIC (get_contacts, "mu:get-contacts", 2, 0, 0, mu_msg_contact_foreach (msgwrap->_msg, (MuMsgContactForeachFunc)contacts_to_list, &ecdata); - - /* explicitly close the file backend, so we won't run of fds */ + /* explicitly close the file backend, so we won't run out of fds */ mu_msg_close_file_backend (msgwrap->_msg); return ecdata.lst; @@ -412,7 +328,7 @@ each_part (MuMsg *msg, MuMsgPart *part, AttInfo *attinfo) } -SCM_DEFINE_PUBLIC (get_parts, "mu:get-parts", 1, 1, 0, +SCM_DEFINE (get_parts, "mu:c:get-parts", 1, 1, 0, (SCM MSG, SCM ATTS_ONLY), "Get the list of mime-parts for MSG. If ATTS_ONLY is #t, only" "get parts that are (look like) attachments. The resulting list has " @@ -441,56 +357,8 @@ SCM_DEFINE_PUBLIC (get_parts, "mu:get-parts", 1, 1, 0, #undef FUNC_NAME -SCM_DEFINE_PUBLIC (save_part, "mu:save-part", 2, 0, 0, - (SCM MSGPATH, SCM INDEX), - "Create a temporary file containing the attachment; this function " - "returns the full path to that temporary file.\n") -#define FUNC_NAME s_save_part -{ - GError *err; - gchar *attachpath, *msgpath; - unsigned index; - MuMsg *msg; - SCM rv_scm; - - SCM_ASSERT (scm_is_string(MSGPATH), MSGPATH, SCM_ARG1, FUNC_NAME); - SCM_ASSERT (scm_is_integer (INDEX), - INDEX,SCM_ARG2, FUNC_NAME); - - index = scm_to_uint (INDEX); - msgpath = scm_to_utf8_string (MSGPATH); - - attachpath = NULL; - err = NULL; - msg = mu_msg_new_from_file (msgpath, NULL, &err); - if (!msg) { - rv_scm = mu_guile_g_error (FUNC_NAME, err); - goto leave; - } - - attachpath = mu_msg_part_save_temp (msg, index, &err); - if (!attachpath) { - rv_scm = mu_guile_g_error (FUNC_NAME, err); - goto leave; - } - - rv_scm = mu_guile_scm_from_str (attachpath); - -leave: - mu_msg_unref (msg); - g_clear_error (&err); - - g_free (attachpath); - return rv_scm; -} -#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") +SCM_DEFINE (get_header, "mu:c:get-header", 2, 0, 0, + (SCM MSG, SCM HEADER), "Get an arbitary HEADER from MSG.\n") #define FUNC_NAME s_get_header { MuMsgWrapper *msgwrap; @@ -514,89 +382,6 @@ SCM_DEFINE_PUBLIC (get_header, "mu:get-header", 2, 0, 0, #undef FUNC_NAME - -static struct { - const char* name; - unsigned val; -} SYMPAIRS[] = { - - { "mu:prio:high", MU_MSG_PRIO_HIGH }, - { "mu:prio:low", MU_MSG_PRIO_LOW }, - { "mu:prio:normal", MU_MSG_PRIO_NORMAL }, - - { "mu:flag:new", MU_FLAG_NEW }, - { "mu:flag:passed", MU_FLAG_PASSED }, - { "mu:flag:replied", MU_FLAG_REPLIED }, - { "mu:flag:seen", MU_FLAG_SEEN }, - { "mu:flag:trashed", MU_FLAG_TRASHED }, - { "mu:flag:draft", MU_FLAG_DRAFT }, - { "mu:flag:flagged", MU_FLAG_FLAGGED }, - { "mu:flag:signed", MU_FLAG_SIGNED }, - { "mu:flag:encrypted", MU_FLAG_ENCRYPTED }, - { "mu:flag:has-attach", MU_FLAG_HAS_ATTACH }, - { "mu:flag:unread", MU_FLAG_UNREAD }, - - { "mu:field:bcc", MU_MSG_FIELD_ID_BCC }, - { "mu:field:body-html", MU_MSG_FIELD_ID_BODY_HTML }, - { "mu:field:body-txt", MU_MSG_FIELD_ID_BODY_TEXT }, - { "mu:field:cc", MU_MSG_FIELD_ID_CC }, - { "mu:field:date", MU_MSG_FIELD_ID_DATE }, - { "mu:field:flags", MU_MSG_FIELD_ID_FLAGS }, - { "mu:field:from", MU_MSG_FIELD_ID_FROM }, - { "mu:field:maildir", MU_MSG_FIELD_ID_MAILDIR }, - { "mu:field:message-id",MU_MSG_FIELD_ID_MSGID }, - { "mu:field:path", MU_MSG_FIELD_ID_PATH }, - { "mu:field:prio", MU_MSG_FIELD_ID_PRIO }, - { "mu:field:refs", MU_MSG_FIELD_ID_REFS }, - { "mu:field:size", MU_MSG_FIELD_ID_SIZE }, - { "mu:field:subject", MU_MSG_FIELD_ID_SUBJECT }, - { "mu:field:tags", MU_MSG_FIELD_ID_TAGS }, - { "mu:field:to", MU_MSG_FIELD_ID_TO }, - - /* non-Xapian field: timestamp */ - { "mu:field:timestamp", MU_GUILE_MSG_FIELD_ID_TIMESTAMP } -}; - - -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) { @@ -628,14 +413,14 @@ get_query_iter (MuQuery *query, const char* expr, int maxnum) } -SCM_DEFINE_PUBLIC (for_each_msg_internal, "mu:for-each-msg-internal", 3, 0, 0, - (SCM FUNC, SCM EXPR, SCM MAXNUM), -"Call FUNC for each msg in the message store matching EXPR. EXPR is " +SCM_DEFINE (for_each_message, "mu:c:for-each-message", 3, 0, 0, + (SCM FUNC, SCM EXPR, SCM MAXNUM), +"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 +"none if EXPR equals #f.") +#define FUNC_NAME s_for_each_message { MuMsgIter *iter; char* expr; @@ -645,9 +430,6 @@ SCM_DEFINE_PUBLIC (for_each_msg_internal, "mu:for-each-msg-internal", 3, 0, 0, EXPR, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_integer (MAXNUM), MAXNUM, SCM_ARG3, 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 */ @@ -673,6 +455,124 @@ SCM_DEFINE_PUBLIC (for_each_msg_internal, "mu:for-each-msg-internal", 3, 0, 0, #undef FUNC_NAME +static SCM +register_symbol (const char *name) +{ + SCM scm; + + scm = scm_from_utf8_symbol (name); + scm_c_define (name, scm); + scm_c_export (name, NULL); + + return scm; +} + +static void +define_symbols (void) +{ + SYMB_CONTACT_TO = register_symbol ("mu:contact:to"); + SYMB_CONTACT_CC = register_symbol ("mu:contact:cc"); + SYMB_CONTACT_FROM = register_symbol ("mu:contact:from"); + SYMB_CONTACT_BCC = register_symbol ("mu:contact:bcc"); + + SYMB_PRIO_LOW = register_symbol ("mu:prio:low"); + SYMB_PRIO_NORMAL = register_symbol ("mu:prio:normal"); + SYMB_PRIO_HIGH = register_symbol ("mu:prio:high"); + + SYMB_FLAG_NEW = register_symbol ("mu:flag:new"); + SYMB_FLAG_PASSED = register_symbol ("mu:flag:passed"); + SYMB_FLAG_REPLIED = register_symbol ("mu:flag:replied"); + SYMB_FLAG_SEEN = register_symbol ("mu:flag:seen"); + SYMB_FLAG_TRASHED = register_symbol ("mu:flag:trashed"); + SYMB_FLAG_DRAFT = register_symbol ("mu:flag:draft"); + SYMB_FLAG_FLAGGED = register_symbol ("mu:flag:flagged"); + SYMB_FLAG_SIGNED = register_symbol ("mu:flag:signed"); + SYMB_FLAG_ENCRYPTED = register_symbol ("mu:flag:encrypted"); + SYMB_FLAG_HAS_ATTACH = register_symbol ("mu:flag:has-attach"); + SYMB_FLAG_UNREAD = register_symbol ("mu:flag:unread"); +} + + +static struct { + const char* name; + unsigned val; +} VAR_PAIRS[] = { + + { "mu:field:bcc", MU_MSG_FIELD_ID_BCC }, + { "mu:field:body-html", MU_MSG_FIELD_ID_BODY_HTML }, + { "mu:field:body-txt", MU_MSG_FIELD_ID_BODY_TEXT }, + { "mu:field:cc", MU_MSG_FIELD_ID_CC }, + { "mu:field:date", MU_MSG_FIELD_ID_DATE }, + { "mu:field:flags", MU_MSG_FIELD_ID_FLAGS }, + { "mu:field:from", MU_MSG_FIELD_ID_FROM }, + { "mu:field:maildir", MU_MSG_FIELD_ID_MAILDIR }, + { "mu:field:message-id",MU_MSG_FIELD_ID_MSGID }, + { "mu:field:path", MU_MSG_FIELD_ID_PATH }, + { "mu:field:prio", MU_MSG_FIELD_ID_PRIO }, + { "mu:field:refs", MU_MSG_FIELD_ID_REFS }, + { "mu:field:size", MU_MSG_FIELD_ID_SIZE }, + { "mu:field:subject", MU_MSG_FIELD_ID_SUBJECT }, + { "mu:field:tags", MU_MSG_FIELD_ID_TAGS }, + { "mu:field:to", MU_MSG_FIELD_ID_TO }, + + /* non-Xapian field: timestamp */ + { "mu:field:timestamp", MU_GUILE_MSG_FIELD_ID_TIMESTAMP } +}; + +static void +define_vars (void) +{ + unsigned u; + for (u = 0; u != G_N_ELEMENTS(VAR_PAIRS); ++u) { + scm_c_define (VAR_PAIRS[u].name, + scm_from_uint (VAR_PAIRS[u].val)); + scm_c_export (VAR_PAIRS[u].name, NULL); + } +} + + +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; +} + void* mu_guile_message_init (void *data) @@ -683,9 +583,12 @@ mu_guile_message_init (void *data) scm_set_smob_free (MSG_TAG, msg_free); scm_set_smob_print (MSG_TAG, msg_print); + define_vars (); define_symbols (); +#ifndef SCM_MAGIC_SNARFER #include "mu-guile-message.x" +#endif /*SCM_MAGIC_SNARFER*/ return NULL; } diff --git a/guile/mu-guile.c b/guile/mu-guile.c index a3f4ce5a..47dcb648 100644 --- a/guile/mu-guile.c +++ b/guile/mu-guile.c @@ -138,20 +138,19 @@ mu_guile_initialized (void) } - 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\n.") + "-- typically, the default, ~/.mu, should be just fine.") #define FUNC_NAME s_mu_initialize { char *muhome; gboolean rv; - SCM_ASSERT (scm_is_string (MUHOME) || MUHOME == SCM_BOOL_F || SCM_UNBNDP(MUHOME), - MUHOME, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_string (MUHOME) || MUHOME == SCM_BOOL_F || + SCM_UNBNDP(MUHOME), MUHOME, SCM_ARG1, FUNC_NAME); if (mu_guile_initialized()) return mu_guile_error (FUNC_NAME, 0, "Already initialized", @@ -176,9 +175,8 @@ SCM_DEFINE_PUBLIC (mu_initialize, "mu:initialize", 0, 1, 0, } #undef FUNC_NAME - SCM_DEFINE_PUBLIC (mu_initialized_p, "mu:initialized?", 0, 0, 0, - (void), "Whether mu is initialized or not.\n") + (void), "Whether mu is initialized or not.\n") #define FUNC_NAME s_mu_initialized_p { return mu_guile_initialized() ? SCM_BOOL_T : SCM_BOOL_F; @@ -186,63 +184,71 @@ SCM_DEFINE_PUBLIC (mu_initialized_p, "mu:initialized?", 0, 0, 0, #undef FUNC_NAME - -static SCM -write_log (GLogLevelFlags level, SCM FRM, SCM ARGS) -#define FUNC_NAME __FUNCTION__ +SCM_DEFINE (log_func, "mu:c:log", 1, 0, 1, (SCM LEVEL, SCM FRM, SCM ARGS), + "log some message at LEVEL using a list of ARGS applied to FRM" + "(in 'simple-format' notation).\n") +#define FUNC_NAME s_log_func { + gchar *output; SCM str; + int level; - SCM_ASSERT (scm_is_string(FRM), FRM, SCM_ARG1, ""); + SCM_ASSERT (scm_integer_p(LEVEL), LEVEL, SCM_ARG1, FUNC_NAME); + SCM_ASSERT (scm_is_string(FRM), FRM, SCM_ARG2, ""); SCM_VALIDATE_REST_ARGUMENT(ARGS); + level = scm_to_int (LEVEL); + if (level != G_LOG_LEVEL_MESSAGE && + level != G_LOG_LEVEL_WARNING && + level != G_LOG_LEVEL_CRITICAL) + return mu_guile_error (FUNC_NAME, 0, "invalid log level", + SCM_UNSPECIFIED); + str = scm_simple_format (SCM_BOOL_F, FRM, ARGS); - if (scm_is_string (str)) { + if (!scm_is_string (str)) + return SCM_UNSPECIFIED; - gchar *output; - output = scm_to_utf8_string (str); - g_log (G_LOG_DOMAIN, level, "%s", output); - free (output); - } + output = scm_to_utf8_string (str); + g_log (G_LOG_DOMAIN, level, "%s", output); + free (output); return SCM_UNSPECIFIED; - -#undef FUNC_NAME } +#undef FUNC_NAME -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 +static struct { + const char* name; + unsigned val; +} VAR_PAIRS[] = { + + { "mu:message", G_LOG_LEVEL_MESSAGE }, + { "mu:warning", G_LOG_LEVEL_WARNING }, + { "mu:critical", G_LOG_LEVEL_CRITICAL } +}; + +static void +define_vars (void) { - return write_log (G_LOG_LEVEL_INFO, FRM, ARGS); + unsigned u; + for (u = 0; u != G_N_ELEMENTS(VAR_PAIRS); ++u) { + scm_c_define (VAR_PAIRS[u].name, + scm_from_uint (VAR_PAIRS[u].val)); + scm_c_export (VAR_PAIRS[u].name, NULL); + } } -#undef FUNC_NAME - -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 (G_LOG_LEVEL_WARNING, FRM, ARGS); -} -#undef FUNC_NAME - -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 (G_LOG_LEVEL_CRITICAL, FRM, ARGS); -} -#undef FUNC_NAME void* mu_guile_init (void *data) { + define_vars (); + + +#ifndef SCM_MAGIC_SNARFER #include "mu-guile.x" +#endif /*SCM_MAGIC_SNARFER*/ + return NULL; } diff --git a/guile/mu.scm b/guile/mu.scm index dd83aae9..9fccd7f4 100644 --- a/guile/mu.scm +++ b/guile/mu.scm @@ -1,5 +1,4 @@ -;; -;; Copyright (C) 2011 Dirk-Jan C. Binnema +;; Copyright (C) 2011-2012 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 @@ -17,10 +16,289 @@ ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. (define-module (mu) + :use-module (oop goops) + :use-module (ice-9 optargs) + :use-module (texinfo string-utils) :export - (mu:initialize)) + ( ;; classes + + + + ;; general +;; mu:initialize + ;; mu:initialized? + mu:log-warning + mu:log-message + mu:log-critical + ;; search funcs + mu:for-each-message + mu:for-each-msg + mu:message-list + ;; message funcs + header + ;; message accessors + mu:field:bcc + mu:field:body-html + mu:field:body-txt + mu:field:cc + mu:field:date + mu:field:flags + mu:field:from + mu:field:maildir + mu:field:message-id + mu:field:path + mu:field:prio + mu:field:refs + mu:field:size + mu:field:subject + mu:field:tags + mu:field:timestamp + mu:field:to + ;; contact funcs + mu:name + mu:email + mu:contact->string + ;; + mu:for-each-contact + + ;; + mu:contacts + ;; + ;; + mu:frequency + mu:last-seen + ;; parts + + + ;; message function + mu:attachments + mu:parts + ;; methods + mu:name + mu:mime-type + ;; size + ;; mu:save + ;; mu:save-as + )) ;; this is needed for guile < 2.0.4 (setlocale LC_ALL "") +;; load the binary (load-extension "libguile-mu" "mu_guile_init") +(load-extension "libguile-mu" "mu_guile_message_init") + +(define (mu:log-warning frm . args) + "Log FRM with ARGS at warning." + (mu:c:log mu:warning frm args)) + +(define (mu:log-message frm . args) + "Log FRM with ARGS at warning." + (mu:c:log mu:message frm args)) + +(define (mu:log-critical frm . args) + "Log FRM with ARGS at warning." + (mu:c:log mu:critical frm args)) + +(define-class () + (msg #:init-keyword #:msg)) ;; the MuMsg-smob we're wrapping + +(define-syntax define-getter + (syntax-rules () + ((define-getter method-name field) + (begin + (define-method (method-name (msg )) + (mu:c:get-field (slot-ref msg 'msg) field)) + (export method-name))))) + +(define-getter mu:bcc mu:field:bcc) +(define-getter mu:body-html mu:field:body-html) +(define-getter mu:body-txt mu:field:body-txt) +(define-getter mu:cc mu:field:cc) +(define-getter mu:date mu:field:date) +(define-getter mu:flags mu:field:flags) +(define-getter mu:from mu:field:from) +(define-getter mu:maildir mu:field:maildir) +(define-getter mu:message-id mu:field:message-id) +(define-getter mu:path mu:field:path) +(define-getter mu:priority mu:field:prio) +(define-getter mu:references mu:field:refs) +(define-getter mu:size mu:field:size) +(define-getter mu:subject mu:field:subject) +(define-getter mu:tags mu:field:tags) +(define-getter mu:timestamp mu:field:timestamp) +(define-getter mu:to mu:field:to) + +(define-method (header (msg ) (hdr )) + "Get an arbitrary header HDR from message MSG; return #f if it does +not exist." + (mu:c:get-header (slot-ref msg 'msg) hdr)) + +(define* (mu:for-each-message func #:optional (expr #t) (maxresults -1)) + "Execute function FUNC for each message that matches mu search expression EXPR. +If EXPR is not provided, match /all/ messages in the store. MAXRESULTS +specifies the maximum of messages to return, or -1 (the default) for +no limit." + (mu:c:for-each-message + (lambda (msg) + (func (make #:msg msg))) + expr + maxresults)) + +;; backward-compatibility alias +(define mu:for-each-msg mu:for-each-message) + +(define* (mu:message-list #:optional (expr #t) (maxresults -1)) + "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. MAXRESULTS specifies the maximum of messages to return, or +-1 (the default) for no limit." + (let ((lst '())) + (mu:for-each-message + (lambda (m) + (set! lst (append! lst (list m)))) expr maxresults) + lst)) + +;; contacts +(define-class () + (name #:init-value #f #:accessor mu:name #:init-keyword #:name) + (email #:init-value #f #:accessor mu:email #:init-keyword #:email)) + +(define-method (mu:contacts (msg ) contact-type) + "Get all contacts for MSG of the given CONTACT-TYPE. MSG is of type , +while contact type is either `mu:to', `mu:cc', `mu:from' or `mu:bcc' +to get the corresponding type of contacts, or #t to get all. Returns a +list of objects." + (map (lambda (pair) ;; a pair (na . addr) + (make #:name (car pair) #:email (cdr pair))) + (mu:get-contacts (slot-ref msg 'msg) contact-type))) + +(define-method (mu:contacts (msg )) + "Get contacts of all types for message MSG as a list of +objects." + (mu:contacts msg #t)) + +(define-class () + (tstamp #:init-value 0 #:accessor mu:timestamp #:init-keyword #:timestamp) + (last-seen #:init-value 0 #:accessor mu:last-seen) + (freq #:init-value 1 #:accessor mu: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 (ct) + (let ((ct-ws (make + #:name (mu:name ct) + #:email (mu:email ct) + #:timestamp (mu:date msg)))) + (update-contacts-hash c-hash ct-ws))) + (mu:contacts msg #t))) + expr) + (hash-for-each ;; c-hash now contains a map of email->contact + (lambda (email ct-ws) (proc ct-ws)) 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 (mu:email nc)))) + (if (not xc) ;; no existing contact with this email address? + (hash-set! c-hash (mu:email nc) nc) ;; store the new contact. + ;; otherwise: + (begin + ;; 1) update the frequency for the existing contact + (set! (mu:frequency xc) (1+ (mu: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 (mu:name nc) (> (string-length (mu:name nc))) + (> (mu:timestamp nc) (mu:timestamp xc))) + (set! (mu:name xc) (mu:name nc)) + (set! (mu:timestamp xc) (mu:timestamp nc))) + ;; 3) update last-seen with timestamp, if x's timestamp is newer + (if (> (mu:timestamp nc) (mu:last-seen xc)) + (set! (mu:last-seen xc) (mu:timestamp nc))) + ;; okay --> now xc has been updated; but it back in the hash + (hash-set! c-hash (mu:email xc) xc))))) + +(define-method (mu:contact->string (contact ) (form )) + "Convert a contact to a string in format FORM, which is a string, +either \"org-contact\", \"mutt-alias\", \"mutt-ab\", +\"wanderlust\", \"quoted\" \"plain\"." + (let* ((name (mu:name contact)) (email (mu:email contact)) + (nick ;; simplistic nick guessing... + (string-map + (lambda(kar) + (if (char-alphabetic? kar) kar #\_)) + (string-downcase (or name email))))) + (cond + ((string= form "plain") + (format #f "~a~a~a" (or name "") (if name " " "") email)) + ((string= form "org-contact") + (format #f "* ~s\n:PROPERTIES:\n:EMAIL:~a\n:NICK:~a\n:END:" + (or name email) email nick)) + ((string= form "wanderlust") + (format #f "~a ~s ~s" + nick (or name email) email)) + ((string= form "mutt-alias") + (format #f "alias ~a ~a <~a>" + nick (or name email) email)) + ((string= form "mutt-ab") + (format #f "~a\t~a\t" + email (or name ""))) + ((string= form "quoted") + (string-append + "\"" + (escape-special-chars + (string-append + (if name + (format #f "\"~a\" " name) + "") + (format #f "<~a>" email)) + "\"" #\\) + "\"")) + (else (error "Unsupported format"))))) + + +;; message parts + + +(define-class () + (msgpath #:init-value #f #:init-keyword #:msgpath) + (index #:init-value #f #:init-keyword #:index) + (name #:init-value #f #:getter mu:name #:init-keyword #:name) + (mime-type #:init-value #f #:getter mu:mime-type #:init-keyword #:mime-type) + (size #:init-value 0 #:getter mu:size #:init-keyword #:size)) + +(define-method (get-parts (msg ) (files-only )) + "Get the part for MSG as a list of objects; if FILES-ONLY is #t, +only get the part with file names." + (map (lambda (part) + (make + #:msgpath (list-ref part 0) + #:index (list-ref part 1) + #:name (list-ref part 2) + #:mime-type (list-ref part 3) + #:size (list-ref part 4))) + (mu:get-parts (slot-ref msg 'msg) files-only))) + +(define-method (mu:attachments (msg )) + "Get the attachments for MSG as a list of objects." + (get-parts msg #t)) + +(define-method (mu:parts (msg )) + "Get the MIME-parts for MSG as a list of objects." + (get-parts msg #f)) + +;; (define-method (mu:save (part )) +;; "Save PART to a temporary file, and return the file name. If the +;; part had a filename, the temporary file's file name will be just that; +;; otherwise a name is made up." +;; (mu:save-part (slot-ref part 'msgpath) (slot-ref part 'index))) + +;; (define-method (mu:save-as (part ) (filepath )) +;; "Save message-part PART to file system path PATH." +;; (copy-file (save part) filepath)) diff --git a/guile/mu/Makefile.am b/guile/mu/Makefile.am index 57b60b2e..3fca28c4 100644 --- a/guile/mu/Makefile.am +++ b/guile/mu/Makefile.am @@ -19,11 +19,6 @@ include $(top_srcdir)/gtest.mk # FIXME: GUILE_SITEDIR would be better, but that # breaks 'make distcheck' scmdir=${prefix}/share/guile/site/2.0/mu/ -scm_DATA= \ - message.scm \ - contact.scm \ - part.scm \ - stats.scm \ - plot.scm +scm_DATA=stats.scm plot.scm EXTRA_DIST=$(scm_DATA) diff --git a/guile/mu/contact.scm b/guile/mu/contact.scm index 7165a780..61f36922 100644 --- a/guile/mu/contact.scm +++ b/guile/mu/contact.scm @@ -1,141 +1,4 @@ -;; -;; 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. -;; +(define-module (mu contact)) +(display "(mu contact) is deprecated, please remove from (use-modules ...)") +(newline) -;; 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. - -;; some guile/scheme functions to get various statistics of my mu -;; message store. - -(define-module (mu contact) - :use-module (oop goops) - :use-module (mu message) - :use-module (texinfo string-utils) - :export ( - - mu:name - mu:email - mu:contact->string - ;; - mu:for-each-contact - ;; - mu:contacts - ;; - - mu:frequency - mu:last-seen - )) - -(define-class () - (name #:init-value #f #:accessor mu:name #:init-keyword #:name) - (email #:init-value #f #:accessor mu:email #:init-keyword #:email)) - -(define-method (mu:contacts (msg ) contact-type) - "Get all contacts for MSG of the given CONTACT-TYPE. MSG is of type , -while contact type is either `mu:to', `mu:cc', `mu:from' or `mu:bcc' -to get the corresponding type of contacts, or #t to get all. Returns a -list of objects." - (map (lambda (pair) ;; a pair (na . addr) - (make #:name (car pair) #:email (cdr pair))) - (mu:get-contacts (slot-ref msg 'msg) contact-type))) - -(define-method (mu:contacts (msg )) - "Get contacts of all types for message MSG as a list of -objects." - (mu:contacts msg #t)) - -(define-class () - (tstamp #:init-value 0 #:accessor mu:timestamp #:init-keyword #:timestamp) - (last-seen #:init-value 0 #:accessor mu:last-seen) - (freq #:init-value 1 #:accessor mu: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 (ct) - (let ((ct-ws (make - #:name (mu:name ct) - #:email (mu:email ct) - #:timestamp (mu:date msg)))) - (update-contacts-hash c-hash ct-ws))) - (mu:contacts msg #t))) - expr) - (hash-for-each ;; c-hash now contains a map of email->contact - (lambda (email ct-ws) (proc ct-ws)) 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 (mu:email nc)))) - (if (not xc) ;; no existing contact with this email address? - (hash-set! c-hash (mu:email nc) nc) ;; store the new contact. - ;; otherwise: - (begin - ;; 1) update the frequency for the existing contact - (set! (mu:frequency xc) (1+ (mu: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 (mu:name nc) (> (string-length (mu:name nc))) - (> (mu:timestamp nc) (mu:timestamp xc))) - (set! (mu:name xc) (mu:name nc)) - (set! (mu:timestamp xc) (mu:timestamp nc))) - ;; 3) update last-seen with timestamp, if x's timestamp is newer - (if (> (mu:timestamp nc) (mu:last-seen xc)) - (set! (mu:last-seen xc) (mu:timestamp nc))) - ;; okay --> now xc has been updated; but it back in the hash - (hash-set! c-hash (mu:email xc) xc))))) - -(define-method (mu:contact->string (contact ) (form )) - "Convert a contact to a string in format FORM, which is a string, -either \"org-contact\", \"mutt-alias\", \"mutt-ab\", -\"wanderlust\", \"quoted\" \"plain\"." - (let* ((name (mu:name contact)) (email (mu:email contact)) - (nick ;; simplistic nick guessing... - (string-map - (lambda(kar) - (if (char-alphabetic? kar) kar #\_)) - (string-downcase (or name email))))) - (cond - ((string= form "plain") - (format #f "~a~a~a" (or name "") (if name " " "") email)) - ((string= form "org-contact") - (format #f "* ~s\n:PROPERTIES:\n:EMAIL:~a\n:NICK:~a\n:END:" - (or name email) email nick)) - ((string= form "wanderlust") - (format #f "~a ~s ~s" - nick (or name email) email)) - ((string= form "mutt-alias") - (format #f "alias ~a ~a <~a>" - nick (or name email) email)) - ((string= form "mutt-ab") - (format #f "~a\t~a\t" - email (or name ""))) - ((string= form "quoted") - (string-append - "\"" - (escape-special-chars - (string-append - (if name - (format #f "\"~a\" " name) - "") - (format #f "<~a>" email)) - "\"" #\\) - "\"")) - (else (error "Unsupported format"))))) diff --git a/guile/mu/message.scm b/guile/mu/message.scm index 0b6c18f0..61c6e77d 100644 --- a/guile/mu/message.scm +++ b/guile/mu/message.scm @@ -1,107 +1,4 @@ -;; -;; Copyright (C) 2011-2012 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. -;; +(define-module (mu message)) +(display "(mu message) is deprecated, please remove from (use-modules ...)") +(newline) -;; 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. - -(define-module (mu message) - :use-module (oop goops) - :export ( ;; classes - - mu:for-each-message - mu:message-list - ;; internal - mu:get-header - mu:get-field - mu:for-each-msg-internal - ;; message funcs - header - ;; other symbols - mu:field:bcc - mu:field:body-html - mu:field:body-txt - mu:field:cc - mu:field:date - mu:field:flags - mu:field:from - mu:field:maildir - mu:field:message-id - mu:field:path - mu:field:prio - mu:field:refs - mu:field:size - mu:field:subject - mu:field:tags - mu:field:timestamp - mu:field:to)) - -(load-extension "libguile-mu" "mu_guile_message_init") - -(define-class () - (msg #:init-keyword #:msg)) ;; the MuMsg-smob we're wrapping - -(define-syntax define-getter - (syntax-rules () - ((define-getter method-name field) - (begin - (define-method (method-name (msg )) - (mu:get-field (slot-ref msg 'msg) field)) - (export method-name))))) - -(define-getter mu:bcc mu:field:bcc) -(define-getter mu:body-html mu:field:body-html) -(define-getter mu:body-txt mu:field:body-txt) -(define-getter mu:cc mu:field:cc) -(define-getter mu:date mu:field:date) -(define-getter mu:flags mu:field:flags) -(define-getter mu:from mu:field:from) -(define-getter mu:maildir mu:field:maildir) -(define-getter mu:message-id mu:field:message-id) -(define-getter mu:path mu:field:path) -(define-getter mu:priority mu:field:prio) -(define-getter mu:references mu:field:refs) -(define-getter mu:size mu:field:size) -(define-getter mu:subject mu:field:subject) -(define-getter mu:tags mu:field:tags) -(define-getter mu:timestamp mu:field:timestamp) -(define-getter mu:to mu:field:to) - - -(define-method (header (msg ) (hdr )) - "Get an arbitrary header HDR from message MSG; return #f if it does -not exist." - (mu:get-header (slot-ref msg 'msg) hdr)) - -(define* (mu:for-each-message func #:optional (expr #t) (maxresults -1)) - "Execute function FUNC for each message that matches mu search expression EXPR. -If EXPR is not provided, match /all/ messages in the store. MAXRESULTS -specifies the maximum of messages to return, or -1 (the default) for -no limit." - (mu:for-each-msg-internal - (lambda (msg) - (func (make #:msg msg))) - expr - maxresults)) - -(define* (mu:message-list #:optional (expr #t) (maxresults -1)) - "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. MAXRESULTS specifies the maximum of messages to return, or --1 (the default) for no limit." - (let ((lst '())) - (mu:for-each-message - (lambda (m) - (set! lst (append! lst (list m)))) expr maxresults) - lst)) diff --git a/guile/mu/part.scm b/guile/mu/part.scm index 4115422b..538e92b3 100644 --- a/guile/mu/part.scm +++ b/guile/mu/part.scm @@ -1,71 +1,4 @@ -;; -;; Copyright (C) 2011-2012 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. -;; +(define-module (mu part)) +(display "(mu part) is deprecated, please remove from (use-modules ...)") +(newline) -;; 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. - -(define-module (mu part) - :use-module (oop goops) - :use-module (mu) - :use-module (mu message) - :export (;; get-part - ;; classes - - ;; message function - mu:attachments - mu:parts - ;; methods - mu:name - mu:mime-type -;; size - mu:save - mu:save-as)) - -(define-class () - (msgpath #:init-value #f #:init-keyword #:msgpath) - (index #:init-value #f #:init-keyword #:index) - (name #:init-value #f #:getter mu:name #:init-keyword #:name) - (mime-type #:init-value #f #:getter mu:mime-type #:init-keyword #:mime-type) - (size #:init-value 0 #:getter mu:size #:init-keyword #:size)) - -(define-method (get-parts (msg ) (files-only )) - "Get the part for MSG as a list of objects; if FILES-ONLY is #t, -only get the part with file names." - (map (lambda (part) - (make - #:msgpath (list-ref part 0) - #:index (list-ref part 1) - #:name (list-ref part 2) - #:mime-type (list-ref part 3) - #:size (list-ref part 4))) - (mu:get-parts (slot-ref msg 'msg) files-only))) - -(define-method (mu:attachments (msg )) - "Get the attachments for MSG as a list of objects." - (get-parts msg #t)) - -(define-method (mu:parts (msg )) - "Get the MIME-parts for MSG as a list of objects." - (get-parts msg #f)) - -(define-method (mu:save (part )) - "Save PART to a temporary file, and return the file name. If the -part had a filename, the temporary file's file name will be just that; -otherwise a name is made up." - (mu:save-part (slot-ref part 'msgpath) (slot-ref part 'index))) - -(define-method (mu:save-as (part ) (filepath )) - "Save message-part PART to file system path PATH." - (copy-file (save part) filepath)) diff --git a/guile/mu/stats.scm b/guile/mu/stats.scm index bedfd35f..47ba49aa 100644 --- a/guile/mu/stats.scm +++ b/guile/mu/stats.scm @@ -24,7 +24,8 @@ :use-module (ice-9 r5rs) :export ( mu:tabulate mu:average - mu:stddev + mu:standard-deviation + mu:pearsons-r mu:weekday-numbers->names mu:month-numbers->names)) @@ -45,7 +46,7 @@ get back a list like (set! table (assoc-set! table val (1+ old-freq))))) expr) table)) - + (define (average lst) "Calculate the average of a list LST of numbers, or #f if undefined." (if (null? lst) @@ -67,12 +68,11 @@ undefined." EXPR (or #t for all). Returns #f if undefined." (average (map func (mu:message-list expr)))) -(define* (mu:stddev func #:optional (expr #t)) +(define* (mu:standard-deviation func #:optional (expr #t)) "Get the standard deviation for the the values of FUNC applied to all messages matching EXPR (or #t for all). Returns #f if undefined." (stddev (map func (mu:message-list expr)))) - (define* (mu:max func #:optional (expr #t)) "Get the maximum value of FUNC applied to all messages matching EXPR (or #t for all). Returns #f if undefined." @@ -83,6 +83,23 @@ EXPR (or #t for all). Returns #f if undefined." EXPR (or #t for all). Returns #f if undefined." (apply min (map func (mu:message-list expr)))) +(define* (mu:pearsons-r func1 func2 #:optional (expr #t)) + "Calculate Pearson's product-moment correlation coefficient between +func1 and func2. Inefficient implementation." + (let* ((msglist (mu:message-list expr)) + (lst-x (map func1 msglist)) + (lst-y (map func2 msglist)) + (avg-x (average lst-x)) + (avg-y (average lst-y)) + (denominator (sqrt (* (stddev lst-x) (stddev lst-y)))) + (n (length lst-x)) + (cov-xy 0)) + (while (not (null? lst-x)) + (set! cov-xy (+ (* (- (car lst-x) avg-x) (- (car lst-y) avg-y)))) + (set! lst-x (cdr lst-x)) + (set! lst-y (cdr lst-y))) + (/ (/ cov-xy n) denominator))) + ;; a list of abbreviated, localized day names (define day-names diff --git a/guile/tests/test-mu-guile.scm b/guile/tests/test-mu-guile.scm index 65b20770..91cc658d 100755 --- a/guile/tests/test-mu-guile.scm +++ b/guile/tests/test-mu-guile.scm @@ -21,7 +21,7 @@ exec guile -e main -s $0 $@ (setlocale LC_ALL "") (use-modules (ice-9 getopt-long) (ice-9 optargs) (ice-9 popen) (ice-9 format)) -(use-modules (mu) (mu message) (mu stats) (mu plot)) +(use-modules (mu)) (define (n-results-or-exit query n) "Run QUERY, and exit 1 if the number of results != N." @@ -34,7 +34,6 @@ exec guile -e main -s $0 $@ (define (test-queries) "Test a bunch of queries (or die trying)." - (n-results-or-exit "hello" 1) (n-results-or-exit "f:john fruit" 1) (n-results-or-exit "f:soc@example.com" 1) @@ -55,22 +54,36 @@ exec guile -e main -s $0 $@ (n-results-or-exit "y:image*" 1) (n-results-or-exit "mime:message/rfc822" 2)) +(define (error-exit msg . args) + "Print error and exit." + (let ((msg (apply format #f msg args))) + (simple-format (current-error-port) "*ERROR*: ~A\n" msg) + (exit 1))) -(define (str-equal-or-exit s1 s2) +(define (str-equal-or-exit got exp) "S1 == S2 or exit 1." ;; (format #t "'~A' <=> '~A'\n" s1 s2) - (if (not (string= s1 s2)) - (begin - (simple-format (current-error-port) "Message: expected \"~A\", got \"~A\"\n" - s1 s2) - (exit 1)))) + (if (not (string= exp got)) + (error-exit "Expected \"~A\", got \"~A\"\n" exp got))) (define (test-message) "Test functions for a particular message." + (let ((msg (car (mu:message-list "hello")))) (str-equal-or-exit (mu:subject msg) "Fwd: rfc822") (str-equal-or-exit (mu:to msg) "martin") - (str-equal-or-exit (mu:from msg) "foobar "))) + (str-equal-or-exit (mu:from msg) "foobar ") + + (if (not (equal? (mu:priority msg) mu:prio:normal)) + (error-exit "Expected ~A, got ~A" (mu:priority msg) mu:prio:normal))) + + (let ((msg (car (mu:message-list "atoms")))) + (str-equal-or-exit (mu:subject msg) "atoms") + (str-equal-or-exit (mu:to msg) "Democritus ") + (str-equal-or-exit (mu:from msg) "\"Richard P. Feynman\" ") + + (if (not (equal? (mu:priority msg) mu:prio:high)) + (error-exit "Expected ~a, got ~a" (mu:priority msg) mu:prio:high)))) (define (test-stats)