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

* guile: some general improvements / cleanups in module loading, object

Browse Source 
visibilty. turn some integers (such as message priority, log level, contact
  type) into symbols.
This commit is contained in:
djcb
2012-07-14 12:32:15 +03:00
parent fcb202d618
commit 8e3fbe380e
10 changed files with 576 additions and 671 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
guile/mu/Makefile.am
View File

@ -19,11 +19,6 @@ include $(top_srcdir)/gtest.mk
# FIXME: GUILE_SITEDIR would be better, but that
# breaks 'make distcheck'
scmdir=${prefix}/share/guile/site/2.0/mu/
scm_DATA= \
message.scm \
contact.scm \
part.scm \
stats.scm \
plot.scm
scm_DATA=stats.scm plot.scm
EXTRA_DIST=$(scm_DATA)

143
guile/mu/contact.scm
View File

@ -1,141 +1,4 @@
;;
;; Copyright (C) 2011 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;;
;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 3, or (at your option) any
;; later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
(define-module (mu contact))
(display "(mu contact) is deprecated, please remove from (use-modules ...)")
(newline)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software Foundation,
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;; some guile/scheme functions to get various statistics of my mu
;; message store.
(define-module (mu contact)
:use-module (oop goops)
:use-module (mu message)
:use-module (texinfo string-utils)
:export (
<mu:contact>
mu:name
mu:email
mu:contact->string
;;
mu:for-each-contact
;;
mu:contacts
;;
<mu:contact-with-stats>
mu:frequency
mu:last-seen
))
(define-class <mu:contact> ()
(name #:init-value #f #:accessor mu:name #:init-keyword #:name)
(email #:init-value #f #:accessor mu:email #:init-keyword #:email))
(define-method (mu:contacts (msg <mu:message>) contact-type)
"Get all contacts for MSG of the given CONTACT-TYPE. MSG is of type <mu-message>,
while contact type is either `mu:to', `mu:cc', `mu:from' or `mu:bcc'
to get the corresponding type of contacts, or #t to get all. Returns a
list of <mu-contact> objects."
(map (lambda (pair) ;; a pair (na . addr)
(make <mu:contact> #:name (car pair) #:email (cdr pair)))
(mu:get-contacts (slot-ref msg 'msg) contact-type)))
(define-method (mu:contacts (msg <mu:message>))
"Get contacts of all types for message MSG as a list of <mu-contact>
objects."
(mu:contacts msg #t))
(define-class <mu:contact-with-stats> (<mu:contact>)
(tstamp #:init-value 0 #:accessor mu:timestamp #:init-keyword #:timestamp)
(last-seen #:init-value 0 #:accessor mu:last-seen)
(freq #:init-value 1 #:accessor mu:frequency))
(define* (mu:for-each-contact proc #:optional (expr #t))
"Execute PROC for each contact. PROC receives a <mu-contact> instance
as parameter. If EXPR is specified, only consider contacts in messages
matching EXPR."
(let ((c-hash (make-hash-table 4096)))
(mu:for-each-message
(lambda (msg)
(for-each
(lambda (ct)
(let ((ct-ws (make <mu:contact-with-stats>
#:name (mu:name ct)
#:email (mu:email ct)
#:timestamp (mu:date msg))))
(update-contacts-hash c-hash ct-ws)))
(mu:contacts msg #t)))
expr)
(hash-for-each ;; c-hash now contains a map of email->contact
(lambda (email ct-ws) (proc ct-ws)) c-hash)))
(define-method (update-contacts-hash c-hash (nc <mu:contact-with-stats>))
"Update the contacts hash with a new and/or existing contact."
;; xc: existing-contact, nc: new contact
(let ((xc (hash-ref c-hash (mu:email nc))))
(if (not xc) ;; no existing contact with this email address?
(hash-set! c-hash (mu:email nc) nc) ;; store the new contact.
;; otherwise:
(begin
;; 1) update the frequency for the existing contact
(set! (mu:frequency xc) (1+ (mu:frequency xc)))
;; 2) update the name if the new one is not empty and its timestamp is newer
;; in that case, also update the timestamp
(if (and (mu:name nc) (> (string-length (mu:name nc)))
(> (mu:timestamp nc) (mu:timestamp xc)))
(set! (mu:name xc) (mu:name nc))
(set! (mu:timestamp xc) (mu:timestamp nc)))
;; 3) update last-seen with timestamp, if x's timestamp is newer
(if (> (mu:timestamp nc) (mu:last-seen xc))
(set! (mu:last-seen xc) (mu:timestamp nc)))
;; okay --> now xc has been updated; but it back in the hash
(hash-set! c-hash (mu:email xc) xc)))))
(define-method (mu:contact->string (contact <mu:contact>) (form <string>))
"Convert a contact to a string in format FORM, which is a string,
either \"org-contact\", \"mutt-alias\", \"mutt-ab\",
\"wanderlust\", \"quoted\" \"plain\"."
(let* ((name (mu:name contact)) (email (mu:email contact))
(nick ;; simplistic nick guessing...
(string-map
(lambda(kar)
(if (char-alphabetic? kar) kar #\_))
(string-downcase (or name email)))))
(cond
((string= form "plain")
(format #f "~a~a~a" (or name "") (if name " " "") email))
((string= form "org-contact")
(format #f "* ~s\n:PROPERTIES:\n:EMAIL:~a\n:NICK:~a\n:END:"
(or name email) email nick))
((string= form "wanderlust")
(format #f "~a ~s ~s"
nick (or name email) email))
((string= form "mutt-alias")
(format #f "alias ~a ~a <~a>"
nick (or name email) email))
((string= form "mutt-ab")
(format #f "~a\t~a\t"
email (or name "")))
((string= form "quoted")
(string-append
"\""
(escape-special-chars
(string-append
(if name
(format #f "\"~a\" " name)
"")
(format #f "<~a>" email))
"\"" #\\)
"\""))
(else (error "Unsupported format")))))

109
guile/mu/message.scm
View File

@ -1,107 +1,4 @@
;;
;; Copyright (C) 2011-2012 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;;
;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 3, or (at your option) any
;; later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
(define-module (mu message))
(display "(mu message) is deprecated, please remove from (use-modules ...)")
(newline)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software Foundation,
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
(define-module (mu message)
:use-module (oop goops)
:export ( ;; classes
<mu:message>
mu:for-each-message
mu:message-list
;; internal
mu:get-header
mu:get-field
mu:for-each-msg-internal
;; message funcs
header
;; other symbols
mu:field:bcc
mu:field:body-html
mu:field:body-txt
mu:field:cc
mu:field:date
mu:field:flags
mu:field:from
mu:field:maildir
mu:field:message-id
mu:field:path
mu:field:prio
mu:field:refs
mu:field:size
mu:field:subject
mu:field:tags
mu:field:timestamp
mu:field:to))
(load-extension "libguile-mu" "mu_guile_message_init")
(define-class <mu:message> ()
(msg #:init-keyword #:msg)) ;; the MuMsg-smob we're wrapping
(define-syntax define-getter
(syntax-rules ()
((define-getter method-name field)
(begin
(define-method (method-name (msg <mu:message>))
(mu:get-field (slot-ref msg 'msg) field))
(export method-name)))))
(define-getter mu:bcc mu:field:bcc)
(define-getter mu:body-html mu:field:body-html)
(define-getter mu:body-txt mu:field:body-txt)
(define-getter mu:cc mu:field:cc)
(define-getter mu:date mu:field:date)
(define-getter mu:flags mu:field:flags)
(define-getter mu:from mu:field:from)
(define-getter mu:maildir mu:field:maildir)
(define-getter mu:message-id mu:field:message-id)
(define-getter mu:path mu:field:path)
(define-getter mu:priority mu:field:prio)
(define-getter mu:references mu:field:refs)
(define-getter mu:size mu:field:size)
(define-getter mu:subject mu:field:subject)
(define-getter mu:tags mu:field:tags)
(define-getter mu:timestamp mu:field:timestamp)
(define-getter mu:to mu:field:to)
(define-method (header (msg <mu:message>) (hdr <string>))
"Get an arbitrary header HDR from message MSG; return #f if it does
not exist."
(mu:get-header (slot-ref msg 'msg) hdr))
(define* (mu:for-each-message func #:optional (expr #t) (maxresults -1))
"Execute function FUNC for each message that matches mu search expression EXPR.
If EXPR is not provided, match /all/ messages in the store. MAXRESULTS
specifies the maximum of messages to return, or -1 (the default) for
no limit."
(mu:for-each-msg-internal
(lambda (msg)
(func (make <mu:message> #:msg msg)))
expr
maxresults))
(define* (mu:message-list #:optional (expr #t) (maxresults -1))
"Return a list of all messages matching mu search expression
EXPR. If EXPR is not provided, return a list of /all/ messages in the
store. MAXRESULTS specifies the maximum of messages to return, or
-1 (the default) for no limit."
(let ((lst '()))
(mu:for-each-message
(lambda (m)
(set! lst (append! lst (list m)))) expr maxresults)
lst))

73
guile/mu/part.scm
View File

@ -1,71 +1,4 @@
;;
;; Copyright (C) 2011-2012 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
;;
;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
;; Free Software Foundation; either version 3, or (at your option) any
;; later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
(define-module (mu part))
(display "(mu part) is deprecated, please remove from (use-modules ...)")
(newline)
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software Foundation,
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
(define-module (mu part)
:use-module (oop goops)
:use-module (mu)
:use-module (mu message)
:export (;; get-part
;; classes
<mu:part>
;; message function
mu:attachments
mu:parts
;; <mu:part> methods
mu:name
mu:mime-type
;; size
mu:save
mu:save-as))
(define-class <mu:part> ()
(msgpath #:init-value #f #:init-keyword #:msgpath)
(index #:init-value #f #:init-keyword #:index)
(name #:init-value #f #:getter mu:name #:init-keyword #:name)
(mime-type #:init-value #f #:getter mu:mime-type #:init-keyword #:mime-type)
(size #:init-value 0 #:getter mu:size #:init-keyword #:size))
(define-method (get-parts (msg <mu:message>) (files-only <boolean>))
"Get the part for MSG as a list of <mu:part> objects; if FILES-ONLY is #t,
only get the part with file names."
(map (lambda (part)
(make <mu:part>
#:msgpath (list-ref part 0)
#:index (list-ref part 1)
#:name (list-ref part 2)
#:mime-type (list-ref part 3)
#:size (list-ref part 4)))
(mu:get-parts (slot-ref msg 'msg) files-only)))
(define-method (mu:attachments (msg <mu:message>))
"Get the attachments for MSG as a list of <mu:part> objects."
(get-parts msg #t))
(define-method (mu:parts (msg <mu:message>))
"Get the MIME-parts for MSG as a list of <mu-part> objects."
(get-parts msg #f))
(define-method (mu:save (part <mu:part>))
"Save PART to a temporary file, and return the file name. If the
part had a filename, the temporary file's file name will be just that;
otherwise a name is made up."
(mu:save-part (slot-ref part 'msgpath) (slot-ref part 'index)))
(define-method (mu:save-as (part <mu:part>) (filepath <string>))
"Save message-part PART to file system path PATH."
(copy-file (save part) filepath))

25
guile/mu/stats.scm
View File

@ -24,7 +24,8 @@
:use-module (ice-9 r5rs)
:export ( mu:tabulate
mu:average
mu:stddev
mu:standard-deviation
mu:pearsons-r
mu:weekday-numbers->names
mu:month-numbers->names))
@ -45,7 +46,7 @@ get back a list like
(set! table (assoc-set! table val (1+ old-freq)))))
expr)
table))
(define (average lst)
"Calculate the average of a list LST of numbers, or #f if undefined."
(if (null? lst)
@ -67,12 +68,11 @@ undefined."
EXPR (or #t for all). Returns #f if undefined."
(average (map func (mu:message-list expr))))
(define* (mu:stddev func #:optional (expr #t))
(define* (mu:standard-deviation func #:optional (expr #t))
"Get the standard deviation for the the values of FUNC applied to
all messages matching EXPR (or #t for all). Returns #f if undefined."
(stddev (map func (mu:message-list expr))))
(define* (mu:max func #:optional (expr #t))
"Get the maximum value of FUNC applied to all messages matching
EXPR (or #t for all). Returns #f if undefined."
@ -83,6 +83,23 @@ EXPR (or #t for all). Returns #f if undefined."
EXPR (or #t for all). Returns #f if undefined."
(apply min (map func (mu:message-list expr))))
(define* (mu:pearsons-r func1 func2 #:optional (expr #t))
"Calculate Pearson's product-moment correlation coefficient between
func1 and func2. Inefficient implementation."
(let* ((msglist (mu:message-list expr))
(lst-x (map func1 msglist))
(lst-y (map func2 msglist))
(avg-x (average lst-x))
(avg-y (average lst-y))
(denominator (sqrt (* (stddev lst-x) (stddev lst-y))))
(n (length lst-x))
(cov-xy 0))
(while (not (null? lst-x))
(set! cov-xy (+ (* (- (car lst-x) avg-x) (- (car lst-y) avg-y))))
(set! lst-x (cdr lst-x))
(set! lst-y (cdr lst-y)))
(/ (/ cov-xy n) denominator)))
;; a list of abbreviated, localized day names
(define day-names