mirror of https://github.com/djcb/mu.git
* 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
parent
fcb202d618
commit
8e3fbe380e
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -32,6 +32,17 @@
|
|||
#include <mu-msg.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 {
|
||||
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);
|
||||
|
||||
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 {
|
||||
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);
|
||||
|
||||
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*
|
||||
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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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, "<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);
|
||||
|
||||
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;
|
||||
}
|
||||
|
|
|
|||
284
guile/mu.scm
284
guile/mu.scm
|
|
@ -1,5 +1,4 @@
|
|||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;; Copyright (C) 2011-2012 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;;
|
||||
;; 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
|
||||
<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
|
||||
(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 <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))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -1,141 +1,4 @@
|
|||
;;
|
||||
;; Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;;
|
||||
;; 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: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")))))
|
||||
|
|
|
|||
|
|
@ -1,107 +1,4 @@
|
|||
;;
|
||||
;; Copyright (C) 2011-2012 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;;
|
||||
;; 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: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))
|
||||
|
|
|
|||
|
|
@ -1,71 +1,4 @@
|
|||
;;
|
||||
;; Copyright (C) 2011-2012 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||
;;
|
||||
;; 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
|
||||
<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))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue