alx/mu4e
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* guile cleanup/overhaul (WIP)

Browse Source
This commit is contained in:
djcb
2012-01-01 18:17:29 +02:00
parent dd574cb8ba
commit 46e002a4fa
12 changed files with 586 additions and 831 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
guile/Makefile.am
View File

@ -36,18 +36,13 @@ lib_LTLIBRARIES= \
libguile_mu_la_SOURCES= \ libguile_mu_la_SOURCES= \
mu-guile.c \ mu-guile.c \
mu-guile.h \ mu-guile.h
mu-guile-msg.c \
mu-guile-msg.h \
mu-guile-util.c \
mu-guile-util.h
libguile_mu_la_LIBADD= \ libguile_mu_la_LIBADD= \
${top_builddir}/src/libmu.la \ ${top_builddir}/src/libmu.la \
${GUILE_LIBS} ${GUILE_LIBS}
XFILES= \ XFILES= \
mu-guile-msg.x \
mu-guile.x mu-guile.x
# FIXME: GUILE_SITEDIR would be better, but that # FIXME: GUILE_SITEDIR would be better, but that

18
guile/examples/contacts-export
View File

@ -35,7 +35,13 @@ exec guile -e main -s $0 $@
(cond (cond
((string= form "org-contacts") ((string= form "org-contacts")
(format #t "* ~a\n:PROPERTIES:\n:EMAIL:~a\n:END:\n\n" (format #t "* ~a\n:PROPERTIES:\n:EMAIL:~a\n:END:\n\n"
(or (name contact) (email contact)) (email contact))))) (or (name contact) (email contact)) (email contact)))
((string= form "plain")
(format #t "~a~a\n"
(or (name contact) "")
(if (name contact)
(string-append " <" (email contact) ">")
(email contact))))))
(define (main args) (define (main args)
(let* ((optionspec '( (muhome (value #t)) (let* ((optionspec '( (muhome (value #t))
@ -54,15 +60,13 @@ exec guile -e main -s $0 $@
(sort-by (or (option-ref options 'sort-by #f) "frequency")) (sort-by (or (option-ref options 'sort-by #f) "frequency"))
(revert (option-ref options 'revert #f)) (revert (option-ref options 'revert #f))
(form (or (option-ref options 'format #f) "plain")) (form (or (option-ref options 'format #f) "plain"))
(limit (string->number (option-ref options 'limit 1000000)))) (limit (string->number (option-ref options 'limit "1000000"))))
(if help (if help
(begin (begin
(display msg) (display msg)
(exit 0)) (exit 0))
(begin (begin
(if muhome (mu:initialize muhome)
(initialize-mu muhome)
(initialize-mu))
(let* ((sort-func (let* ((sort-func
(cond (cond
((string= sort-by "frequency") sort-by-freq) ((string= sort-by "frequency") sort-by-freq)
@ -70,7 +74,7 @@ exec guile -e main -s $0 $@
(else (begin (display msg) (exit 1))))) (else (begin (display msg) (exit 1)))))
(contacts '())) (contacts '()))
;; make a list of all contacts ;; make a list of all contacts
(for-each-contact (mu:for-each-contact
(lambda (c) (set! contacts (cons c contacts)))) (lambda (c) (set! contacts (cons c contacts))))
;; should we sort it? ;; should we sort it?
(if sort-by (if sort-by
@ -78,7 +82,7 @@ exec guile -e main -s $0 $@
(if revert (negate sort-func) sort-func)))) (if revert (negate sort-func) sort-func))))
;; should we limit the number? ;; should we limit the number?
(if limit (if (and limit (< limit (length contacts)))
(set! contacts (take! contacts limit))) (set! contacts (take! contacts limit)))
;; export! ;; export!
(for-each (for-each

56
guile/examples/msg-stats
View File

@ -21,7 +21,7 @@ exec guile -e main -s $0 $@
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
(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 msg)) (use-modules (mu) (mu message))
;; note, this is a rather inefficient way to calculate the number; for ;; note, this is a rather inefficient way to calculate the number; for
;; demonstration purposes only... ;; demonstration purposes only...
@ -53,31 +53,31 @@ exec guile -e main -s $0 $@
;; (length (mu:msg:cc msg)) ;; (length (mu:msg:cc msg))
;; (length (mu:msg:bcc msg)))) EXPR)) ;; (length (mu:msg:bcc msg)))) EXPR))
(define* (frequency FUNC #:optional (EXPR "")) ;; (define* (frequency FUNC #:optional (EXPR ""))
"FUNC is a function that takes a mMsg, and returns the frequency of ;; "FUNC is a function that takes a msg, and returns the frequency of
the different values this function returns. If FUNC returns a list, ;; the different values this function returns. If FUNC returns a list,
update the frequency table for each element of this list. If the ;; update the frequency table for each element of this list. If the
optional EXPR is provided, only consider messages that match it.\n" ;; optional EXPR is provided, only consider messages that match it.\n"
(let ((table '())) ;; (let ((table '()))
(for-each-message ;; (mu:for-each-message
(lambda(msg) ;; (lambda(msg)
;; note, if val is not already a list, turn it into a list ;; ;; note, if val is not already a list, turn it into a list
;; then, take frequency for each element in the list ;; ;; then, take frequency for each element in the list
(let* ((val (FUNC msg)) (vals (if (list? val) val (list val)))) ;; (let* ((val (FUNC msg)) (vals (if (list? val) val (list val))))
(for-each ;; (for-each
(lambda (val) ;; (lambda (val)
(let ((freq (assoc-ref table val))) ;; (let ((freq (assoc-ref table val)))
(set! table (assoc-set! table val ;; (set! table (assoc-set! table val
(+ 1 (if (eq? freq #f) 0 freq)))))) vals))) EXPR) ;; (+ 1 (if (eq? freq #f) 0 freq)))))) vals))) EXPR)
table)) ;; table))
(define* (per-weekday #:optional (EXPR "")) (define* (per-weekday #:optional (EXPR ""))
"Count the total number of messages for each weekday (0-6 for "Count the total number of messages for each weekday (0-6 for
Sun..Sat). If the optional EXPR is provided, only count the messages Sun..Sat). If the optional EXPR is provided, only count the messages
that match it. The result is a list of pairs (weekday . frequency).\n" that match it. The result is a list of pairs (weekday . frequency).\n"
(let* ((stats (frequency (let* ((stats (mu:tabulate-messages
(lambda (msg) (tm:wday (localtime (mu:msg:date msg)))) EXPR))) (lambda (msg) (tm:wday (localtime (date msg)))) EXPR)))
(sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of weekday (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of weekday
(define* (mu:plot:per-weekday #:optional (EXPR "")) (define* (mu:plot:per-weekday #:optional (EXPR ""))
@ -103,9 +103,9 @@ that match it. The result is a list of pairs (weekday . frequency).\n"
"Count the total number of messages for each month (1-12 for "Count the total number of messages for each month (1-12 for
Jan..Dec). If the optional EXPR is provided, only count the messages Jan..Dec). If the optional EXPR is provided, only count the messages
that match it. The result is a list of pairs (month . frequency).\n" that match it. The result is a list of pairs (month . frequency).\n"
(let* ((stats (frequency (let* ((stats (mu:tabulate-messages
(lambda (msg) ;; note the 1+ (lambda (msg) ;; note the 1+
(1+ (tm:mon (localtime (mu:msg:date msg))))) EXPR))) (1+ (tm:mon (localtime (date msg))))) EXPR)))
(sort stats (sort stats
(lambda(a b) (lambda(a b)
(< (car a) (car b)))))) ;; in order ofmonth (< (car a) (car b)))))) ;; in order ofmonth
@ -131,8 +131,8 @@ that match it. The result is a list of pairs (month . frequency).\n"
"Count the total number of messages for each weekday (0-6 for "Count the total number of messages for each weekday (0-6 for
Sun..Sat). If the optional EXPR is provided, only count the messages Sun..Sat). If the optional EXPR is provided, only count the messages
that match it. The result is a list of pairs (weekday . frequency).\n" that match it. The result is a list of pairs (weekday . frequency).\n"
(let* ((stats (frequency (let* ((stats (mu:tabulate-messages
(lambda (msg) (tm:hour (localtime (mu:msg:date msg)))) EXPR))) (lambda (msg) (tm:hour (localtime (date msg)))) EXPR)))
(sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of hour (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of hour
(define* (mu:plot:per-hour #:optional (EXPR "")) (define* (mu:plot:per-hour #:optional (EXPR ""))
@ -152,8 +152,8 @@ that match it. The result is a list of pairs (weekday . frequency).\n"
"Count the total number of messages for each year since 1970. If the "Count the total number of messages for each year since 1970. If the
optional EXPR is provided, only count the messages that match it. The optional EXPR is provided, only count the messages that match it. The
result is a list of pairs (year . frequency).\n" result is a list of pairs (year . frequency).\n"
(let* ((stats (frequency (let* ((stats (mu:tabulate-messages
(lambda (msg) (+ 1900 (tm:year (localtime (mu:msg:date msg))))) (lambda (msg) (+ 1900 (tm:year (localtime (date msg)))))
EXPR))) EXPR)))
(sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of year (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of year
@ -245,9 +245,7 @@ then be used in, e.g., R and gnuplot."
(begin (begin
(display msg) (display msg)
(exit (if help 0 1)))) (exit (if help 0 1))))
(if muhome (mu:initialize muhome)
(initialize-mu muhome)
(initialize-mu))
(cond (cond
((string= period "hour") (mu:plot:per-hour expr)) ((string= period "hour") (mu:plot:per-hour expr))
((string= period "day") (mu:plot:per-weekday expr)) ((string= period "day") (mu:plot:per-weekday expr))

580
guile/mu-guile-msg.c
View File

@ -1,580 +0,0 @@
/*
** 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.
**
** 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.
**
*/
#include <mu-msg.h>
#include <mu-query.h>
#include <mu-runtime.h>
#include "mu-guile-msg.h"
#include "mu-guile-util.h"
struct _MuMsgWrapper {
MuMsg *_msg;
gboolean _unrefme;
};
typedef struct _MuMsgWrapper MuMsgWrapper;
static long MSG_TAG;
static int
mu_guile_scm_is_msg (SCM scm)
{
return SCM_NIMP(scm) && (long)SCM_CAR(scm) == MSG_TAG;
}
SCM
mu_guile_msg_to_scm (MuMsg *msg)
{
MuMsgWrapper *msgwrap;
g_return_val_if_fail (msg, SCM_UNDEFINED);
msgwrap = scm_gc_malloc (sizeof (MuMsgWrapper), "msg");
msgwrap->_msg = msg;
msgwrap->_unrefme = FALSE;
SCM_RETURN_NEWSMOB (MSG_TAG, msgwrap);
}
SCM_DEFINE_PUBLIC (msg_make_from_file, "mu:msg:make-from-file", 1, 0, 0,
(SCM PATH),
"Create a message object based on the message in PATH.\n")
#define FUNC_NAME s_msg_make_from_file
{
MuMsg *msg;
GError *err;
SCM_ASSERT (scm_is_string (PATH), PATH, SCM_ARG1, FUNC_NAME);
err = NULL;
msg = mu_msg_new_from_file (scm_to_utf8_string (PATH), NULL, &err);
if (err) {
mu_guile_util_g_error (FUNC_NAME, err);
g_error_free (err);
}
return msg ? mu_guile_msg_to_scm (msg) : SCM_UNDEFINED;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_move, "mu:msg:move-to-maildir", 2, 0, 0,
(SCM MSG, SCM TARGETMDIR),
"Move message to another maildir TARGETMDIR. Note that this the "
"base-level Maildir, ie. /home/user/Maildir/archive, and must"
" _not_ include the 'cur' or 'new' part. mu_msg_move_to_maildir "
"will make sure that the copy is from new/ to new/ and cur/ to "
"cur/. Also note that the target maildir must be on the same "
"filesystem. Returns #t if it worked, #f otherwise.\n")
#define FUNC_NAME s_msg_move
{
GError *err;
MuMsgWrapper *msgwrap;
gboolean rv;
MuFlags flags;
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_string (TARGETMDIR), TARGETMDIR, SCM_ARG2, FUNC_NAME);
msgwrap = (MuMsgWrapper*) SCM_CDR(MSG);
err = NULL;
flags = mu_msg_get_flags (msgwrap->_msg);
rv = mu_msg_move_to_maildir (msgwrap->_msg,
scm_to_utf8_string (TARGETMDIR), flags,
FALSE, &err);
if (!rv && err) {
mu_guile_util_g_error (FUNC_NAME, err);
g_error_free (err);
}
return rv ? SCM_BOOL_T : SCM_BOOL_F;
}
#undef FUNC_NAME
static SCM
scm_from_string_or_null (const char *str)
{
return str ? scm_from_utf8_string (str) : SCM_BOOL_F;
}
static SCM
msg_str_field (SCM msg_smob, MuMsgFieldId mfid)
{
MuMsgWrapper *msgwrap;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
return scm_from_string_or_null (
mu_msg_get_field_string(msgwrap->_msg, mfid));
}
static gint64
msg_num_field (SCM msg_smob, MuMsgFieldId mfid)
{
MuMsgWrapper *msgwrap;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
return mu_msg_get_field_numeric(msgwrap->_msg, mfid);
}
SCM_DEFINE_PUBLIC (msg_date, "mu:msg:date", 1, 0, 0,
(SCM MSG),
"Get the date (time in seconds since epoch) for MSG.\n")
#define FUNC_NAME s_msg_date
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return scm_from_unsigned_integer
(msg_num_field (MSG, MU_MSG_FIELD_ID_DATE));
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_size, "mu:msg:size", 1, 0, 0,
(SCM MSG),
"Get the size in bytes for MSG.\n")
#define FUNC_NAME s_msg_size
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return scm_from_unsigned_integer
(msg_num_field (MSG, MU_MSG_FIELD_ID_SIZE));
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_prio, "mu:msg:priority", 1, 0, 0,
(SCM MSG),
"Get the priority of MSG (low, normal or high).\n")
#define FUNC_NAME s_msg_prio
{
MuMsgPrio prio;
MuMsgWrapper *msgwrap;
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
msgwrap = (MuMsgWrapper*) SCM_CDR(MSG);
prio = mu_msg_get_prio (msgwrap->_msg);
switch (prio) {
case MU_MSG_PRIO_LOW: return scm_from_locale_symbol("mu:low");
case MU_MSG_PRIO_NORMAL: return scm_from_locale_symbol("mu:normal");
case MU_MSG_PRIO_HIGH: return scm_from_locale_symbol("mu:high");
default:
g_return_val_if_reached (SCM_UNDEFINED);
}
}
#undef FUNC_NAME
struct _FlagData {
MuFlags flags;
SCM lst;
};
typedef struct _FlagData FlagData;
static void
check_flag (MuFlags flag, FlagData *fdata)
{
if (fdata->flags & flag) {
SCM item;
char *flagsym;
flagsym = g_strconcat ("mu:", mu_flag_name(flag), NULL);
item = scm_list_1 (scm_from_locale_symbol(flagsym));
g_free (flagsym);
fdata->lst = scm_append_x (scm_list_2(fdata->lst, item));
}
}
SCM_DEFINE_PUBLIC (msg_flags, "mu:msg:flags", 1, 0, 0,
(SCM MSG),
"Get the flags for MSG (one or or more of new, passed, replied, "
"seen, trashed, draft, flagged, unread, signed, encrypted, "
"has-attach).\n")
#define FUNC_NAME s_msg_flags
{
MuMsgWrapper *msgwrap;
FlagData fdata;
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
msgwrap = (MuMsgWrapper*) SCM_CDR(MSG);
fdata.flags = mu_msg_get_flags (msgwrap->_msg);
fdata.lst = SCM_EOL;
mu_flags_foreach ((MuFlagsForeachFunc)check_flag,
&fdata);
return fdata.lst;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_subject, "mu:msg:subject", 1, 0, 0,
(SCM MSG), "Get the subject of MSG.\n")
#define FUNC_NAME s_msg_subject
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return msg_str_field (MSG, MU_MSG_FIELD_ID_SUBJECT);
}
#undef FUNC_NAME
struct _EachContactData {
SCM lst;
MuMsgContactType ctype;
};
typedef struct _EachContactData EachContactData;
static void
contacts_to_list (MuMsgContact *contact, EachContactData *ecdata)
{
if (mu_msg_contact_type (contact) == ecdata->ctype) {
SCM item;
const char *addr, *name;
addr = mu_msg_contact_address (contact);
name = mu_msg_contact_name (contact);
item = scm_list_1
(scm_cons (
scm_from_string_or_null(name),
scm_from_string_or_null(addr)));
ecdata->lst = scm_append_x (scm_list_2(ecdata->lst, item));
}
}
static SCM
contact_list_field (SCM msg_smob, MuMsgFieldId mfid)
{
MuMsgWrapper *msgwrap;
EachContactData ecdata;
ecdata.lst = SCM_EOL;
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);
}
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
mu_msg_contact_foreach (msgwrap->_msg,
(MuMsgContactForeachFunc)contacts_to_list,
&ecdata);
return ecdata.lst;
}
SCM_DEFINE_PUBLIC (msg_from, "mu:msg:from", 1, 0, 0,
(SCM MSG), "Get the list of senders of MSG.\n")
#define FUNC_NAME s_msg_from
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return contact_list_field (MSG, MU_MSG_FIELD_ID_FROM);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_to, "mu:msg:to", 1, 0, 0,
(SCM MSG), "Get the list of To:-recipients of MSG.\n")
#define FUNC_NAME s_msg_to
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return contact_list_field (MSG, MU_MSG_FIELD_ID_TO);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_cc, "mu:msg:cc", 1, 0, 0,
(SCM MSG), "Get the list of Cc:-recipients of MSG.\n")
#define FUNC_NAME s_msg_cc
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return contact_list_field (MSG, MU_MSG_FIELD_ID_CC);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_bcc, "mu:msg:bcc", 1, 0, 0,
(SCM MSG), "Get the list of Bcc:-recipients of MSG.\n")
#define FUNC_NAME s_msg_bcc
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return contact_list_field (MSG, MU_MSG_FIELD_ID_BCC);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_path, "mu:msg:path", 1, 0, 0,
(SCM MSG), "Get the filesystem path for MSG.\n")
#define FUNC_NAME s_msg_path
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return msg_str_field (MSG, MU_MSG_FIELD_ID_PATH);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_maildir, "mu:msg:maildir", 1, 0, 0,
(SCM MSG), "Get the maildir where MSG lives.\n")
#define FUNC_NAME s_msg_maildir
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return msg_str_field (MSG, MU_MSG_FIELD_ID_MAILDIR);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_msgid, "mu:msg:message-id", 1, 0, 0,
(SCM MSG), "Get the MSG's message-id.\n")
#define FUNC_NAME s_msg_msgid
{
return msg_str_field (MSG, MU_MSG_FIELD_ID_MSGID);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_body, "mu:msg:body", 1, 1, 0,
(SCM MSG, SCM HTML), "Get the MSG's body. If HTML is #t, "
"prefer the html-version, otherwise prefer plain text.\n")
#define FUNC_NAME s_msg_body
{
MuMsgWrapper *msgwrap;
gboolean html;
const char *val;
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
msgwrap = (MuMsgWrapper*) SCM_CDR(MSG);
html = SCM_UNBNDP(HTML) ? FALSE : HTML == SCM_BOOL_T;
if (html)
val = mu_msg_get_body_html(msgwrap->_msg);
else
val = mu_msg_get_body_text(msgwrap->_msg);
return scm_from_string_or_null (val);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_header, "mu:msg:header", 2, 0, 0,
(SCM MSG, SCM HEADER), "Get an arbitary HEADER from MSG.\n")
#define FUNC_NAME s_msg_header
{
MuMsgWrapper *msgwrap;
const char *header;
const char *val;
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_string (HEADER)||HEADER==SCM_UNDEFINED,
HEADER, SCM_ARG2, FUNC_NAME);
msgwrap = (MuMsgWrapper*) SCM_CDR(MSG);
header = scm_to_utf8_string (HEADER);
val = mu_msg_get_header(msgwrap->_msg, header);
return val ? scm_from_string_or_null(val) : SCM_UNDEFINED;
}
#undef FUNC_NAME
static SCM
msg_string_list_field (SCM msg_smob, MuMsgFieldId mfid)
{
MuMsgWrapper *msgwrap;
SCM scmlst;
const GSList *lst;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
lst = mu_msg_get_field_string_list (msgwrap->_msg, mfid);
for (scmlst = SCM_EOL; lst;
lst = g_slist_next(lst)) {
SCM item;
item = scm_list_1
(scm_from_string_or_null((const char*)lst->data));
scmlst = scm_append_x (scm_list_2(scmlst, item));
}
return scmlst;
}
SCM_DEFINE_PUBLIC (msg_tags, "mu:msg:tags", 1, 0, 0,
(SCM MSG), "Get the list of tags (contents of the "
"X-Label:-header) for MSG.\n")
#define FUNC_NAME s_msg_tags
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return msg_string_list_field (MSG, MU_MSG_FIELD_ID_TAGS);
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_refs, "mu:msg:references", 1, 0, 0,
(SCM MSG), "Get the list of referenced message-ids "
"(contents of the References: and Reply-To: headers).\n")
#define FUNC_NAME s_msg_refs
{
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
return msg_string_list_field (MSG, MU_MSG_FIELD_ID_REFS);
}
#undef FUNC_NAME
static SCM
msg_mark (SCM msg_smob)
{
MuMsgWrapper *msgwrap;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
msgwrap->_unrefme = TRUE;
return SCM_UNSPECIFIED;
}
static size_t
msg_free (SCM msg_smob)
{
MuMsgWrapper *msgwrap;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
if (msgwrap->_unrefme)
mu_msg_unref (msgwrap->_msg);
return sizeof (MuMsgWrapper);
}
static int
msg_print (SCM msg_smob, SCM port, scm_print_state * pstate)
{
MuMsgWrapper *msgwrap;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
scm_puts ("#<msg ", port);
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;
}
static void
define_symbols (void)
{
/* message priority */
scm_c_define ("mu:high", scm_from_int(MU_MSG_PRIO_HIGH));
scm_c_define ("mu:low", scm_from_int(MU_MSG_PRIO_LOW));
scm_c_define ("mu:normal", scm_from_int(MU_MSG_PRIO_NORMAL));
/* message flags */
scm_c_define ("mu:new", scm_from_int(MU_FLAG_NEW));
scm_c_define ("mu:passed", scm_from_int(MU_FLAG_PASSED));
scm_c_define ("mu:replied", scm_from_int(MU_FLAG_REPLIED));
scm_c_define ("mu:seen", scm_from_int(MU_FLAG_SEEN));
scm_c_define ("mu:trashed", scm_from_int(MU_FLAG_TRASHED));
scm_c_define ("mu:draft", scm_from_int(MU_FLAG_DRAFT));
scm_c_define ("mu:flagged", scm_from_int(MU_FLAG_FLAGGED));
scm_c_define ("mu:signed", scm_from_int(MU_FLAG_SIGNED));
scm_c_define ("mu:encrypted", scm_from_int(MU_FLAG_ENCRYPTED));
scm_c_define ("mu:has-attach", scm_from_int(MU_FLAG_HAS_ATTACH));
scm_c_define ("mu:unread", scm_from_int(MU_FLAG_UNREAD));
}
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;
}
void*
mu_guile_msg_init (void *data)
{
MSG_TAG = scm_make_smob_type ("msg", sizeof(MuMsgWrapper));
scm_set_smob_mark (MSG_TAG, msg_mark);
scm_set_smob_free (MSG_TAG, msg_free);
scm_set_smob_print (MSG_TAG, msg_print);
define_symbols ();
#include "mu-guile-msg.x"
return NULL;
}

65
guile/mu-guile-msg.h
View File

@ -1,65 +0,0 @@
/*
** 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.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software Foundation,
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
**
*/
#ifndef __MU_GUILE_MSG_H__
#define __MU_GUILE_MSG_H__
#include <libguile.h>
#include <mu-msg.h>
#ifdef __cplusplus
extern "C" {
#endif /*__cplusplus*/
typedef void* MuGuileFunc (void*);
/**
* register MuMsg-related functions/smobs with guile; use with
* scm_with_guile
*
* @param data
*/
void *mu_guile_msg_init (void *data);
/**
* set 'mu:msg:current in the guile env
*
* @param path path to a message
*
* @return TRUE if it worked, FALSE otherwise
*/
gboolean mu_guile_msg_load_current (const char *path);
/**
* create an SCM for the MuMsg*
*
* @param msg a MuMsg instance
*
* @return an SCM for the msg
*/
SCM mu_guile_msg_to_scm (MuMsg *msg);
#ifdef __cplusplus
}
#endif /*__cplusplus*/
#endif /*__MU_GUILE_MSG_H__*/

48
guile/mu-guile-util.c
View File

@ -1,48 +0,0 @@
/*
** 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.
**
** 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.
**
*/
#include <mu-runtime.h>
#include <glib-object.h>
#include "mu-guile-util.h"
#include "mu-guile-msg.h"
SCM
mu_guile_util_error (const char *func_name, int status,
const char *fmt, SCM args)
{
scm_error_scm (scm_from_locale_symbol ("MuError"),
scm_from_utf8_string (func_name ? func_name : "<nameless>"),
scm_from_utf8_string (fmt), args,
scm_list_1 (scm_from_int (status)));
return SCM_UNSPECIFIED;
}
SCM
mu_guile_util_g_error (const char *func_name, GError *err)
{
scm_error_scm (scm_from_locale_symbol ("MuError"),
scm_from_utf8_string (func_name),
scm_from_utf8_string (err ? err->message : "error"),
SCM_UNDEFINED, SCM_UNDEFINED);
return SCM_UNSPECIFIED;
}

61
guile/mu-guile-util.h
View File

@ -1,61 +0,0 @@
/*
** 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.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software Foundation,
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
**
*/
#ifndef __MU_GUILE_UTIL_H__
#define __MU_GUILE_UTIL_H__
#include <libguile.h>
#include <glib.h>
G_BEGIN_DECLS
/**
* start a guile shell with the mu modules loaded. function does not return
*
* @param argcp pointer to argc
* @param argvp pointer to argv
*
* @return FALSE in case of error, otherwise, the function will not return
*/
gboolean mu_guile_util_run (int *argcp, char **argvp[]);
/**
* output an error
*
* @param func_name
* @param status
* @param fmt
* @param args
*/
SCM mu_guile_util_error (const char *func_name, int status,
const char *fmt, SCM args);
/**
* display a GError as a Guile error
*
* @param func_name function name
* @param err Gerror
*/
SCM mu_guile_util_g_error (const char *func_name, GError *err);
G_END_DECLS
#endif /*__MU_GUILE_UTIL_H__*/

502
guile/mu-guile.c
View File

@ -21,12 +21,457 @@
#include <config.h> #include <config.h>
#endif /*HAVE_CONFIG_H*/ #endif /*HAVE_CONFIG_H*/
#include <glib-object.h>
#include <libguile.h>
#include <mu-runtime.h> #include <mu-runtime.h>
#include <mu-store.h> #include <mu-store.h>
#include <mu-query.h> #include <mu-query.h>
#include <mu-msg.h>
#include <mu-query.h>
#include <mu-runtime.h>
struct _MuMsgWrapper {
MuMsg *_msg;
gboolean _unrefme;
};
typedef struct _MuMsgWrapper MuMsgWrapper;
static long MSG_TAG;
static SCM
mu_guile_util_error (const char *func_name, int status,
const char *fmt, SCM args)
{
scm_error_scm (scm_from_locale_symbol ("MuError"),
scm_from_utf8_string (func_name ? func_name : "<nameless>"),
scm_from_utf8_string (fmt), args,
scm_list_1 (scm_from_int (status)));
return SCM_UNSPECIFIED;
}
static SCM
mu_guile_util_g_error (const char *func_name, GError *err)
{
scm_error_scm (scm_from_locale_symbol ("MuError"),
scm_from_utf8_string (func_name),
scm_from_utf8_string (err ? err->message : "error"),
SCM_UNDEFINED, SCM_UNDEFINED);
return SCM_UNSPECIFIED;
}
static gboolean
mu_guile_scm_is_msg (SCM scm)
{
return SCM_NIMP(scm) && (long)SCM_CAR(scm) == MSG_TAG;
}
SCM
mu_guile_msg_to_scm (MuMsg *msg)
{
MuMsgWrapper *msgwrap;
g_return_val_if_fail (msg, SCM_UNDEFINED);
msgwrap = scm_gc_malloc (sizeof (MuMsgWrapper), "msg");
msgwrap->_msg = msg;
msgwrap->_unrefme = FALSE;
SCM_RETURN_NEWSMOB (MSG_TAG, msgwrap);
}
SCM_DEFINE_PUBLIC (msg_make_from_file, "mu:msg:make-from-file", 1, 0, 0,
(SCM PATH),
"Create a message object based on the message in PATH.\n")
#define FUNC_NAME s_msg_make_from_file
{
MuMsg *msg;
GError *err;
SCM_ASSERT (scm_is_string (PATH), PATH, SCM_ARG1, FUNC_NAME);
err = NULL;
msg = mu_msg_new_from_file (scm_to_utf8_string (PATH), NULL, &err);
if (err) {
mu_guile_util_g_error (FUNC_NAME, err);
g_error_free (err);
}
return msg ? mu_guile_msg_to_scm (msg) : SCM_UNDEFINED;
}
#undef FUNC_NAME
/* SCM_DEFINE_PUBLIC (msg_move, "mu:msg:move-to-maildir", 2, 0, 0, */
/* (SCM MSG, SCM TARGETMDIR), */
/* "Move message to another maildir TARGETMDIR. Note that this the " */
/* "base-level Maildir, ie. /home/user/Maildir/archive, and must" */
/* " _not_ include the 'cur' or 'new' part. mu_msg_move_to_maildir " */
/* "will make sure that the copy is from new/ to new/ and cur/ to " */
/* "cur/. Also note that the target maildir must be on the same " */
/* "filesystem. Returns #t if it worked, #f otherwise.\n") */
/* #define FUNC_NAME s_msg_move */
/* { */
/* GError *err; */
/* MuMsgWrapper *msgwrap; */
/* gboolean rv; */
/* MuFlags flags; */
/* SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME); */
/* SCM_ASSERT (scm_is_string (TARGETMDIR), TARGETMDIR, SCM_ARG2, FUNC_NAME); */
/* msgwrap = (MuMsgWrapper*) SCM_CDR(MSG); */
/* err = NULL; */
/* flags = mu_msg_get_flags (msgwrap->_msg); */
/* rv = mu_msg_move_to_maildir (msgwrap->_msg, */
/* scm_to_utf8_string (TARGETMDIR), flags, */
/* FALSE, &err); */
/* if (!rv && err) { */
/* mu_guile_util_g_error (FUNC_NAME, err); */
/* g_error_free (err); */
/* } */
/* return rv ? SCM_BOOL_T : SCM_BOOL_F; */
/* } */
/* #undef FUNC_NAME */
static SCM
scm_from_string_or_null (const char *str)
{
return str ? scm_from_utf8_string (str) : SCM_BOOL_F;
}
struct _FlagData {
MuFlags flags;
SCM lst;
};
typedef struct _FlagData FlagData;
static void
check_flag (MuFlags flag, FlagData *fdata)
{
if (fdata->flags & flag) {
SCM item;
char *flagsym;
flagsym = g_strconcat ("mu:", mu_flag_name(flag), NULL);
item = scm_list_1 (scm_from_locale_symbol(flagsym));
g_free (flagsym);
fdata->lst = scm_append_x (scm_list_2(fdata->lst, item));
}
}
static SCM
get_flags_scm (MuMsg *msg)
{
FlagData fdata;
fdata.flags = mu_msg_get_flags (msg);
fdata.lst = SCM_EOL;
mu_flags_foreach ((MuFlagsForeachFunc)check_flag, &fdata);
return fdata.lst;
}
static SCM
get_prio_scm (MuMsg *msg)
{
switch (mu_msg_get_prio (msg)) {
case MU_MSG_PRIO_LOW: return scm_from_locale_symbol("mu:low");
case MU_MSG_PRIO_NORMAL: return scm_from_locale_symbol("mu:normal");
case MU_MSG_PRIO_HIGH: return scm_from_locale_symbol("mu:high");
default: g_return_val_if_reached (SCM_UNDEFINED);
}
}
static SCM
msg_string_list_field (MuMsg *msg, MuMsgFieldId mfid)
{
SCM scmlst;
const GSList *lst;
lst = mu_msg_get_field_string_list (msg, mfid);
for (scmlst = SCM_EOL; lst;
lst = g_slist_next(lst)) {
SCM item;
item = scm_list_1
(scm_from_string_or_null((const char*)lst->data));
scmlst = scm_append_x (scm_list_2(scmlst, item));
}
return scmlst;
}
SCM_DEFINE_PUBLIC(msg_field, "mu:msg:field", 2, 0, 0,
(SCM MSG, SCM FIELD),
"Get the field FIELD from message MSG.\n")
#define FUNC_NAME s_msg_field
{
MuMsgWrapper *msgwrap;
MuMsgFieldId mfid;
msgwrap = (MuMsgWrapper*) SCM_CDR(MSG);
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_integer_p(FIELD), FIELD, SCM_ARG2, FUNC_NAME);
mfid = scm_to_int (FIELD);
SCM_ASSERT (mfid < MU_MSG_FIELD_ID_NUM, FIELD, SCM_ARG2, FUNC_NAME);
switch (mfid) {
case MU_MSG_FIELD_ID_PRIO: return get_prio_scm (msgwrap->_msg);
case MU_MSG_FIELD_ID_FLAGS: return get_flags_scm (msgwrap->_msg);
default: break;
}
switch (mu_msg_field_type (mfid)) {
case MU_MSG_FIELD_TYPE_STRING:
return scm_from_string_or_null
(mu_msg_get_field_string(msgwrap->_msg, mfid));
case MU_MSG_FIELD_TYPE_BYTESIZE:
case MU_MSG_FIELD_TYPE_TIME_T:
return scm_from_uint (
mu_msg_get_field_numeric (msgwrap->_msg, mfid));
case MU_MSG_FIELD_TYPE_INT:
return scm_from_int (
mu_msg_get_field_numeric (msgwrap->_msg, mfid));
case MU_MSG_FIELD_TYPE_STRING_LIST:
return msg_string_list_field (msgwrap->_msg, mfid);
default:
SCM_ASSERT (0, FIELD, SCM_ARG2, FUNC_NAME);
}
}
#undef FUNC_NAME
struct _EachContactData {
SCM lst;
MuMsgContactType ctype;
};
typedef struct _EachContactData EachContactData;
static void
contacts_to_list (MuMsgContact *contact, EachContactData *ecdata)
{
if (ecdata->ctype == MU_MSG_CONTACT_TYPE_ALL ||
mu_msg_contact_type (contact) == ecdata->ctype) {
SCM item;
const char *addr, *name;
addr = mu_msg_contact_address (contact);
name = mu_msg_contact_name (contact);
item = scm_list_1
(scm_cons (
scm_from_string_or_null(name),
scm_from_string_or_null(addr)));
ecdata->lst = scm_append_x (scm_list_2(ecdata->lst, item));
}
}
SCM_DEFINE_PUBLIC (msg_contacts, "mu:msg:contacts", 2, 0, 0,
(SCM MSG, SCM CONTACT_TYPE), "Get a list of contact information pairs.\n")
#define FUNC_NAME s_msg_contacts
{
MuMsgWrapper *msgwrap;
EachContactData ecdata;
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_integer_p (CONTACT_TYPE) || scm_is_bool(CONTACT_TYPE),
CONTACT_TYPE, SCM_ARG2, FUNC_NAME);
if (CONTACT_TYPE == SCM_BOOL_F)
return SCM_UNSPECIFIED; /* nothing to do */
else if (CONTACT_TYPE == SCM_BOOL_T)
ecdata.ctype = MU_MSG_CONTACT_TYPE_ALL;
else {
MuMsgFieldId mfid;
mfid = scm_to_uint (CONTACT_TYPE);
switch (mfid) {
case MU_MSG_FIELD_ID_TO: ecdata.ctype = MU_MSG_CONTACT_TYPE_TO; break;
case MU_MSG_FIELD_ID_FROM: ecdata.ctype = MU_MSG_CONTACT_TYPE_FROM; break;
case MU_MSG_FIELD_ID_CC: ecdata.ctype = MU_MSG_CONTACT_TYPE_CC; break;
case MU_MSG_FIELD_ID_BCC: ecdata.ctype = MU_MSG_CONTACT_TYPE_BCC; break;
default: g_return_val_if_reached (SCM_UNDEFINED);
}
}
ecdata.lst = SCM_EOL;
msgwrap = (MuMsgWrapper*) SCM_CDR(MSG);
mu_msg_contact_foreach (msgwrap->_msg,
(MuMsgContactForeachFunc)contacts_to_list,
&ecdata);
return ecdata.lst;
}
#undef FUNC_NAME
SCM_DEFINE_PUBLIC (msg_header, "mu:msg:header", 2, 0, 0,
(SCM MSG, SCM HEADER), "Get an arbitary HEADER from MSG.\n")
#define FUNC_NAME s_msg_header
{
MuMsgWrapper *msgwrap;
const char *header;
const char *val;
SCM_ASSERT (mu_guile_scm_is_msg(MSG), MSG, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (scm_is_string (HEADER)||HEADER==SCM_UNDEFINED,
HEADER, SCM_ARG2, FUNC_NAME);
msgwrap = (MuMsgWrapper*) SCM_CDR(MSG);
header = scm_to_utf8_string (HEADER);
val = mu_msg_get_header(msgwrap->_msg, header);
return val ? scm_from_string_or_null(val) : SCM_BOOL_F;
}
#undef FUNC_NAME
static SCM
msg_mark (SCM msg_smob)
{
MuMsgWrapper *msgwrap;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
msgwrap->_unrefme = TRUE;
return SCM_UNSPECIFIED;
}
static size_t
msg_free (SCM msg_smob)
{
MuMsgWrapper *msgwrap;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
if (msgwrap->_unrefme)
mu_msg_unref (msgwrap->_msg);
return sizeof (MuMsgWrapper);
}
static int
msg_print (SCM msg_smob, SCM port, scm_print_state * pstate)
{
MuMsgWrapper *msgwrap;
msgwrap = (MuMsgWrapper*) SCM_CDR(msg_smob);
scm_puts ("#<msg ", port);
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;
}
static struct {
const char* name;
unsigned val;
} SYMPAIRS[] = {
{ "mu:high", MU_MSG_PRIO_HIGH },
{ "mu:low", MU_MSG_PRIO_LOW },
{ "mu:normal", MU_MSG_PRIO_NORMAL },
{ "mu:new", MU_FLAG_NEW },
{ "mu:passed", MU_FLAG_PASSED },
{ "mu:replied", MU_FLAG_REPLIED },
{ "mu:seen", MU_FLAG_SEEN },
{ "mu:trashed", MU_FLAG_TRASHED },
{ "mu:draft", MU_FLAG_DRAFT },
{ "mu:flagged", MU_FLAG_FLAGGED },
{ "mu:signed", MU_FLAG_SIGNED },
{ "mu:encrypted", MU_FLAG_ENCRYPTED },
{ "mu:has-attach", MU_FLAG_HAS_ATTACH },
{ "mu:unread", MU_FLAG_UNREAD },
/* { "mu:embedded-text", MU_MSG_FIELD_ID_EMBEDDED_TEXT }, */
/* { "mu:file", MU_MSG_FIELD_ID_FILE }, */
/* { "mu:mime", MU_MSG_FIELD_ID_MIME }, */
{ "mu:bcc", MU_MSG_FIELD_ID_BCC },
{ "mu:body-html", MU_MSG_FIELD_ID_BODY_HTML },
{ "mu:body-txt", MU_MSG_FIELD_ID_BODY_TEXT },
{ "mu:cc", MU_MSG_FIELD_ID_CC },
{ "mu:date", MU_MSG_FIELD_ID_DATE },
{ "mu:flags", MU_MSG_FIELD_ID_FLAGS },
{ "mu:from", MU_MSG_FIELD_ID_FROM },
{ "mu:maildir", MU_MSG_FIELD_ID_MAILDIR },
{ "mu:message-id", MU_MSG_FIELD_ID_MSGID },
{ "mu:path", MU_MSG_FIELD_ID_PATH },
{ "mu:prio", MU_MSG_FIELD_ID_PRIO },
{ "mu:refs", MU_MSG_FIELD_ID_REFS },
{ "mu:size", MU_MSG_FIELD_ID_SIZE },
{ "mu:subject", MU_MSG_FIELD_ID_SUBJECT },
{ "mu:tags", MU_MSG_FIELD_ID_TAGS },
{ "mu:to", MU_MSG_FIELD_ID_TO },
};
static void
define_symbols (void)
{
unsigned u;
for (u = 0; u != G_N_ELEMENTS(SYMPAIRS); ++u) {
scm_c_define (SYMPAIRS[u].name,
scm_from_uint (SYMPAIRS[u].val));
scm_c_export (SYMPAIRS[u].name, NULL);
}
}
/* gboolean */
/* mu_guile_msg_load_current (const char *path) */
/* { */
/* MuMsg *msg; */
/* GError *err; */
/* SCM msgsmob; */
/* err = NULL; */
/* msg = mu_msg_new_from_file (path, NULL, &err); */
/* if (!msg) { */
/* g_printerr ("error creating message for '%s'", path); */
/* if (err) { */
/* g_printerr (": %s", err->message); */
/* g_error_free (err); */
/* } */
/* g_printerr ("\n"); */
/* return FALSE; */
/* } */
/* msgsmob = mu_guile_msg_to_scm (msg); */
/* scm_c_define ("mu:current-msg", msgsmob); */
/* return TRUE; */
/* } */
#include "mu-guile-util.h"
#include "mu-guile-msg.h"
struct _MuData { struct _MuData {
MuQuery *_query; MuQuery *_query;
@ -83,7 +528,7 @@ uninit_mu (void)
} }
SCM_DEFINE_PUBLIC (mu_initialize, "initialize-mu", 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 " "functions. Optionally, you can provide MUHOME which "
@ -93,14 +538,17 @@ SCM_DEFINE_PUBLIC (mu_initialize, "initialize-mu", 0, 1, 0,
{ {
const char *muhome; const char *muhome;
SCM_ASSERT (scm_is_string (MUHOME) || SCM_UNBNDP(MUHOME), SCM_ASSERT (scm_is_string (MUHOME) || MUHOME == SCM_BOOL_F || SCM_UNBNDP(MUHOME),
MUHOME, SCM_ARG1, FUNC_NAME); MUHOME, SCM_ARG1, FUNC_NAME);
if (MU_DATA) if (MU_DATA)
return mu_guile_util_error (FUNC_NAME, 0, "Already initialized", return mu_guile_util_error (FUNC_NAME, 0, "Already initialized",
SCM_BOOL_F); SCM_BOOL_F);
muhome = SCM_UNBNDP(MUHOME) ? NULL : scm_to_utf8_string (MUHOME); if (SCM_UNBNDP(MUHOME) || MUHOME == SCM_BOOL_F)
muhome = NULL;
else
muhome = scm_to_utf8_string (MUHOME);
if (!init_mu (muhome)) if (!init_mu (muhome))
return mu_guile_util_error (FUNC_NAME, 0, "Failed to initialize mu", return mu_guile_util_error (FUNC_NAME, 0, "Failed to initialize mu",
@ -113,7 +561,7 @@ SCM_DEFINE_PUBLIC (mu_initialize, "initialize-mu", 0, 1, 0,
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE_PUBLIC (mu_initialized_p, "initialized-mu?", 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
{ {
@ -150,41 +598,45 @@ call_func (SCM FUNC, MuMsgIter *iter, const char* func_name)
msgsmob = mu_guile_msg_to_scm (mu_msg_ref(msg)); msgsmob = mu_guile_msg_to_scm (mu_msg_ref(msg));
scm_call_1 (FUNC, msgsmob); scm_call_1 (FUNC, msgsmob);
} }
SCM_DEFINE_PUBLIC (for_each_message, "for-each-message", 1, 1, 0, SCM_DEFINE_PUBLIC (for_each_message, "mu:internal:for-each-message", 2, 0, 0,
(SCM FUNC, SCM EXPR), (SCM FUNC, SCM EXPR),
"Call FUNC for each message in the message store. If search expression EXPR " "Call FUNC for each message in the message store. EXPR is either a "
"is specified, limit this to messages matching EXPR\n") "string containing a mu search expression or a boolean; in the former "
"case, limit the messages to only those matching the expression, in the "
"latter case, match /all/ messages if the EXPR equals #t, and match "
"none if EXPR equals #f.")
#define FUNC_NAME s_for_each_message #define FUNC_NAME s_for_each_message
{ {
MuMsgIter *iter; MuMsgIter *iter;
int count;
const char* expr; const char* expr;
SCM_ASSERT (scm_procedure_p (FUNC), FUNC, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_procedure_p (FUNC), FUNC, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_UNBNDP(EXPR) || scm_is_string (EXPR), SCM_ASSERT (scm_is_bool(EXPR) || scm_is_string (EXPR),
EXPR, SCM_ARG2, FUNC_NAME); EXPR, SCM_ARG2, FUNC_NAME);
if (!MU_DATA) if (!MU_DATA)
return mu_guile_util_error (FUNC_NAME, 0, "mu not initialized", return mu_guile_util_error (FUNC_NAME, 0, "mu not initialized",
SCM_UNDEFINED); SCM_UNDEFINED);
if (EXPR == SCM_BOOL_F)
/* note, "" matches *all* messages */ return SCM_UNSPECIFIED; /* nothing to do */
expr = SCM_UNBNDP(EXPR) ? "" : scm_to_utf8_string(EXPR); else if (EXPR == SCM_BOOL_T)
expr = ""; /* note, "" matches *all* messages */
else
expr = scm_to_utf8_string(EXPR);
iter = get_query_iter (MU_DATA->_query, expr); iter = get_query_iter (MU_DATA->_query, expr);
if (!iter) if (!iter)
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
for (count = 0; !mu_msg_iter_is_done(iter); mu_msg_iter_next (iter)) { while (!mu_msg_iter_is_done(iter)) {
call_func (FUNC, iter, FUNC_NAME); call_func (FUNC, iter, FUNC_NAME);
++count; mu_msg_iter_next (iter);
} }
return scm_from_int (count); return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -226,7 +678,7 @@ write_log (LogType logtype, SCM FRM, SCM ARGS)
} }
SCM_DEFINE_PUBLIC (log_info, "mu:log:info", 1, 0, 1, (SCM FRM, SCM ARGS), SCM_DEFINE_PUBLIC (log_info, "mu:log", 1, 0, 1, (SCM FRM, SCM ARGS),
"log some message using a list of ARGS applied to FRM " "log some message using a list of ARGS applied to FRM "
"(in 'simple-format' notation).\n") "(in 'simple-format' notation).\n")
#define FUNC_NAME s_info #define FUNC_NAME s_info
@ -235,7 +687,7 @@ SCM_DEFINE_PUBLIC (log_info, "mu:log:info", 1, 0, 1, (SCM FRM, SCM ARGS),
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE_PUBLIC (log_warning, "mu:log:warning", 1, 0, 1, (SCM FRM, SCM ARGS), SCM_DEFINE_PUBLIC (log_warning, "mu:warning", 1, 0, 1, (SCM FRM, SCM ARGS),
"log some warning using a list of ARGS applied to FRM (in 'simple-format' " "log some warning using a list of ARGS applied to FRM (in 'simple-format' "
"notation).\n") "notation).\n")
#define FUNC_NAME s_warning #define FUNC_NAME s_warning
@ -244,7 +696,7 @@ SCM_DEFINE_PUBLIC (log_warning, "mu:log:warning", 1, 0, 1, (SCM FRM, SCM ARGS),
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE_PUBLIC (log_critical, "mu:log:critical", 1, 0, 1, (SCM FRM, SCM ARGS), SCM_DEFINE_PUBLIC (log_critical, "mu:critical", 1, 0, 1, (SCM FRM, SCM ARGS),
"log some critical message using a list of ARGS applied to FRM " "log some critical message using a list of ARGS applied to FRM "
"(in 'simple-format' notation).\n") "(in 'simple-format' notation).\n")
#define FUNC_NAME s_critical #define FUNC_NAME s_critical
@ -258,6 +710,14 @@ SCM_DEFINE_PUBLIC (log_critical, "mu:log:critical", 1, 0, 1, (SCM FRM, SCM ARGS
void* void*
mu_guile_init (void *data) mu_guile_init (void *data)
{ {
MSG_TAG = scm_make_smob_type ("msg", sizeof(MuMsgWrapper));
scm_set_smob_mark (MSG_TAG, msg_mark);
scm_set_smob_free (MSG_TAG, msg_free);
scm_set_smob_print (MSG_TAG, msg_print);
define_symbols ();
#include "mu-guile.x" #include "mu-guile.x"
return NULL; return NULL;

73
guile/mu.scm
View File

@ -18,36 +18,38 @@
(define-module (mu) (define-module (mu)
:use-module (oop goops) :use-module (oop goops)
:use-module (mu msg) :use-module (mu message)
:use-module (mu contact) :use-module (mu contact)
:export :export
(for-each-contact (mu:for-each-contact
for-each-message)) ;; note, defined in libguile-mu (in c) mu:for-each-message
mu:message-list
mu:tabulate-messages
mu:average-messages))
(load-extension "libguile-mu" "mu_guile_init") (load-extension "libguile-mu" "mu_guile_init")
(define* (for-each-contact proc #:optional (expr "")) (define* (mu:for-each-contact proc #:optional (expr #t))
"Execute PROC for each contact. PROC receives a <contact> instance "Execute PROC for each contact. PROC receives a <mu-contact> instance
as parameter. If EXPR is specified, only consider contacts in messages as parameter. If EXPR is specified, only consider contacts in messages
matching EXPR." matching EXPR."
(let ((c-hash (make-hash-table 4096))) (let ((c-hash (make-hash-table 4096)))
(for-each-message (mu:for-each-message
(lambda (msg) (lambda (msg)
(for-each (for-each
(lambda (name-addr) (lambda (name-addr)
(let ((contact (make <contact> (let ((contact (make <mu-contact>
#:name (car name-addr) #:name (car name-addr)
#:email (cdr name-addr) #:email (cdr name-addr)
#:timestamp (mu:msg:date msg)))) #:timestamp (date msg))))
(update-contacts-hash c-hash contact))) (update-contacts-hash c-hash contact)))
(append (mu:msg:to msg) (mu:msg:from msg) (mu:msg:cc msg) (contacts msg #t)))
(mu:msg:bcc msg))))
expr) expr)
;; c-hash now contains a map of email->contact ;; c-hash now contains a map of email->contact
(hash-for-each (hash-for-each
(lambda (email contact) (proc contact)) c-hash))) (lambda (email contact) (proc contact)) c-hash)))
(define-method (update-contacts-hash c-hash (nc <contact>)) (define-method (update-contacts-hash c-hash (nc <mu-contact>))
"Update the contacts hash with a new and/or existing contact." "Update the contacts hash with a new and/or existing contact."
;; xc: existing-contact, nc: new contact ;; xc: existing-contact, nc: new contact
(let ((xc (hash-ref c-hash (email nc)))) (let ((xc (hash-ref c-hash (email nc))))
@ -68,3 +70,52 @@ matching EXPR."
(set! (last-seen xc) (timestamp nc))) (set! (last-seen xc) (timestamp nc)))
;; okay --> now xc has been updated; but it back in the hash ;; okay --> now xc has been updated; but it back in the hash
(hash-set! c-hash (email xc) xc))))) (hash-set! c-hash (email xc) xc)))))
(define* (mu:for-each-message func #:optional (expr #t))
"Execute function FUNC for each message that matches mu search expression EXPR.
If EXPR is not provided, match /all/ messages in the store."
(let ((my-func
(lambda (msg)
(func (make <mu-message> #:msg msg)))))
(mu:internal:for-each-message my-func expr)))
(define* (mu:message-list #:optional (expr #t))
"Return a list of all messages matching mu search expression
EXPR. If EXPR is not provided, return a list of /all/ messages in the store."
(let ((lst '()))
(mu:for-each-message
(lambda (m)
(set! lst (append! lst (list m)))) expr)
lst))
(define* (mu:tabulate-messages func #:optional (expr #t))
"Execute FUNC for each message matching EXPR, and return an alist
with maps each result of FUNC to its frequency. FUNC is a function
takes a <mu-message> instance as its argument. For example, to tabulate messages by weekday,
one could use:
(mu:tabulate-messages (lambda(msg) (tm:wday (localtime (date msg)))))
."
(let ((table '()))
(mu:for-each-message
(lambda(msg)
(let* ((val (func msg))
(old-freq (or (assoc-ref table val) 0)))
(set! table (assoc-set! table val (1+ old-freq)))))
expr)
table))
(define* (mu:average-messages func #:optional (expr #t))
"Execute FUNC for each message matching EXPR, and return the average value of the results of FUNC.
FUNC is a function that takes a <mu-message> instance as its
argument, and returns some number. For example, to get the average message size of messages related to icecream:
(mu:average (lambda(msg) (size msg)) \"icecream\" ."
(let ((count 0) (sum 0))
(mu:for-each-message
(lambda (msg)
(set! count (+1 count))
(set! sum (+ sum (func msg))))
expr)
(if (= count 0)
0
(exact->inexact (/ sum count)))))

1
guile/mu/Makefile.am
View File

@ -21,6 +21,7 @@ include $(top_srcdir)/gtest.mk
scmdir=${prefix}/share/guile/site/2.0/mu/ scmdir=${prefix}/share/guile/site/2.0/mu/
scm_DATA= \ scm_DATA= \
msg.scm \ msg.scm \
message.scm \
contact.scm contact.scm
EXTRA_DIST=$(scm_DATA) EXTRA_DIST=$(scm_DATA)

4
guile/mu/contact.scm
View File

@ -22,12 +22,12 @@
(define-module (mu contact) (define-module (mu contact)
:use-module (oop goops) :use-module (oop goops)
:export ( ;; classes :export ( ;; classes
<contact> <mu-contact>
;; contact methods ;; contact methods
name email timestamp frequency last-seen name email timestamp frequency last-seen
)) ))
(define-class <contact> () (define-class <mu-contact> ()
(name #:init-value #f #:accessor name #:init-keyword #:name) (name #:init-value #f #:accessor name #:init-keyword #:name)
(email #:init-value #f #:accessor email #:init-keyword #:email) (email #:init-value #f #:accessor email #:init-keyword #:email)
(tstamp #:init-value 0 #:accessor timestamp #:init-keyword #:timestamp) (tstamp #:init-value 0 #:accessor timestamp #:init-keyword #:timestamp)

2
guile/mu/msg.scm
View File

@ -17,4 +17,4 @@
;; 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 msg)) (define-module (mu msg))
(load-extension "libguile-mu" "mu_guile_msg_init") (load-extension "libguile-mu" "mu_guile_init")