emacs
/
mu
mirror of https://github.com/djcb/mu.git
1
0
Fork 0
Code Issues Releases Wiki Activity

* guile: some general improvements / cleanups in module loading, object 

visibilty. turn some integers (such as message priority, log level, contact
  type) into symbols.
This commit is contained in:
djcb 2012-07-14 12:32:15 +03:00
parent fcb202d618
commit 8e3fbe380e
10 changed files with 576 additions and 671 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
guile/Makefile.am
View File

@ -44,6 +44,8 @@ libguile_mu_la_LIBADD= \
${top_builddir}/lib/libmu.la \ ${top_builddir}/lib/libmu.la \
${GUILE_LIBS} ${GUILE_LIBS}
libguile_mu_la_LDFLAGS= -export-dynamic
XFILES= \ XFILES= \
mu-guile.x \ mu-guile.x \
mu-guile-message.x mu-guile-message.x
@ -53,13 +55,6 @@ info_TEXINFOS= \
mu_guile_TEXINFOS= \ mu_guile_TEXINFOS= \
fdl.texi 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) BUILT_SOURCES=$(XFILES)
snarfcppopts= $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) $(INCLUDES) snarfcppopts= $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) $(INCLUDES)
@ -67,9 +62,14 @@ SUFFIXES = .x .doc
.c.x: .c.x:
$(GUILE_SNARF) -o $@ $< $(snarfcppopts) $(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. ## Add -MG to make the .x magic work with auto-dep code.
MKDEP = $(CC) -M -MG $(snarfcppopts) MKDEP = $(CC) -M -MG $(snarfcppopts)
DISTCLEANFILES=$(XFILES) DISTCLEANFILES=$(XFILES)
EXTRA_DIST=$(scm_DATA)

453
guile/mu-guile-message.c
View File

@ -32,6 +32,17 @@
#include <mu-msg.h> #include <mu-msg.h>
#include <mu-msg-part.h> #include <mu-msg-part.h>
/* 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 { struct _MuMsgWrapper {
MuMsg *_msg; MuMsg *_msg;
@ -40,10 +51,6 @@ struct _MuMsgWrapper {
typedef struct _MuMsgWrapper MuMsgWrapper; typedef struct _MuMsgWrapper MuMsgWrapper;
static long MSG_TAG; static long MSG_TAG;
/* pseudo field, not in Xapian */
#define MU_GUILE_MSG_FIELD_ID_TIMESTAMP (MU_MSG_FIELD_ID_NUM + 1)
static gboolean static gboolean
mu_guile_scm_is_msg (SCM scm) mu_guile_scm_is_msg (SCM scm)
{ {
@ -64,109 +71,6 @@ mu_guile_msg_to_scm (MuMsg *msg)
SCM_RETURN_NEWSMOB (MSG_TAG, msgwrap); 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);
if (msg_smob == SCM_BOOL_F)
scm_puts ("#f", port);
else
scm_puts (mu_msg_get_path(msgwrap->_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 { struct _FlagData {
MuFlags flags; MuFlags flags;
SCM lst; SCM lst;
@ -174,22 +78,36 @@ struct _FlagData {
typedef struct _FlagData FlagData; typedef struct _FlagData FlagData;
static void static void
check_flag (MuFlags flag, FlagData *fdata) check_flag (MuFlags flag, FlagData *fdata)
{ {
SCM item; SCM flag_scm;
char *flagsym;
if (!(fdata->flags & flag)) if (!(fdata->flags & flag))
return; return;
flagsym = g_strconcat ("mu:", mu_flag_name(flag), NULL); switch (flag) {
item = scm_list_1 (scm_from_utf8_symbol(flagsym)); case MU_FLAG_NEW: flag_scm = SYMB_FLAG_NEW; break;
g_free (flagsym); case MU_FLAG_PASSED: flag_scm = SYMB_FLAG_PASSED; break;
case MU_FLAG_REPLIED: flag_scm = SYMB_FLAG_REPLIED; break;
fdata->lst = scm_append_x (scm_list_2(fdata->lst, item)); 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,
scm_list_1 (flag_scm)));
}
static SCM static SCM
get_flags_scm (MuMsg *msg) get_flags_scm (MuMsg *msg)
@ -210,12 +128,10 @@ get_prio_scm (MuMsg *msg)
{ {
switch (mu_msg_get_prio (msg)) { switch (mu_msg_get_prio (msg)) {
case MU_MSG_PRIO_LOW: case MU_MSG_PRIO_LOW: return SYMB_PRIO_LOW;
return scm_from_utf8_symbol("mu:low"); case MU_MSG_PRIO_NORMAL: return SYMB_PRIO_NORMAL;
case MU_MSG_PRIO_NORMAL: case MU_MSG_PRIO_HIGH: return SYMB_PRIO_HIGH;
return scm_from_utf8_symbol("mu:normal");
case MU_MSG_PRIO_HIGH:
return scm_from_utf8_symbol("mu:high");
default: default:
g_return_val_if_reached (SCM_UNDEFINED); g_return_val_if_reached (SCM_UNDEFINED);
} }
@ -241,7 +157,7 @@ msg_string_list_field (MuMsg *msg, MuMsgFieldId mfid)
} }
SCM_DEFINE_PUBLIC(get_field, "mu:get-field", 2, 0, 0, SCM_DEFINE (get_field, "mu:c:get-field", 2, 0, 0,
(SCM MSG, SCM FIELD), (SCM MSG, SCM FIELD),
"Get the field FIELD from message MSG.\n") "Get the field FIELD from message MSG.\n")
#define FUNC_NAME s_get_field #define FUNC_NAME s_get_field
@ -326,8 +242,7 @@ contacts_to_list (MuMsgContact *contact, EachContactData *ecdata)
} }
SCM_DEFINE (get_contacts, "mu:c:get-contacts", 2, 0, 0,
SCM_DEFINE_PUBLIC (get_contacts, "mu:get-contacts", 2, 0, 0,
(SCM MSG, SCM CONTACT_TYPE), (SCM MSG, SCM CONTACT_TYPE),
"Get a list of contact information pairs.\n") "Get a list of contact information pairs.\n")
#define FUNC_NAME s_get_contacts #define FUNC_NAME s_get_contacts
@ -336,7 +251,7 @@ SCM_DEFINE_PUBLIC (get_contacts, "mu:get-contacts", 2, 0, 0,
EachContactData ecdata; EachContactData ecdata;
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); 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); CONTACT_TYPE, SCM_ARG2, FUNC_NAME);
if (CONTACT_TYPE == SCM_BOOL_F) 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) else if (CONTACT_TYPE == SCM_BOOL_T)
ecdata.ctype = MU_MSG_CONTACT_TYPE_ALL; ecdata.ctype = MU_MSG_CONTACT_TYPE_ALL;
else { else {
MuMsgFieldId mfid; if (scm_is_eq (CONTACT_TYPE, SYMB_CONTACT_TO))
mfid = scm_to_uint (CONTACT_TYPE); ecdata.ctype = MU_MSG_CONTACT_TYPE_TO;
switch (mfid) { else if (scm_is_eq (CONTACT_TYPE, SYMB_CONTACT_CC))
case MU_MSG_FIELD_ID_TO: ecdata.ctype = MU_MSG_CONTACT_TYPE_TO; break; ecdata.ctype = MU_MSG_CONTACT_TYPE_CC;
case MU_MSG_FIELD_ID_FROM: ecdata.ctype = MU_MSG_CONTACT_TYPE_FROM; break; else if (scm_is_eq (CONTACT_TYPE, SYMB_CONTACT_BCC))
case MU_MSG_FIELD_ID_CC: ecdata.ctype = MU_MSG_CONTACT_TYPE_CC; break; ecdata.ctype = MU_MSG_CONTACT_TYPE_BCC;
case MU_MSG_FIELD_ID_BCC: ecdata.ctype = MU_MSG_CONTACT_TYPE_BCC; break; else if (scm_is_eq (CONTACT_TYPE, SYMB_CONTACT_FROM))
default: g_return_val_if_reached (SCM_UNDEFINED); ecdata.ctype = MU_MSG_CONTACT_TYPE_FROM;
} else
/* FIXME: rais error */
g_return_val_if_reached (SCM_UNDEFINED);
} }
ecdata.lst = SCM_EOL; 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, mu_msg_contact_foreach (msgwrap->_msg,
(MuMsgContactForeachFunc)contacts_to_list, (MuMsgContactForeachFunc)contacts_to_list,
&ecdata); &ecdata);
/* explicitly close the file backend, so we won't run out of fds */
/* explicitly close the file backend, so we won't run of fds */
mu_msg_close_file_backend (msgwrap->_msg); mu_msg_close_file_backend (msgwrap->_msg);
return ecdata.lst; 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), (SCM MSG, SCM ATTS_ONLY),
"Get the list of mime-parts for MSG. If ATTS_ONLY is #t, 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 " "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 #undef FUNC_NAME
SCM_DEFINE_PUBLIC (save_part, "mu:save-part", 2, 0, 0, SCM_DEFINE (get_header, "mu:c:get-header", 2, 0, 0,
(SCM MSGPATH, SCM INDEX), (SCM MSG, SCM HEADER), "Get an arbitary HEADER from MSG.\n")
"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")
#define FUNC_NAME s_get_header #define FUNC_NAME s_get_header
{ {
MuMsgWrapper *msgwrap; MuMsgWrapper *msgwrap;
@ -514,89 +382,6 @@ SCM_DEFINE_PUBLIC (get_header, "mu:get-header", 2, 0, 0,
#undef FUNC_NAME #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 static void
call_func (SCM FUNC, MuMsgIter *iter, const char* func_name) 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_DEFINE (for_each_message, "mu:c:for-each-message", 3, 0, 0,
(SCM FUNC, SCM EXPR, SCM MAXNUM), (SCM FUNC, SCM EXPR, SCM MAXNUM),
"Call FUNC for each msg in the message store matching EXPR. EXPR is" "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 " "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 " "case, limit the messages to only those matching the expression, in the "
"latter case, match /all/ messages if the EXPR equals #t, and match " "latter case, match /all/ messages if the EXPR equals #t, and match "
"none if EXPR equals #f. Note -- function for internal use.") "none if EXPR equals #f.")
#define FUNC_NAME s_for_each_msg_internal #define FUNC_NAME s_for_each_message
{ {
MuMsgIter *iter; MuMsgIter *iter;
char* expr; 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); EXPR, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_integer (MAXNUM), MAXNUM, SCM_ARG3, 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) if (EXPR == SCM_BOOL_F)
return SCM_UNSPECIFIED; /* nothing to do */ 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 #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);
if (msg_smob == SCM_BOOL_F)
scm_puts ("#f", port);
else
scm_puts (mu_msg_get_path(msgwrap->_msg),
port);
scm_puts (">", port);
return 1;
}
void* void*
mu_guile_message_init (void *data) 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_free (MSG_TAG, msg_free);
scm_set_smob_print (MSG_TAG, msg_print); scm_set_smob_print (MSG_TAG, msg_print);
define_vars ();
define_symbols (); define_symbols ();
#ifndef SCM_MAGIC_SNARFER
#include "mu-guile-message.x" #include "mu-guile-message.x"
#endif /*SCM_MAGIC_SNARFER*/
return NULL; return NULL;
} }

82
guile/mu-guile.c
View File

@ -138,20 +138,19 @@ mu_guile_initialized (void)
} }
SCM_DEFINE_PUBLIC (mu_initialize, "mu:initialize", 0, 1, 0, SCM_DEFINE_PUBLIC (mu_initialize, "mu:initialize", 0, 1, 0,
(SCM MUHOME), (SCM MUHOME),
"Initialize mu - needed before you call any of the other " "Initialize mu - needed before you call any of the other "
"functions. Optionally, you can provide MUHOME which should be an " "functions. Optionally, you can provide MUHOME which should be an "
"absolute path to your mu home directory " "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 #define FUNC_NAME s_mu_initialize
{ {
char *muhome; char *muhome;
gboolean rv; gboolean rv;
SCM_ASSERT (scm_is_string (MUHOME) || MUHOME == SCM_BOOL_F || SCM_UNBNDP(MUHOME), SCM_ASSERT (scm_is_string (MUHOME) || MUHOME == SCM_BOOL_F ||
MUHOME, SCM_ARG1, FUNC_NAME); SCM_UNBNDP(MUHOME), MUHOME, SCM_ARG1, FUNC_NAME);
if (mu_guile_initialized()) if (mu_guile_initialized())
return mu_guile_error (FUNC_NAME, 0, "Already initialized", return mu_guile_error (FUNC_NAME, 0, "Already initialized",
@ -176,7 +175,6 @@ SCM_DEFINE_PUBLIC (mu_initialize, "mu:initialize", 0, 1, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE_PUBLIC (mu_initialized_p, "mu:initialized?", 0, 0, 0, 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 #define FUNC_NAME s_mu_initialized_p
@ -186,63 +184,71 @@ SCM_DEFINE_PUBLIC (mu_initialized_p, "mu:initialized?", 0, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (log_func, "mu:c:log", 1, 0, 1, (SCM LEVEL, SCM FRM, SCM ARGS),
static SCM "log some message at LEVEL using a list of ARGS applied to FRM"
write_log (GLogLevelFlags level, SCM FRM, SCM ARGS) "(in 'simple-format' notation).\n")
#define FUNC_NAME __FUNCTION__ #define FUNC_NAME s_log_func
{ {
gchar *output;
SCM str; SCM str;
int level;
SCM_ASSERT (scm_is_string(FRM), FRM, SCM_ARG1, "<write_log>"); SCM_ASSERT (scm_integer_p(LEVEL), LEVEL, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_string(FRM), FRM, SCM_ARG2, "<write_log>");
SCM_VALIDATE_REST_ARGUMENT(ARGS); 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); 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); output = scm_to_utf8_string (str);
g_log (G_LOG_DOMAIN, level, "%s", output); g_log (G_LOG_DOMAIN, level, "%s", output);
free (output); free (output);
}
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
#undef FUNC_NAME
} }
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (log_info, "mu:log-info", 1, 0, 1, (SCM FRM, SCM ARGS), static struct {
"log some message using a list of ARGS applied to FRM " const char* name;
"(in 'simple-format' notation).\n") unsigned val;
#define FUNC_NAME s_info } 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* void*
mu_guile_init (void *data) mu_guile_init (void *data)
{ {
define_vars ();
#ifndef SCM_MAGIC_SNARFER
#include "mu-guile.x" #include "mu-guile.x"
#endif /*SCM_MAGIC_SNARFER*/
return NULL; return NULL;
} }

284
guile/mu.scm
View File

@ -1,5 +1,4 @@
;; ;; Copyright (C) 2011-2012 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;; Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;; ;;
;; This program is free software; you can redistribute it and/or modify it ;; 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 ;; 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. ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
(define-module (mu) (define-module (mu)
:use-module (oop goops)
:use-module (ice-9 optargs)
:use-module (texinfo string-utils)
:export :export
(mu:initialize)) ( ;; classes
<mu:message>
<mu:contact>
<mu:part>
;; 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:contact-with-stats>
mu:frequency
mu:last-seen
;; parts
<mu:part>
;; message function
mu:attachments
mu:parts
;; <mu:part> methods
mu:name
mu:mime-type
;; size
;; mu:save
;; mu:save-as
))
;; this is needed for guile < 2.0.4 ;; this is needed for guile < 2.0.4
(setlocale LC_ALL "") (setlocale LC_ALL "")
;; load the binary
(load-extension "libguile-mu" "mu_guile_init") (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 <mu:message> ()
(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:message>))
(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 <mu:message>) (hdr <string>))
"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 <mu:message> #: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 <mu:contact> ()
(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 <mu:message>) contact-type)
"Get all contacts for MSG of the given CONTACT-TYPE. MSG is of type <mu-message>,
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 <mu-contact> objects."
(map (lambda (pair) ;; a pair (na . addr)
(make <mu:contact> #:name (car pair) #:email (cdr pair)))
(mu:get-contacts (slot-ref msg 'msg) contact-type)))
(define-method (mu:contacts (msg <mu:message>))
"Get contacts of all types for message MSG as a list of <mu-contact>
objects."
(mu:contacts msg #t))
(define-class <mu:contact-with-stats> (<mu:contact>)
(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 <mu-contact> 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 <mu:contact-with-stats>
#: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 <mu:contact-with-stats>))
"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 <mu:contact>) (form <string>))
"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 <mu:part> ()
(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 <mu:message>) (files-only <boolean>))
"Get the part for MSG as a list of <mu:part> objects; if FILES-ONLY is #t,
only get the part with file names."
(map (lambda (part)
(make <mu:part>
#: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 <mu:message>))
"Get the attachments for MSG as a list of <mu:part> objects."
(get-parts msg #t))
(define-method (mu:parts (msg <mu:message>))
"Get the MIME-parts for MSG as a list of <mu-part> objects."
(get-parts msg #f))
;; (define-method (mu:save (part <mu: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 <mu:part>) (filepath <string>))
;; "Save message-part PART to file system path PATH."
;; (copy-file (save part) filepath))

7
guile/mu/Makefile.am
View File

@ -19,11 +19,6 @@ include $(top_srcdir)/gtest.mk
# FIXME: GUILE_SITEDIR would be better, but that # FIXME: GUILE_SITEDIR would be better, but that
# breaks 'make distcheck' # breaks 'make distcheck'
scmdir=${prefix}/share/guile/site/2.0/mu/ scmdir=${prefix}/share/guile/site/2.0/mu/
scm_DATA= \ scm_DATA=stats.scm plot.scm
message.scm \
contact.scm \
part.scm \
stats.scm \
plot.scm
EXTRA_DIST=$(scm_DATA) EXTRA_DIST=$(scm_DATA)

143
guile/mu/contact.scm
View File

@ -1,141 +1,4 @@
;; (define-module (mu contact))
;; Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl> (display "(mu contact) is deprecated, please remove from (use-modules ...)")
;; (newline)
;; 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.
;; 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:contact>
mu:name
mu:email
mu:contact->string
;;
mu:for-each-contact
;;
mu:contacts
;;
<mu:contact-with-stats>
mu:frequency
mu:last-seen
))
(define-class <mu:contact> ()
(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 <mu:message>) contact-type)
"Get all contacts for MSG of the given CONTACT-TYPE. MSG is of type <mu-message>,
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 <mu-contact> objects."
(map (lambda (pair) ;; a pair (na . addr)
(make <mu:contact> #:name (car pair) #:email (cdr pair)))
(mu:get-contacts (slot-ref msg 'msg) contact-type)))
(define-method (mu:contacts (msg <mu:message>))
"Get contacts of all types for message MSG as a list of <mu-contact>
objects."
(mu:contacts msg #t))
(define-class <mu:contact-with-stats> (<mu:contact>)
(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 <mu-contact> 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 <mu:contact-with-stats>
#: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 <mu:contact-with-stats>))
"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 <mu:contact>) (form <string>))
"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")))))

109
guile/mu/message.scm
View File

@ -1,107 +1,4 @@
;; (define-module (mu message))
;; Copyright (C) 2011-2012 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl> (display "(mu message) is deprecated, please remove from (use-modules ...)")
;; (newline)
;; 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.
(define-module (mu message)
:use-module (oop goops)
:export ( ;; classes
<mu:message>
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 <mu:message> ()
(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:message>))
(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 <mu:message>) (hdr <string>))
"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 <mu:message> #: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))

73
guile/mu/part.scm
View File

@ -1,71 +1,4 @@
;; (define-module (mu part))
;; Copyright (C) 2011-2012 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl> (display "(mu part) is deprecated, please remove from (use-modules ...)")
;; (newline)
;; 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.
(define-module (mu part)
:use-module (oop goops)
:use-module (mu)
:use-module (mu message)
:export (;; get-part
;; classes
<mu:part>
;; message function
mu:attachments
mu:parts
;; <mu:part> methods
mu:name
mu:mime-type
;; size
mu:save
mu:save-as))
(define-class <mu:part> ()
(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 <mu:message>) (files-only <boolean>))
"Get the part for MSG as a list of <mu:part> objects; if FILES-ONLY is #t,
only get the part with file names."
(map (lambda (part)
(make <mu:part>
#: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 <mu:message>))
"Get the attachments for MSG as a list of <mu:part> objects."
(get-parts msg #t))
(define-method (mu:parts (msg <mu:message>))
"Get the MIME-parts for MSG as a list of <mu-part> objects."
(get-parts msg #f))
(define-method (mu:save (part <mu: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 <mu:part>) (filepath <string>))
"Save message-part PART to file system path PATH."
(copy-file (save part) filepath))

23
guile/mu/stats.scm
View File

@ -24,7 +24,8 @@
:use-module (ice-9 r5rs) :use-module (ice-9 r5rs)
:export ( mu:tabulate :export ( mu:tabulate
mu:average mu:average
mu:stddev mu:standard-deviation
mu:pearsons-r
mu:weekday-numbers->names mu:weekday-numbers->names
mu:month-numbers->names)) mu:month-numbers->names))
@ -67,12 +68,11 @@ undefined."
EXPR (or #t for all). Returns #f if undefined." EXPR (or #t for all). Returns #f if undefined."
(average (map func (mu:message-list expr)))) (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 "Get the standard deviation for the the values of FUNC applied to
all messages matching EXPR (or #t for all). Returns #f if undefined." all messages matching EXPR (or #t for all). Returns #f if undefined."
(stddev (map func (mu:message-list expr)))) (stddev (map func (mu:message-list expr))))
(define* (mu:max func #:optional (expr #t)) (define* (mu:max func #:optional (expr #t))
"Get the maximum value of FUNC applied to all messages matching "Get the maximum value of FUNC applied to all messages matching
EXPR (or #t for all). Returns #f if undefined." 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." EXPR (or #t for all). Returns #f if undefined."
(apply min (map func (mu:message-list expr)))) (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 ;; a list of abbreviated, localized day names
(define day-names (define day-names

31
guile/tests/test-mu-guile.scm
View File

@ -21,7 +21,7 @@ exec guile -e main -s $0 $@
(setlocale LC_ALL "") (setlocale LC_ALL "")
(use-modules (ice-9 getopt-long) (ice-9 optargs) (ice-9 popen) (ice-9 format)) (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) (define (n-results-or-exit query n)
"Run QUERY, and exit 1 if the number of results != 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) (define (test-queries)
"Test a bunch of queries (or die trying)." "Test a bunch of queries (or die trying)."
(n-results-or-exit "hello" 1) (n-results-or-exit "hello" 1)
(n-results-or-exit "f:john fruit" 1) (n-results-or-exit "f:john fruit" 1)
(n-results-or-exit "f:soc@example.com" 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 "y:image*" 1)
(n-results-or-exit "mime:message/rfc822" 2)) (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." "S1 == S2 or exit 1."
;; (format #t "'~A' <=> '~A'\n" s1 s2) ;; (format #t "'~A' <=> '~A'\n" s1 s2)
(if (not (string= s1 s2)) (if (not (string= exp got))
(begin (error-exit "Expected \"~A\", got \"~A\"\n" exp got)))
(simple-format (current-error-port) "Message: expected \"~A\", got \"~A\"\n"
s1 s2)
(exit 1))))
(define (test-message) (define (test-message)
"Test functions for a particular message." "Test functions for a particular message."
(let ((msg (car (mu:message-list "hello")))) (let ((msg (car (mu:message-list "hello"))))
(str-equal-or-exit (mu:subject msg) "Fwd: rfc822") (str-equal-or-exit (mu:subject msg) "Fwd: rfc822")
(str-equal-or-exit (mu:to msg) "martin") (str-equal-or-exit (mu:to msg) "martin")
(str-equal-or-exit (mu:from msg) "foobar <foo@example.com>"))) (str-equal-or-exit (mu:from msg) "foobar <foo@example.com>")
(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 <demo@example.com>")
(str-equal-or-exit (mu:from msg) "\"Richard P. Feynman\" <rpf@example.com>")
(if (not (equal? (mu:priority msg) mu:prio:high))
(error-exit "Expected ~a, got ~a" (mu:priority msg) mu:prio:high))))
(define (test-stats) (define (test-stats)