From 46e002a4fa571d0954e0e2782bda51f2a52e4a72 Mon Sep 17 00:00:00 2001 From: djcb Date: Sun, 1 Jan 2012 18:17:29 +0200 Subject: [PATCH] * guile cleanup/overhaul (WIP) --- guile/Makefile.am | 7 +- guile/examples/contacts-export | 18 +- guile/examples/msg-stats | 56 ++-- guile/mu-guile-msg.c | 580 --------------------------------- guile/mu-guile-msg.h | 65 ---- guile/mu-guile-util.c | 48 --- guile/mu-guile-util.h | 61 ---- guile/mu-guile.c | 502 ++++++++++++++++++++++++++-- guile/mu.scm | 73 ++++- guile/mu/Makefile.am | 1 + guile/mu/contact.scm | 4 +- guile/mu/msg.scm | 2 +- 12 files changed, 586 insertions(+), 831 deletions(-) delete mode 100644 guile/mu-guile-msg.c delete mode 100644 guile/mu-guile-msg.h delete mode 100644 guile/mu-guile-util.c delete mode 100644 guile/mu-guile-util.h diff --git a/guile/Makefile.am b/guile/Makefile.am index 8145862f..d38d7c0e 100644 --- a/guile/Makefile.am +++ b/guile/Makefile.am @@ -36,18 +36,13 @@ lib_LTLIBRARIES= \ libguile_mu_la_SOURCES= \ mu-guile.c \ - mu-guile.h \ - mu-guile-msg.c \ - mu-guile-msg.h \ - mu-guile-util.c \ - mu-guile-util.h + mu-guile.h libguile_mu_la_LIBADD= \ ${top_builddir}/src/libmu.la \ ${GUILE_LIBS} XFILES= \ - mu-guile-msg.x \ mu-guile.x # FIXME: GUILE_SITEDIR would be better, but that diff --git a/guile/examples/contacts-export b/guile/examples/contacts-export index 0c6bf996..bac04302 100755 --- a/guile/examples/contacts-export +++ b/guile/examples/contacts-export @@ -35,7 +35,13 @@ exec guile -e main -s $0 $@ (cond ((string= form "org-contacts") (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) (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")) (revert (option-ref options 'revert #f)) (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 (begin (display msg) (exit 0)) (begin - (if muhome - (initialize-mu muhome) - (initialize-mu)) + (mu:initialize muhome) (let* ((sort-func (cond ((string= sort-by "frequency") sort-by-freq) @@ -70,7 +74,7 @@ exec guile -e main -s $0 $@ (else (begin (display msg) (exit 1))))) (contacts '())) ;; make a list of all contacts - (for-each-contact + (mu:for-each-contact (lambda (c) (set! contacts (cons c contacts)))) ;; should we sort it? (if sort-by @@ -78,7 +82,7 @@ exec guile -e main -s $0 $@ (if revert (negate sort-func) sort-func)))) ;; should we limit the number? - (if limit + (if (and limit (< limit (length contacts))) (set! contacts (take! contacts limit))) ;; export! (for-each diff --git a/guile/examples/msg-stats b/guile/examples/msg-stats index f3a5a159..86884f9d 100755 --- a/guile/examples/msg-stats +++ b/guile/examples/msg-stats @@ -21,7 +21,7 @@ exec guile -e main -s $0 $@ ;; 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 (mu) (mu msg)) +(use-modules (mu) (mu message)) ;; note, this is a rather inefficient way to calculate the number; for ;; demonstration purposes only... @@ -53,31 +53,31 @@ exec guile -e main -s $0 $@ ;; (length (mu:msg:cc msg)) ;; (length (mu:msg:bcc msg)))) EXPR)) -(define* (frequency FUNC #:optional (EXPR "")) - "FUNC is a function that takes a mMsg, and returns the frequency of -the different values this function returns. If FUNC returns a list, -update the frequency table for each element of this list. If the -optional EXPR is provided, only consider messages that match it.\n" - (let ((table '())) - (for-each-message - (lambda(msg) - ;; note, if val is not already a list, turn it into a list - ;; then, take frequency for each element in the list - (let* ((val (FUNC msg)) (vals (if (list? val) val (list val)))) - (for-each - (lambda (val) - (let ((freq (assoc-ref table val))) - (set! table (assoc-set! table val - (+ 1 (if (eq? freq #f) 0 freq)))))) vals))) EXPR) - table)) +;; (define* (frequency FUNC #:optional (EXPR "")) +;; "FUNC is a function that takes a msg, and returns the frequency of +;; the different values this function returns. If FUNC returns a list, +;; update the frequency table for each element of this list. If the +;; optional EXPR is provided, only consider messages that match it.\n" +;; (let ((table '())) +;; (mu:for-each-message +;; (lambda(msg) +;; ;; note, if val is not already a list, turn it into a list +;; ;; then, take frequency for each element in the list +;; (let* ((val (FUNC msg)) (vals (if (list? val) val (list val)))) +;; (for-each +;; (lambda (val) +;; (let ((freq (assoc-ref table val))) +;; (set! table (assoc-set! table val +;; (+ 1 (if (eq? freq #f) 0 freq)))))) vals))) EXPR) +;; table)) (define* (per-weekday #:optional (EXPR "")) "Count the total number of messages for each weekday (0-6 for 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" - (let* ((stats (frequency - (lambda (msg) (tm:wday (localtime (mu:msg:date msg)))) EXPR))) + (let* ((stats (mu:tabulate-messages + (lambda (msg) (tm:wday (localtime (date msg)))) EXPR))) (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of weekday (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 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" - (let* ((stats (frequency + (let* ((stats (mu:tabulate-messages (lambda (msg) ;; note the 1+ - (1+ (tm:mon (localtime (mu:msg:date msg))))) EXPR))) + (1+ (tm:mon (localtime (date msg))))) EXPR))) (sort stats (lambda(a b) (< (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 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" - (let* ((stats (frequency - (lambda (msg) (tm:hour (localtime (mu:msg:date msg)))) EXPR))) + (let* ((stats (mu:tabulate-messages + (lambda (msg) (tm:hour (localtime (date msg)))) EXPR))) (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of hour (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 optional EXPR is provided, only count the messages that match it. The result is a list of pairs (year . frequency).\n" - (let* ((stats (frequency - (lambda (msg) (+ 1900 (tm:year (localtime (mu:msg:date msg))))) + (let* ((stats (mu:tabulate-messages + (lambda (msg) (+ 1900 (tm:year (localtime (date msg))))) EXPR))) (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 (display msg) (exit (if help 0 1)))) - (if muhome - (initialize-mu muhome) - (initialize-mu)) + (mu:initialize muhome) (cond ((string= period "hour") (mu:plot:per-hour expr)) ((string= period "day") (mu:plot:per-weekday expr)) diff --git a/guile/mu-guile-msg.c b/guile/mu-guile-msg.c deleted file mode 100644 index 53ef70fa..00000000 --- a/guile/mu-guile-msg.c +++ /dev/null @@ -1,580 +0,0 @@ -/* -** Copyright (C) 2011 Dirk-Jan C. Binnema -** -** This program is free software; you can redistribute it and/or modify it -** under the terms of the GNU General Public License as published by the -** Free Software Foundation; either version 3, or (at your option) any -** later version. -** -** This program is distributed in the hope that it will be useful, -** but WITHOUT ANY WARRANTY; without even the implied warranty of -** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -** GNU General Public License for more details. -** -** You should have received a copy of the GNU General Public License -** along with this program; if not, write to the Free Software Foundation, -** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -** -*/ - - -#include -#include -#include - -#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); - - 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; -} diff --git a/guile/mu-guile-msg.h b/guile/mu-guile-msg.h deleted file mode 100644 index e69b095d..00000000 --- a/guile/mu-guile-msg.h +++ /dev/null @@ -1,65 +0,0 @@ -/* -** Copyright (C) 2011 Dirk-Jan C. Binnema -** -** This program is free software; you can redistribute it and/or modify it -** under the terms of the GNU General Public License as published by the -** Free Software Foundation; either version 3, or (at your option) any -** later version. -** -** This program is distributed in the hope that it will be useful, -** but WITHOUT ANY WARRANTY; without even the implied warranty of -** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -** GNU General Public License for more details. -** -** You should have received a copy of the GNU General Public License -** along with this program; if not, write to the Free Software Foundation, -** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -** -*/ - -#ifndef __MU_GUILE_MSG_H__ -#define __MU_GUILE_MSG_H__ - -#include -#include - -#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__*/ diff --git a/guile/mu-guile-util.c b/guile/mu-guile-util.c deleted file mode 100644 index 27a9958a..00000000 --- a/guile/mu-guile-util.c +++ /dev/null @@ -1,48 +0,0 @@ -/* -** Copyright (C) 2011 Dirk-Jan C. Binnema -** -** This program is free software; you can redistribute it and/or modify it -** under the terms of the GNU General Public License as published by the -** Free Software Foundation; either version 3, or (at your option) any -** later version. -** -** This program is distributed in the hope that it will be useful, -** but WITHOUT ANY WARRANTY; without even the implied warranty of -** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -** GNU General Public License for more details. -** -** You should have received a copy of the GNU General Public License -** along with this program; if not, write to the Free Software Foundation, -** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -** -*/ - -#include -#include - -#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 : ""), - 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; -} diff --git a/guile/mu-guile-util.h b/guile/mu-guile-util.h deleted file mode 100644 index c37fbfca..00000000 --- a/guile/mu-guile-util.h +++ /dev/null @@ -1,61 +0,0 @@ -/* -** Copyright (C) 2011 Dirk-Jan C. Binnema -** -** This program is free software; you can redistribute it and/or modify it -** under the terms of the GNU General Public License as published by the -** Free Software Foundation; either version 3, or (at your option) any -** later version. -** -** This program is distributed in the hope that it will be useful, -** but WITHOUT ANY WARRANTY; without even the implied warranty of -** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -** GNU General Public License for more details. -** -** You should have received a copy of the GNU General Public License -** along with this program; if not, write to the Free Software Foundation, -** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -** -*/ - -#ifndef __MU_GUILE_UTIL_H__ -#define __MU_GUILE_UTIL_H__ - -#include -#include - -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__*/ diff --git a/guile/mu-guile.c b/guile/mu-guile.c index a5e391d7..9d9d92d3 100644 --- a/guile/mu-guile.c +++ b/guile/mu-guile.c @@ -21,12 +21,457 @@ #include #endif /*HAVE_CONFIG_H*/ +#include +#include + #include #include #include +#include +#include +#include + +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 : ""), + 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); + + 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 { 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), "Initialize mu - needed before you call any of the other " "functions. Optionally, you can provide MUHOME which " @@ -93,14 +538,17 @@ SCM_DEFINE_PUBLIC (mu_initialize, "initialize-mu", 0, 1, 0, { 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); if (MU_DATA) return mu_guile_util_error (FUNC_NAME, 0, "Already initialized", 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)) 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 -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") #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)); 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), - "Call FUNC for each message in the message store. If search expression EXPR " - "is specified, limit this to messages matching EXPR\n") + "Call FUNC for each message in the message store. EXPR is either a " +"string containing a mu search expression or a boolean; in the former " +"case, limit the messages to only those matching the expression, in the " +"latter case, match /all/ messages if the EXPR equals #t, and match " +"none if EXPR equals #f.") #define FUNC_NAME s_for_each_message { MuMsgIter *iter; - int count; const char* expr; 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); if (!MU_DATA) return mu_guile_util_error (FUNC_NAME, 0, "mu not initialized", SCM_UNDEFINED); - - /* note, "" matches *all* messages */ - expr = SCM_UNBNDP(EXPR) ? "" : scm_to_utf8_string(EXPR); + if (EXPR == SCM_BOOL_F) + return SCM_UNSPECIFIED; /* nothing to do */ + else if (EXPR == SCM_BOOL_T) + expr = ""; /* note, "" matches *all* messages */ + else + expr = scm_to_utf8_string(EXPR); iter = get_query_iter (MU_DATA->_query, expr); if (!iter) return SCM_UNSPECIFIED; - 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); - ++count; + mu_msg_iter_next (iter); } - return scm_from_int (count); + return SCM_UNSPECIFIED; } #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 " "(in 'simple-format' notation).\n") #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 -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' " "notation).\n") #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 -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 " "(in 'simple-format' notation).\n") #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* mu_guile_init (void *data) { + MSG_TAG = scm_make_smob_type ("msg", sizeof(MuMsgWrapper)); + + scm_set_smob_mark (MSG_TAG, msg_mark); + scm_set_smob_free (MSG_TAG, msg_free); + scm_set_smob_print (MSG_TAG, msg_print); + + define_symbols (); + #include "mu-guile.x" return NULL; diff --git a/guile/mu.scm b/guile/mu.scm index 2e51564b..8884be93 100644 --- a/guile/mu.scm +++ b/guile/mu.scm @@ -18,36 +18,38 @@ (define-module (mu) :use-module (oop goops) - :use-module (mu msg) + :use-module (mu message) :use-module (mu contact) :export - (for-each-contact - for-each-message)) ;; note, defined in libguile-mu (in c) + (mu:for-each-contact + mu:for-each-message + mu:message-list + mu:tabulate-messages + mu:average-messages)) (load-extension "libguile-mu" "mu_guile_init") -(define* (for-each-contact proc #:optional (expr "")) - "Execute PROC for each contact. PROC receives a instance +(define* (mu:for-each-contact proc #:optional (expr #t)) + "Execute PROC for each contact. PROC receives a instance as parameter. If EXPR is specified, only consider contacts in messages matching EXPR." (let ((c-hash (make-hash-table 4096))) - (for-each-message + (mu:for-each-message (lambda (msg) (for-each (lambda (name-addr) - (let ((contact (make + (let ((contact (make #:name (car name-addr) #:email (cdr name-addr) - #:timestamp (mu:msg:date msg)))) + #:timestamp (date msg)))) (update-contacts-hash c-hash contact))) - (append (mu:msg:to msg) (mu:msg:from msg) (mu:msg:cc msg) - (mu:msg:bcc msg)))) + (contacts msg #t))) expr) ;; c-hash now contains a map of email->contact (hash-for-each (lambda (email contact) (proc contact)) c-hash))) -(define-method (update-contacts-hash c-hash (nc )) +(define-method (update-contacts-hash c-hash (nc )) "Update the contacts hash with a new and/or existing contact." ;; xc: existing-contact, nc: new contact (let ((xc (hash-ref c-hash (email nc)))) @@ -68,3 +70,52 @@ matching EXPR." (set! (last-seen xc) (timestamp nc))) ;; okay --> now xc has been updated; but it back in the hash (hash-set! c-hash (email xc) xc))))) + +(define* (mu:for-each-message func #:optional (expr #t)) + "Execute function FUNC for each message that matches mu search expression EXPR. +If EXPR is not provided, match /all/ messages in the store." + (let ((my-func + (lambda (msg) + (func (make #:msg msg))))) + (mu:internal:for-each-message my-func expr))) + +(define* (mu:message-list #:optional (expr #t)) + "Return a list of all messages matching mu search expression +EXPR. If EXPR is not provided, return a list of /all/ messages in the store." + (let ((lst '())) + (mu:for-each-message + (lambda (m) + (set! lst (append! lst (list m)))) expr) + lst)) + +(define* (mu:tabulate-messages func #:optional (expr #t)) + "Execute FUNC for each message matching EXPR, and return an alist +with maps each result of FUNC to its frequency. FUNC is a function +takes a instance as its argument. For example, to tabulate messages by weekday, +one could use: + (mu:tabulate-messages (lambda(msg) (tm:wday (localtime (date msg))))) +." + (let ((table '())) + (mu:for-each-message + (lambda(msg) + (let* ((val (func msg)) + (old-freq (or (assoc-ref table val) 0))) + (set! table (assoc-set! table val (1+ old-freq))))) + expr) + table)) + + +(define* (mu:average-messages func #:optional (expr #t)) + "Execute FUNC for each message matching EXPR, and return the average value of the results of FUNC. + FUNC is a function that takes a instance as its +argument, and returns some number. For example, to get the average message size of messages related to icecream: + (mu:average (lambda(msg) (size msg)) \"icecream\" ." +(let ((count 0) (sum 0)) + (mu:for-each-message + (lambda (msg) + (set! count (+1 count)) + (set! sum (+ sum (func msg)))) + expr) + (if (= count 0) + 0 + (exact->inexact (/ sum count))))) diff --git a/guile/mu/Makefile.am b/guile/mu/Makefile.am index f3c45bc9..f0a2e5dd 100644 --- a/guile/mu/Makefile.am +++ b/guile/mu/Makefile.am @@ -21,6 +21,7 @@ include $(top_srcdir)/gtest.mk scmdir=${prefix}/share/guile/site/2.0/mu/ scm_DATA= \ msg.scm \ + message.scm \ contact.scm EXTRA_DIST=$(scm_DATA) diff --git a/guile/mu/contact.scm b/guile/mu/contact.scm index cd7c74ff..cf943d0b 100644 --- a/guile/mu/contact.scm +++ b/guile/mu/contact.scm @@ -22,12 +22,12 @@ (define-module (mu contact) :use-module (oop goops) :export ( ;; classes - + ;; contact methods name email timestamp frequency last-seen )) -(define-class () +(define-class () (name #:init-value #f #:accessor name #:init-keyword #:name) (email #:init-value #f #:accessor email #:init-keyword #:email) (tstamp #:init-value 0 #:accessor timestamp #:init-keyword #:timestamp) diff --git a/guile/mu/msg.scm b/guile/mu/msg.scm index f95dbdda..9daa312e 100644 --- a/guile/mu/msg.scm +++ b/guile/mu/msg.scm @@ -17,4 +17,4 @@ ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. (define-module (mu msg)) -(load-extension "libguile-mu" "mu_guile_msg_init") +(load-extension "libguile-mu" "mu_guile_init")