From b5e2f1c14a16c6c230f65b3a6e3f63a5a139b1bd Mon Sep 17 00:00:00 2001 From: djcb Date: Fri, 30 Dec 2011 12:36:59 +0200 Subject: [PATCH] * guile support cleanup (WIP) --- guile/Makefile.am | 6 - guile/examples/contacts-export | 56 +++--- guile/examples/msg-stats | 216 ++++++++++++++++++++++- guile/mu-guile-log.c | 63 ------- guile/mu-guile-msg.c | 4 +- guile/mu-guile-store.c | 127 -------------- guile/mu-guile-store.h | 39 ----- guile/mu-guile-util.c | 2 +- guile/mu-guile.c | 222 +++++++++++++++++++++--- guile/mu-guile.h | 9 - guile/mu.scm | 50 +++++- guile/mu/Makefile.am | 5 +- guile/mu/{store.scm => contact.scm} | 22 ++- guile/mu/contacts.scm | 114 ------------ guile/mu/log.scm | 20 --- guile/mu/stats.scm | 259 ---------------------------- 16 files changed, 514 insertions(+), 700 deletions(-) delete mode 100644 guile/mu-guile-store.c delete mode 100644 guile/mu-guile-store.h rename guile/mu/{store.scm => contact.scm} (57%) delete mode 100644 guile/mu/contacts.scm delete mode 100644 guile/mu/log.scm delete mode 100644 guile/mu/stats.scm diff --git a/guile/Makefile.am b/guile/Makefile.am index 3fea8251..00e1b0c5 100644 --- a/guile/Makefile.am +++ b/guile/Makefile.am @@ -39,10 +39,6 @@ libguile_mu_la_SOURCES= \ mu-guile.h \ mu-guile-msg.c \ mu-guile-msg.h \ - mu-guile-store.c \ - mu-guile-store.h \ - mu-guile-log.c \ - mu-guile-log.h \ mu-guile-util.c \ mu-guile-util.h @@ -52,8 +48,6 @@ libguile_mu_la_LIBADD= \ XFILES= \ mu-guile-msg.x \ - mu-guile-store.x \ - mu-guile-log.x \ mu-guile.x moduledir=$(GUILE_SITEDIR) diff --git a/guile/examples/contacts-export b/guile/examples/contacts-export index 1e5727f0..0c6bf996 100755 --- a/guile/examples/contacts-export +++ b/guile/examples/contacts-export @@ -22,57 +22,71 @@ exec guile -e main -s $0 $@ (use-modules (ice-9 getopt-long)) -(use-modules (mu) (mu contacts)) +(use-modules (srfi srfi-1)) +(use-modules (mu) (mu contact)) (define (sort-by-freq c1 c2) - (let ((freq1 (vector-ref c1 2)) - (freq2 (vector-ref c2 2))) - (< freq2 freq2))) + (< (frequency c1) (frequency c2))) (define (sort-by-newness c1 c2) - (let ((tstamp1 (vector-ref c1 3)) - (tstamp2 (vector-ref c2 3))) - (< tstamp1 tstamp2))) + (< (timestamp c1) (timestamp c2))) +(define (export-contact contact form) + (cond + ((string= form "org-contacts") + (format #t "* ~a\n:PROPERTIES:\n:EMAIL:~a\n:END:\n\n" + (or (name contact) (email contact)) (email contact))))) (define (main args) (let* ((optionspec '( (muhome (value #t)) (sort-by (value #t)) (revert (value #f)) + (format (value #t)) (limit (value #t)) (help (single-char #\h) (value #f)))) (options (getopt-long args optionspec)) (msg (string-append - "usage: mu-contacts-export [--help] [--muhome=] " + "usage: contacts-export [--help] [--muhome=] " "--format= " - "--sort-by= [--revert] [--limit=]\n")) + "--sort-by= [--revert] [--limit=]\n")) (help (option-ref options 'help #f)) (muhome (option-ref options 'muhome #f)) - (sort-by (or (option-ref options 'sort-by #f) "freq")) + (sort-by (or (option-ref options 'sort-by #f) "frequency")) (revert (option-ref options 'revert #f)) - (format (or (option-ref options 'format #f) "plain")) - (limit (option-ref options 'limit #f))) + (form (or (option-ref options 'format #f) "plain")) + (limit (string->number (option-ref options 'limit 1000000)))) (if help (begin (display msg) (exit 0)) (begin (if muhome - (mu:init muhome) - (mu:init)) + (initialize-mu muhome) + (initialize-mu)) (let* ((sort-func (cond - ((string= sort-by "freq") sort-by-freq) + ((string= sort-by "frequency") sort-by-freq) ((string= sort-by "newness") sort-by-newness) - (else (begin (display msg) (exit 1)))))) + (else (begin (display msg) (exit 1))))) + (contacts '())) + ;; make a list of all contacts + (for-each-contact + (lambda (c) (set! contacts (cons c contacts)))) + ;; should we sort it? + (if sort-by + (set! contacts (sort! contacts + (if revert (negate sort-func) sort-func)))) + + ;; should we limit the number? + (if limit + (set! contacts (take! contacts limit))) + ;; export! (for-each - (lambda (c) (format #t "~S\n" (vector-ref c 0))) - (mu:contacts:list))))))) + (lambda (c) + (export-contact c form)) + contacts)))))) - - ;;(mu:contacts:export 'plain sort-func 100)))))) - ;; Local Variables: ;; mode: scheme ;; End: diff --git a/guile/examples/msg-stats b/guile/examples/msg-stats index 41aa9388..f3a5a159 100755 --- a/guile/examples/msg-stats +++ b/guile/examples/msg-stats @@ -20,9 +20,213 @@ exec guile -e main -s $0 $@ ;; along with this program; if not, write to the Free Software Foundation, ;; 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 (ice-9 getopt-long)) -(use-modules (mu) (mu stats)) +;; note, this is a rather inefficient way to calculate the number; for +;; demonstration purposes only... +;; (define* (count #:optional (EXPR "")) +;; "Count the total number of messages. If the optional EXPR is +;; provided, only count the messages that match it.\n" +;; (for-each-message (lambda(msg) #f) EXPR)) + +;; (define* (average FUNC #:optional (EXPR "")) +;; "Count the average of the result of applying FUNC on all +;; messages. If the optional EXPR is provided, only consider the messages +;; that match it.\n" +;; (let* ((sum 0) +;; (n (for-each-message +;; (lambda(msg) (set! sum (+ sum (FUNC msg)))) EXPR))) +;; (if (= n 0) 0 (exact->inexact (/ sum n))))) + +;; (define* (average-size #:optional (EXPR "")) +;; "Calculate the average message size. If the optional EXPR is +;; provided, only consider the messages that match it.\n" +;; (average (lambda(msg) (mu:msg:size msg)) EXPR)) + +;; (define* (average-recipient-number #:optional (EXPR "")) +;; "Calculate the average number of recipients (To: + CC: + Bcc:). If +;; the optional EXPR is provided, only consider the messages that match +;; it.\n" +;; (average (lambda(msg) +;; (+(length (mu:msg:to msg)) +;; (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* (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))) + (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of weekday + +(define* (mu:plot:per-weekday #:optional (EXPR "")) + (let* ((datafile (export-pairs (per-weekday EXPR))) + (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) + ;; note, we cannot use the weekday "%a" support in gnuplot because + ;; demands the field to be a date field ('set xdata time' etc.) + ;; for that to work, but we cannot use that since gnuplot does not + ;; support weekdays ('%w') as a date field in its input + (display (string-append + "reset\n" + "set xtics (\"Sun\" 0, \"Mon\" 1, \"Tue\" 2, \"Wed\" 3," + "\"Thu\" 4, \"Fri\" 5, \"Sat\" 6);\n" + "set xlabel \"Weekday\"\n" + "set ylabel \"# of messages\"\n" + "set boxwidth 0.9\n") gnuplot) + (display (string-append "plot \"" datafile "\" using 1:2 with boxes fs solid\n") + gnuplot) + (close-pipe gnuplot))) + + +(define* (per-month #:optional (EXPR "")) + "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 + (lambda (msg) ;; note the 1+ + (1+ (tm:mon (localtime (mu:msg:date msg))))) EXPR))) + (sort stats + (lambda(a b) + (< (car a) (car b)))))) ;; in order ofmonth + + +(define* (mu:plot:per-month #:optional (EXPR "")) + (let* ((datafile (export-pairs (per-month EXPR))) + (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) + (display (string-append + "reset\n" + "set xtics (\"Jan\" 1, \"Feb\" 2, \"Mar\" 3, \"Apr\" 4," + "\"May\" 5, \"Jun\" 6, \"Jul\" 7, \"Aug\" 8," + "\"Sep\" 9, \"Oct\" 10, \"Nov\" 11, \"Dec\" 12);\n" + "set xlabel \"Month\"\n" + "set ylabel \"# of messages\"\n" + "set boxwidth 0.9\n") gnuplot) + (display (string-append "plot \"" datafile "\" using 1:2 with boxes fs solid\n") + gnuplot) + (close-pipe gnuplot))) + + +(define* (per-hour #: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:hour (localtime (mu:msg:date msg)))) EXPR))) + (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of hour + +(define* (mu:plot:per-hour #:optional (EXPR "")) + (let* ((datafile (export-pairs (per-hour EXPR))) + (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) + (display (string-append + "reset\n" + "set xlabel \"Hour\"\n" + "set ylabel \"# of messages\"\n" + "set boxwidth 0.9\n") gnuplot) + (display (string-append "plot \"" datafile "\" using 1:2 with boxes fs solid\n") + gnuplot) + (close-pipe gnuplot))) + + +(define* (per-year #:optional (EXPR "")) + "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))))) + EXPR))) + (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of year + +(define* (mu:plot:per-year #:optional (EXPR "")) + (let* ((datafile (export-pairs (per-year EXPR))) + (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) + (display (string-append + "reset\n" + "set xlabel \"Year\"\n" + "set ylabel \"# of messages\"\n" + "set boxwidth 0.9\n") gnuplot) + (display (string-append "plot \"" datafile "\" using 1:2 with boxes fs solid\n") + gnuplot) + (close-pipe gnuplot))) + +;; (define* (top-n FUNC N #:optional (EXPR "")) +;; "Get the Top-N frequency of the result of FUNC applied on each +;; message. If the optional EXPR is provided, only consider the messages +;; that match it." +;; (let* ((freq (frequency FUNC EXPR)) +;; (top (sort freq (lambda (a b) (< (cdr b) (cdr a) ))))) +;; (list-head top (min (length freq) N)))) + +;; (define* (top-n-to #:optional (N 10) (EXPR "")) +;; "Get the Top-N To:-recipients. If the optional N is not provided, +;; use 10. If the optional EXPR is provided, only consider the messages +;; that match it." +;; (top-n +;; (lambda (msg) (mu:msg:to msg)) N EXPR)) + +;; (define* (top-n-from #:optional (N 10) (EXPR "")) +;; "Get the Top-N senders (From:). If the optional N is not provided, +;; use 10. If the optional EXPR is provided, only consider the messages +;; that match it." +;; (top-n +;; (lambda (msg) (mu:msg:from msg)) N EXPR)) + +;; (define* (top-n-subject #:optional (N 10) (EXPR "")) +;; "Get the Top-N subjects. If the optional N is not provided, +;; use 10. If the optional EXPR is provided, only consider the messages +;; that match it." +;; (top-n +;; (lambda (msg) (mu:msg:subject msg)) N EXPR)) + +(define* (table pairs #:optional (port (current-output-port))) + "Display a list of PAIRS in a table-like fashion." + (let ((maxlen 0)) + (for-each ;; find the widest in the first col + (lambda (pair) + (set! maxlen + (max maxlen (string-length (format #f "~s " (car pair)))))) pairs) + (for-each + (lambda (pair) + (let ((first (format #f "~s" (car pair))) + (second (format #f "~s" (cdr pair)))) + (display (format #f "~A~v_~A\n" + first (- maxlen (string-length first)) second) port))) + pairs))) + +;; (define* (histogram pairs #:optional (port (current-output-port))) +;; "Display a histogram of the list of cons pairs; the car of each pair +;; is used for the x-asxis, while the cdr represents the y value." +;; (let ((pairs ;; pairs may be unsorted, so let's sort first +;; (sort (pairs) (lambda(x1 x2) (< x1 x2))))) + +(define (export-pairs pairs) + "Export PAIRS to a temporary file, return its name. The data can +then be used in, e.g., R and gnuplot." + (let* ((datafile (tmpnam)) + (output (open datafile (logior O_CREAT O_WRONLY) #O0644))) + (table pairs output) + (close output) + datafile)) (define (main args) (let* ((optionspec '( (muhome (value #t)) @@ -40,10 +244,10 @@ exec guile -e main -s $0 $@ (if (or help (not period)) (begin (display msg) - (exit (if help 0 1))) - (if (option-ref options 'muhome #f) - (mu:init (option-ref options 'muhome)) - (mu:init))) + (exit (if help 0 1)))) + (if muhome + (initialize-mu muhome) + (initialize-mu)) (cond ((string= period "hour") (mu:plot:per-hour expr)) ((string= period "day") (mu:plot:per-weekday expr)) diff --git a/guile/mu-guile-log.c b/guile/mu-guile-log.c index d985c62c..205764b1 100644 --- a/guile/mu-guile-log.c +++ b/guile/mu-guile-log.c @@ -20,69 +20,6 @@ #include "mu-guile-util.h" #include "mu-guile-log.h" -enum _LogType { - LOG_INFO, - LOG_WARNING, - LOG_CRITICAL -}; -typedef enum _LogType LogType; - - -static SCM -write_log (LogType logtype, SCM FRM, SCM ARGS) -#define FUNC_NAME __FUNCTION__ -{ - SCM str; - - SCM_ASSERT (scm_is_string(FRM), FRM, SCM_ARG1, ""); - SCM_VALIDATE_REST_ARGUMENT(ARGS); - - str = scm_simple_format (SCM_BOOL_F, FRM, ARGS); - - if (scm_is_string (str)) { - - gchar *output; - output = scm_to_utf8_string (str); - - switch (logtype) { - case LOG_INFO: g_message ("%s", output); break; - case LOG_WARNING: g_warning ("%s", output); break; - case LOG_CRITICAL: g_critical ("%s", output); break; - } - } - - return SCM_UNSPECIFIED; - -#undef FUNC_NAME -} - - -SCM_DEFINE_PUBLIC (log_info, "mu:log:info", 1, 0, 1, (SCM FRM, SCM ARGS), - "log some message using a list of ARGS applied to FRM " - "(in 'simple-format' notation).\n") -#define FUNC_NAME s_info -{ - return write_log (LOG_INFO, FRM, ARGS); -} -#undef FUNC_NAME - -SCM_DEFINE_PUBLIC (log_warning, "mu:log:warning", 1, 0, 1, (SCM FRM, SCM ARGS), - "log some warning using a list of ARGS applied to FRM (in 'simple-format' " - "notation).\n") -#define FUNC_NAME s_warning -{ - return write_log (LOG_WARNING, FRM, ARGS); -} -#undef FUNC_NAME - -SCM_DEFINE_PUBLIC (log_critical, "mu:log:critical", 1, 0, 1, (SCM FRM, SCM ARGS), - "log some critical message using a list of ARGS applied to FRM " - "(in 'simple-format' notation).\n") -#define FUNC_NAME s_critical -{ - return write_log (LOG_CRITICAL, FRM, ARGS); -} -#undef FUNC_NAME void* diff --git a/guile/mu-guile-msg.c b/guile/mu-guile-msg.c index 522cc4aa..53ef70fa 100644 --- a/guile/mu-guile-msg.c +++ b/guile/mu-guile-msg.c @@ -262,10 +262,12 @@ contacts_to_list (MuMsgContact *contact, EachContactData *ecdata) addr = mu_msg_contact_address (contact); name = mu_msg_contact_name (contact); + item = scm_list_1 - (scm_list_2 ( + (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)); } } diff --git a/guile/mu-guile-store.c b/guile/mu-guile-store.c deleted file mode 100644 index 83e78007..00000000 --- a/guile/mu-guile-store.c +++ /dev/null @@ -1,127 +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-store.h" -#include "mu-guile-util.h" - -static MuQuery* -get_query (void) -{ - MuQuery *query; - MuStore *store; - GError *err; - - err = NULL; - store = mu_store_new_read_only (mu_runtime_path(MU_RUNTIME_PATH_XAPIANDB), - &err); - query = store ? mu_query_new (store, &err) : NULL; - - if (store) - mu_store_unref (store); - - if (!query) { - mu_guile_util_g_error ("", err); - g_clear_error (&err); - } - - return query; -} - - -static MuMsgIter* -get_query_iter (MuQuery *query, const char* expr) -{ - MuMsgIter *iter; - GError *err; - - err = NULL; - iter = mu_query_run (query, expr, - FALSE, MU_MSG_FIELD_ID_NONE, TRUE, -1, &err); - if (!iter) { - mu_guile_util_g_error ("", err); - g_clear_error (&err); - } - - return iter; -} - - -static void -call_func (SCM FUNC, MuMsgIter *iter, const char* func_name) -{ - SCM msgsmob; - MuMsg *msg; - - msg = mu_msg_iter_get_msg_floating (iter); /* don't unref */ - - msgsmob = mu_guile_msg_to_scm (mu_msg_ref(msg)); - scm_call_1 (FUNC, msgsmob); - -} - - -SCM_DEFINE_PUBLIC (store_foreach, "mu:store:for-each", 1, 1, 0, - (SCM FUNC, SCM EXPR), - "Call FUNC for each message in the store, or, if EXPR is specified, " - "for each message matching EXPR.\n") -#define FUNC_NAME s_store_foreach -{ - MuQuery *query; - 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), - EXPR, SCM_ARG2, FUNC_NAME); - - query = get_query (); - if (!query) - return SCM_UNSPECIFIED; - - expr = SCM_UNBNDP(EXPR) ? NULL : scm_to_utf8_string(EXPR); - - iter = get_query_iter (query, expr); - if (!iter) - return SCM_UNSPECIFIED; - - for (count = 0; !mu_msg_iter_is_done(iter); mu_msg_iter_next (iter)) { - call_func (FUNC, iter, FUNC_NAME); - ++count; - } - - mu_query_destroy (query); - - return scm_from_int (count); -} -#undef FUNC_NAME - - -void* -mu_guile_store_init (void *data) -{ -#include "mu-guile-store.x" - - return NULL; -} diff --git a/guile/mu-guile-store.h b/guile/mu-guile-store.h deleted file mode 100644 index 47c60a8d..00000000 --- a/guile/mu-guile-store.h +++ /dev/null @@ -1,39 +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_STORE_H__ -#define __MU_GUILE_STORE_H__ - - -#ifdef __cplusplus -extern "C" { -#endif /*__cplusplus*/ - -/** - * initialize mu:store functions - * - */ -void *mu_guile_store_init (void *data); - - -#ifdef __cplusplus -} -#endif /*__cplusplus*/ - -#endif /*__MU_GUILE_STORE_H__*/ diff --git a/guile/mu-guile-util.c b/guile/mu-guile-util.c index 50b2fdae..f485f670 100644 --- a/guile/mu-guile-util.c +++ b/guile/mu-guile-util.c @@ -20,7 +20,7 @@ SCM mu_guile_util_error (const char *func_name, int status, - const char *fmt, SCM args) + const char *fmt, SCM args) { scm_error_scm (scm_from_locale_symbol ("MuError"), scm_from_utf8_string (func_name ? func_name : ""), diff --git a/guile/mu-guile.c b/guile/mu-guile.c index 11f87dff..a5e391d7 100644 --- a/guile/mu-guile.c +++ b/guile/mu-guile.c @@ -22,59 +22,237 @@ #endif /*HAVE_CONFIG_H*/ #include +#include +#include + #include "mu-guile-util.h" +#include "mu-guile-msg.h" + +struct _MuData { + MuQuery *_query; +}; +typedef struct _MuData MuData; + +static MuData *MU_DATA = NULL; + +static gboolean +init_mu (const char *muhome) +{ + MuStore *store; + MuQuery *query; + GError *err; + + g_return_val_if_fail (!MU_DATA, FALSE); + + if (!mu_runtime_init (muhome, "guile")) + return FALSE; + + store = mu_store_new_read_only (mu_runtime_path(MU_RUNTIME_PATH_XAPIANDB), + &err); + if (!store) { + mu_guile_util_g_error (__FUNCTION__, err); + g_clear_error (&err); + return FALSE; + } + + query = mu_query_new (store, &err); + mu_store_unref (store); + if (!query) { + mu_guile_util_g_error (__FUNCTION__, err); + g_clear_error (&err); + return FALSE; + } + + MU_DATA = g_new0 (MuData, 1); + MU_DATA->_query = query; + + return TRUE; +} + +static void +uninit_mu (void) +{ + g_return_if_fail (MU_DATA); + + mu_query_destroy (MU_DATA->_query); + g_free (MU_DATA); + + MU_DATA = NULL; + + mu_runtime_uninit (); +} -static gboolean initialized = FALSE; - -SCM_DEFINE_PUBLIC (init_mu, "mu:init", 0, 1, 0, +SCM_DEFINE_PUBLIC (mu_initialize, "initialize-mu", 0, 1, 0, (SCM MUHOME), "Initialize mu - needed before you call any of the other " "functions. Optionally, you can provide MUHOME which " "should be an absolute path to your mu home directory " "(typically, the default, ~/.mu, should be just fine)") -#define FUNC_NAME s_init_mu +#define FUNC_NAME s_mu_initialize { const char *muhome; - static gboolean initialized = FALSE; SCM_ASSERT (scm_is_string (MUHOME) || SCM_UNBNDP(MUHOME), MUHOME, SCM_ARG1, FUNC_NAME); - if (initialized) + if (MU_DATA) return mu_guile_util_error (FUNC_NAME, 0, "Already initialized", - SCM_UNSPECIFIED); + SCM_BOOL_F); muhome = SCM_UNBNDP(MUHOME) ? NULL : scm_to_utf8_string (MUHOME); - if (!mu_runtime_init (muhome, "mu-guile")) + if (!init_mu (muhome)) return mu_guile_util_error (FUNC_NAME, 0, "Failed to initialize mu", - SCM_UNSPECIFIED); - initialized = TRUE; - + SCM_BOOL_F); /* cleanup when we're exiting */ - g_atexit (mu_runtime_uninit); + g_atexit (uninit_mu); + + return SCM_BOOL_T; +} +#undef FUNC_NAME + + +SCM_DEFINE_PUBLIC (mu_initialized_p, "initialized-mu?", 0, 0, 0, + (void), "Whether mu is initialized or not.\n") +#define FUNC_NAME s_mu_initialized_p +{ + return MU_DATA ? SCM_BOOL_T : SCM_BOOL_F; +} +#undef FUNC_NAME + + +static MuMsgIter* +get_query_iter (MuQuery *query, const char* expr) +{ + MuMsgIter *iter; + GError *err; + + err = NULL; + iter = mu_query_run (query, expr, + FALSE, MU_MSG_FIELD_ID_NONE, TRUE, -1, &err); + if (!iter) { + mu_guile_util_g_error ("", err); + g_clear_error (&err); + } + + return iter; +} + + +static void +call_func (SCM FUNC, MuMsgIter *iter, const char* func_name) +{ + SCM msgsmob; + MuMsg *msg; + + msg = mu_msg_iter_get_msg_floating (iter); /* don't unref */ + + 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 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") +#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), + 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); + + 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)) { + call_func (FUNC, iter, FUNC_NAME); + ++count; + } + + return scm_from_int (count); +} +#undef FUNC_NAME + + +enum _LogType { + LOG_INFO, + LOG_WARNING, + LOG_CRITICAL +}; +typedef enum _LogType LogType; + + +static SCM +write_log (LogType logtype, SCM FRM, SCM ARGS) +#define FUNC_NAME __FUNCTION__ +{ + SCM str; + + SCM_ASSERT (scm_is_string(FRM), FRM, SCM_ARG1, ""); + SCM_VALIDATE_REST_ARGUMENT(ARGS); + + str = scm_simple_format (SCM_BOOL_F, FRM, ARGS); + + if (scm_is_string (str)) { + + gchar *output; + output = scm_to_utf8_string (str); + + switch (logtype) { + case LOG_INFO: g_message ("%s", output); break; + case LOG_WARNING: g_warning ("%s", output); break; + case LOG_CRITICAL: g_critical ("%s", output); break; + } + } return SCM_UNSPECIFIED; + +#undef FUNC_NAME +} + + +SCM_DEFINE_PUBLIC (log_info, "mu:log:info", 1, 0, 1, (SCM FRM, SCM ARGS), + "log some message using a list of ARGS applied to FRM " + "(in 'simple-format' notation).\n") +#define FUNC_NAME s_info +{ + return write_log (LOG_INFO, FRM, ARGS); } #undef FUNC_NAME - -SCM_DEFINE_PUBLIC (init_p, "mu:init?", 0, 0, 0, - (void), "Whether mu is initialized or not.\n") -#define FUNC_NAME s_init_p +SCM_DEFINE_PUBLIC (log_warning, "mu:log:warning", 1, 0, 1, (SCM FRM, SCM ARGS), + "log some warning using a list of ARGS applied to FRM (in 'simple-format' " + "notation).\n") +#define FUNC_NAME s_warning { - return initialized ? SCM_BOOL_T : SCM_BOOL_F; + return write_log (LOG_WARNING, FRM, ARGS); } #undef FUNC_NAME - -/* C function so we can cheaply check from other C-based code */ -gboolean -mu_guile_initialized (void) +SCM_DEFINE_PUBLIC (log_critical, "mu:log:critical", 1, 0, 1, (SCM FRM, SCM ARGS), + "log some critical message using a list of ARGS applied to FRM " + "(in 'simple-format' notation).\n") +#define FUNC_NAME s_critical { - return initialized; + return write_log (LOG_CRITICAL, FRM, ARGS); } +#undef FUNC_NAME + void* diff --git a/guile/mu-guile.h b/guile/mu-guile.h index 59438f11..3904c144 100644 --- a/guile/mu-guile.h +++ b/guile/mu-guile.h @@ -24,15 +24,6 @@ G_BEGIN_DECLS -/** - * Whether or not mu/guile has been initialized - * - * - * @return TRUE if it has been initialized, FALSE otherwise - */ -gboolean mu_guile_initialized (void); - - /** * Initialize this mu guile module. * diff --git a/guile/mu.scm b/guile/mu.scm index 4caf37c7..41935408 100644 --- a/guile/mu.scm +++ b/guile/mu.scm @@ -17,9 +17,55 @@ ;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. (define-module (mu) + :use-module (oop goops) :use-module (mu log) :use-module (mu msg) - :use-module (mu store)) + :use-module (mu contact) + :export + (for-each-contact + for-each-message)) ;; note, defined in libguile-mu (in c) -;; mu_guile_init will actually initialize the msg/store/log as well (load-extension "libguile-mu" "mu_guile_init") + +(define* (for-each-contact proc #:optional (expr "")) + "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 + (lambda (msg) + (for-each + (lambda (name-addr) + (let ((contact (make + #:name (car name-addr) + #:email (cdr name-addr) + #:timestamp (mu:msg: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)))) + 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 )) + "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)))) + (if (not xc) ;; no existing contact with this email address? + (hash-set! c-hash (email nc) nc) ;; store the new contact. + ;; otherwise: + (begin + ;; 1) update the frequency for the existing contact + (set! (frequency xc) (1+ (frequency xc))) + ;; 2) update the name if the new one is not empty and its timestamp is newer + ;; in that case, also update the timestamp + (if (and (name nc) (> (string-length (name nc))) + (> (timestamp nc) (timestamp xc))) + (set! (name xc) (name nc)) + (set! (timestamp xc) (timestamp nc))) + ;; 3) update last-seen with timestamp, if x's timestamp is newer + (if (> (timestamp nc) (last-seen xc)) + (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))))) diff --git a/guile/mu/Makefile.am b/guile/mu/Makefile.am index 6f04e1b4..be519cd2 100644 --- a/guile/mu/Makefile.am +++ b/guile/mu/Makefile.am @@ -20,10 +20,7 @@ moduledir=$(GUILE_SITEDIR)/mu module_DATA= \ msg.scm \ - log.scm \ - store.scm \ - stats.scm \ - contacts.scm + contact.scm EXTRA_DIST= \ README diff --git a/guile/mu/store.scm b/guile/mu/contact.scm similarity index 57% rename from guile/mu/store.scm rename to guile/mu/contact.scm index 01b024ef..cd7c74ff 100644 --- a/guile/mu/store.scm +++ b/guile/mu/contact.scm @@ -15,11 +15,21 @@ ;; 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. -(use-modules (mu log)) -(use-modules (mu msg)) -(define-module (mu store) - :use-module (mu log) - :use-module (mu msg)) +;; some guile/scheme functions to get various statistics of my mu +;; message store. -(load-extension "libguile-mu" "mu_guile_store_init") +(define-module (mu contact) + :use-module (oop goops) + :export ( ;; classes + + ;; contact methods + name email timestamp frequency last-seen + )) + +(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) + (last-seen #:init-value 0 #:accessor last-seen) + (freq #:init-value 1 #:accessor frequency)) diff --git a/guile/mu/contacts.scm b/guile/mu/contacts.scm deleted file mode 100644 index 99906888..00000000 --- a/guile/mu/contacts.scm +++ /dev/null @@ -1,114 +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. - -;; some guile/scheme functions to get various statistics of my mu -;; message store. - -(use-modules (ice-9 optargs) (ice-9 popen)) - -(define-module (mu contacts) - :use-module (mu log) - :use-module (mu store) - :use-module (mu msg) - :use-module (ice-9 format) - :use-module (srfi srfi-1) - :export - (mu:contacts:list - mu:contacts:convert - mu:contacts:export)) - -(define (mu:contacts:hash) - "Create a hash of all the contacts (name . email) in the store. Each entry looks like - email-address => #( )." - (let ((contacts-hash (make-hash-table 2048))) ;; the contacts hash - (mu:store:for-each - (lambda (msg) - (for-each - (lambda (contact) - (let* ((tstamp (mu:msg:date msg)) - ;; the contact we just found - (name (car contact)) - (email (cadr contact)) - ;; the contact found in the hash - (entry (hash-ref contacts-hash email)) - (hash-name (and entry (vector-ref entry 0))) - (hash-freq (and entry (vector-ref entry 1))) - (hash-tstamp (and entry (vector-ref entry 2))) - ;; we don't use last-seen yet - (last-seen (if (and hash-tstamp (> hash-tstamp tstamp)) - hash-tstamp - tstamp))) - (if (not entry) - (hash-set! contacts-hash email (vector name 1 tstamp)) - ;; we replace the name field if either: - ;; 1) the timestamp is newer and the name is non-empty, or - ;; 2) the current name is empty - (if (and (> tstamp hash-tstamp) name (> (string-length name) 0)) - (hash-set! contacts-hash email (vector name (1+ hash-freq) tstamp)) - ;; otherwise, only update the freq, and possibly the last-seen - (hash-set! contacts-hash email - (vector hash-name (1+ hash-freq) hash-tstamp)))))) - (append (mu:msg:to msg) (mu:msg:from msg) (mu:msg:cc msg) (mu:msg:bcc msg)))) - "") - contacts-hash)) - -(define* (mu:contacts:list #:optional (sortfunc #f)) - "Get an unsorted list of contacts (each of which is a contact-vector -#( ). If SORTFUNC is provided, sort the -list using SORT-FUNC. SORT-FUNC takes as arguments two contact-vectors -and returns #t if the first one is smaller than the second one." - (let* ((lst (hash-map->list - (lambda (email vec) - (vector email - (vector-ref vec 0) - (vector-ref vec 1) - (vector-ref vec 2))) - (mu:contacts:hash))) - (lst (if (not sortfunc) - lst - (sort lst sortfunc)))) - lst)) - -(define (mu:contacts:convert contact format) - "Convert a contact vector CONTACT into FORMAT, where format is a -symbol, either 'org-contact, 'mutt-alias, 'bbdb, 'wl, or 'plain." - (let* ( (email (vector-ref contact 0)) - (name (or (vector-ref contact 1) email)) - (freq (vector-ref contact 2)) - (tstamp (vector-ref contact 3)) - (nick (email))) ;; FIXME - (case format - ('mutt-alias - (format #f "alias ~a ~a <~a>\n" nick name email)) - ('org-contact - (format #f "* ~a\n:PROPERTIES:\n:EMAIL:~a\n:NICK:~a\n:END:\n\n" - name nick email)) - ('wl ;; wanderlust - (format #f "~a \"~a\" \"~a\"\n" email nick name)) - ('plain - (format #f "~a <~a>\n" name email)) - (else (error "unsupported format ~s" format))))) - -(define* (mu:contacts:export format #:optional (sortfunc #f) (maxnum #f)) - "Write contacts to standard output, optionally sorted with SORTFUNC and optionally only the first MAXNUM entries." - (let* ((clist (mu:contacts:list sortfunc)) - (clist (if maxnum (take clist maxnum) clist))) - (for-each - (lambda (contact) - (mu:contacts:convert contact format)) - clist))) diff --git a/guile/mu/log.scm b/guile/mu/log.scm deleted file mode 100644 index 42f787eb..00000000 --- a/guile/mu/log.scm +++ /dev/null @@ -1,20 +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. -(define-module (mu log)) - -(load-extension "libguile-mu" "mu_guile_log_init") diff --git a/guile/mu/stats.scm b/guile/mu/stats.scm deleted file mode 100644 index c7d33b1a..00000000 --- a/guile/mu/stats.scm +++ /dev/null @@ -1,259 +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. - -;; some guile/scheme functions to get various statistics of my mu -;; message store. - - -(define-module (mu stats) - :use-module (ice-9 optargs) - :use-module (ice-9 popen) - :use-module (ice-9 format) - :use-module (mu log) - :use-module (mu store) - :use-module (mu msg) - :export - ( - mu:stats:count - mu:stats:average - mu:stats:average-size - mu:stats:average-recipient-number - mu:stats:frequency - mu:stats:per-weekday - mu:stats:per-month - mu:stats:per-hour - mu:stats:per-year - mu:stats:top-n - mu:stats:top-n-to - mu:stats:top-n-from - mu:stats:top-n-subject - mu:stats:table - mu:stats:histogram - mu:stats:export - mu:plot:per-month - mu:plot:per-weekday - mu:plot:per-year - mu:plot:per-hour - )) - -;; note, this is a rather inefficient way to calculate the number; for -;; demonstration purposes only... -(define* (mu:stats:count #:optional (EXPR "")) - "Count the total number of messages. If the optional EXPR is -provided, only count the messages that match it.\n" - (mu:store:for-each (lambda(msg) #f) EXPR)) - -(define* (mu:stats:average FUNC #:optional (EXPR "")) - "Count the average of the result of applying FUNC on all -messages. If the optional EXPR is provided, only consider the messages -that match it.\n" - (let* ((sum 0) - (n (mu:store:for-each - (lambda(msg) (set! sum (+ sum (FUNC msg)))) EXPR))) - (if (= n 0) 0 (exact->inexact (/ sum n))))) - -(define* (mu:stats:average-size #:optional (EXPR "")) - "Calculate the average message size. If the optional EXPR is -provided, only consider the messages that match it.\n" - (mu:stats:average (lambda(msg) (mu:msg:size msg)) EXPR)) - -(define* (mu:stats:average-recipient-number #:optional (EXPR "")) - "Calculate the average number of recipients (To: + CC: + Bcc:). If -the optional EXPR is provided, only consider the messages that match -it.\n" - (mu:stats:average (lambda(msg) - (+(length (mu:msg:to msg)) - (length (mu:msg:cc msg)) - (length (mu:msg:bcc msg)))) EXPR)) - -(define* (mu:stats: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 '())) - (mu:store:for-each - (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* (mu:stats: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 (mu:stats:frequency - (lambda (msg) (tm:wday (localtime (mu:msg:date msg)))) EXPR))) - (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of weekday - -(define* (mu:plot:per-weekday #:optional (EXPR "")) - (let* ((datafile (mu:stats:export (mu:stats:per-weekday EXPR))) - (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) - ;; note, we cannot use the weekday "%a" support in gnuplot because - ;; demands the field to be a date field ('set xdata time' etc.) - ;; for that to work, but we cannot use that since gnuplot does not - ;; support weekdays ('%w') as a date field in its input - (display (string-append - "reset\n" - "set xtics (\"Sun\" 0, \"Mon\" 1, \"Tue\" 2, \"Wed\" 3," - "\"Thu\" 4, \"Fri\" 5, \"Sat\" 6);\n" - "set xlabel \"Weekday\"\n" - "set ylabel \"# of messages\"\n" - "set boxwidth 0.9\n") gnuplot) - (display (string-append "plot \"" datafile "\" using 1:2 with boxes fs solid\n") - gnuplot) - (close-pipe gnuplot))) - - -(define* (mu:stats:per-month #:optional (EXPR "")) - "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 (mu:stats:frequency - (lambda (msg) ;; note the 1+ - (1+ (tm:mon (localtime (mu:msg:date msg))))) EXPR))) - (sort stats - (lambda(a b) - (< (car a) (car b)))))) ;; in order ofmonth - - -(define* (mu:plot:per-month #:optional (EXPR "")) - (let* ((datafile (mu:stats:export (mu:stats:per-month EXPR))) - (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) - (display (string-append - "reset\n" - "set xtics (\"Jan\" 1, \"Feb\" 2, \"Mar\" 3, \"Apr\" 4," - "\"May\" 5, \"Jun\" 6, \"Jul\" 7, \"Aug\" 8," - "\"Sep\" 9, \"Oct\" 10, \"Nov\" 11, \"Dec\" 12);\n" - "set xlabel \"Month\"\n" - "set ylabel \"# of messages\"\n" - "set boxwidth 0.9\n") gnuplot) - (display (string-append "plot \"" datafile "\" using 1:2 with boxes fs solid\n") - gnuplot) - (close-pipe gnuplot))) - - -(define* (mu:stats:per-hour #: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 (mu:stats:frequency - (lambda (msg) (tm:hour (localtime (mu:msg:date msg)))) EXPR))) - (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of hour - -(define* (mu:plot:per-hour #:optional (EXPR "")) - (let* ((datafile (mu:stats:export (mu:stats:per-hour EXPR))) - (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) - (display (string-append - "reset\n" - "set xlabel \"Hour\"\n" - "set ylabel \"# of messages\"\n" - "set boxwidth 0.9\n") gnuplot) - (display (string-append "plot \"" datafile "\" using 1:2 with boxes fs solid\n") - gnuplot) - (close-pipe gnuplot))) - - - - -(define* (mu:stats:per-year #:optional (EXPR "")) - "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 (mu:stats:frequency - (lambda (msg) (+ 1900 (tm:year (localtime (mu:msg:date msg))))) - EXPR))) - (sort stats (lambda(a b) (< (car a) (car b)))))) ;; in order of year - -(define* (mu:plot:per-year #:optional (EXPR "")) - (let* ((datafile (mu:stats:export (mu:stats:per-year EXPR))) - (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) - (display (string-append - "reset\n" - "set xlabel \"Year\"\n" - "set ylabel \"# of messages\"\n" - "set boxwidth 0.9\n") gnuplot) - (display (string-append "plot \"" datafile "\" using 1:2 with boxes fs solid\n") - gnuplot) - (close-pipe gnuplot))) - -(define* (mu:stats:top-n FUNC N #:optional (EXPR "")) - "Get the Top-N frequency of the result of FUNC applied on each -message. If the optional EXPR is provided, only consider the messages -that match it." - (let* ((freq (mu:stats:frequency FUNC EXPR)) - (top (sort freq (lambda (a b) (< (cdr b) (cdr a) ))))) - (list-head top (min (length freq) N)))) - -(define* (mu:stats:top-n-to #:optional (N 10) (EXPR "")) - "Get the Top-N To:-recipients. If the optional N is not provided, -use 10. If the optional EXPR is provided, only consider the messages -that match it." - (mu:stats:top-n - (lambda (msg) (mu:msg:to msg)) N EXPR)) - -(define* (mu:stats:top-n-from #:optional (N 10) (EXPR "")) - "Get the Top-N senders (From:). If the optional N is not provided, -use 10. If the optional EXPR is provided, only consider the messages -that match it." - (mu:stats:top-n - (lambda (msg) (mu:msg:from msg)) N EXPR)) - -(define* (mu:stats:top-n-subject #:optional (N 10) (EXPR "")) - "Get the Top-N subjects. If the optional N is not provided, -use 10. If the optional EXPR is provided, only consider the messages -that match it." - (mu:stats:top-n - (lambda (msg) (mu:msg:subject msg)) N EXPR)) - -(define* (mu:stats:table pairs #:optional (port (current-output-port))) - "Display a list of PAIRS in a table-like fashion." - (let ((maxlen 0)) - (for-each ;; find the widest in the first col - (lambda (pair) - (set! maxlen - (max maxlen (string-length (format #f "~s " (car pair)))))) pairs) - (for-each - (lambda (pair) - (let ((first (format #f "~s" (car pair))) - (second (format #f "~s" (cdr pair)))) - (display (format #f "~A~v_~A\n" - first (- maxlen (string-length first)) second) port))) - pairs))) - -;; (define* (mu:stats:histogram pairs #:optional (port (current-output-port))) -;; "Display a histogram of the list of cons pairs; the car of each pair -;; is used for the x-asxis, while the cdr represents the y value." -;; (let ((pairs ;; pairs may be unsorted, so let's sort first -;; (sort (pairs) (lambda(x1 x2) (< x1 x2))))) - -(define (mu:stats:export pairs) - "Export PAIRS to a temporary file, return its name. The data can -then be used in, e.g., R and gnuplot." - (let* ((datafile (tmpnam)) - (output (open datafile (logior O_CREAT O_WRONLY) #O0644))) - (mu:stats:table pairs output) - (close output) - datafile))