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

* guile support cleanup (WIP)

This commit is contained in:
djcb 2011-12-30 12:36:59 +02:00
parent b01b70db05
commit b5e2f1c14a
16 changed files with 514 additions and 700 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
guile/Makefile.am
View File

@ -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)

56
guile/examples/contacts-export
View File

@ -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=<muhome>] "
"usage: contacts-export [--help] [--muhome=<muhome>] "
"--format=<org-contacts|wl|mutt-ab|plain(*)> "
"--sort-by=<freq(*)|newness> [--revert] [--limit=<n>]\n"))
"--sort-by=<frequency(*)|newness> [--revert] [--limit=<n>]\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:

216
guile/examples/msg-stats
View File

@ -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))

63
guile/mu-guile-log.c
View File

@ -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, "<write_log>");
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*

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

@ -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));
}
}

127
guile/mu-guile-store.c
View File

@ -1,127 +0,0 @@
/*
** Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
**
** This program is free software; you can redistribute it and/or modify it
** under the terms of the GNU General Public License as published by the
** Free Software Foundation; either version 3, or (at your option) any
** later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software Foundation,
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
**
*/
#include <mu-query.h>
#include <mu-store.h>
#include <mu-runtime.h>
#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 ("<internal 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 ("<internal 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;
}

39
guile/mu-guile-store.h
View File

@ -1,39 +0,0 @@
/*
** Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
**
** This program is free software; you can redistribute it and/or modify it
** under the terms of the GNU General Public License as published by the
** Free Software Foundation; either version 3, or (at your option) any
** later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software Foundation,
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
**
*/
#ifndef __MU_GUILE_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__*/

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

@ -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 : "<nameless>"),

222
guile/mu-guile.c
View File

@ -22,59 +22,237 @@
#endif /*HAVE_CONFIG_H*/
#include <mu-runtime.h>
#include <mu-store.h>
#include <mu-query.h>
#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 ("<internal 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, "<write_log>");
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*

9
guile/mu-guile.h
View File

@ -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.
*

50
guile/mu.scm
View File

@ -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 <contact> 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 <contact>
#: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 <contact>))
"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)))))

5
guile/mu/Makefile.am
View File

@ -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

22
guile/mu/store.scm → guile/mu/contact.scm
View File

@ -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>
;; contact methods
name email timestamp frequency last-seen
))
(define-class <contact> ()
(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))

114
guile/mu/contacts.scm
View File

@ -1,114 +0,0 @@
;;
;; Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;;
;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 3, or (at your option) any
;; later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software Foundation,
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;; 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 => #(<name> <freq> <tstamp>)."
(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
#(<email> <name> <freq> <tstamp>). 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)))

20
guile/mu/log.scm
View File

@ -1,20 +0,0 @@
;;
;; Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;;
;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 3, or (at your option) any
;; later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software Foundation,
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
(define-module (mu log))
(load-extension "libguile-mu" "mu_guile_log_init")

259
guile/mu/stats.scm
View File

@ -1,259 +0,0 @@
;;
;; Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;;
;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 3, or (at your option) any
;; later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software Foundation,
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;; 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))