* guile: updates for contact.scm, message.scm

This commit is contained in:
djcb 2012-01-09 08:20:43 +02:00
parent 261e9dff28
commit ba3448fe30
2 changed files with 35 additions and 23 deletions

View File

@ -22,22 +22,41 @@
(define-module (mu contact)
:use-module (oop goops)
:use-module (mu message)
:export ( ;; classes
:export (
<mu-contact>
;; global methods
name email
;;
mu:for-each-contact
;; contact methods
name email timestamp frequency last-seen
;;
contacts
;;
<mu-contact-with-stats>
frequency last-seen
))
(define-class <mu-contact> ()
(name #:init-value #f #:accessor name #:init-keyword #:name)
(email #:init-value #f #:accessor email #:init-keyword #:email)
(name #:init-value #f #:accessor name #:init-keyword #:name)
(email #:init-value #f #:accessor email #:init-keyword #:email))
(define-method (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 (contacts (msg <mu-message>))
"Get contacts of all types for message MSG as a list of <mu-contact>
objects."
(contacts msg #t))
(define-class <mu-contact-with-stats> (<mu-contact>)
(tstamp #:init-value 0 #:accessor timestamp #:init-keyword #:timestamp)
(last-seen #:init-value 0 #:accessor last-seen)
(freq #:init-value 1 #:accessor 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
@ -46,19 +65,18 @@ matching EXPR."
(mu:for-each-message
(lambda (msg)
(for-each
(lambda (name-addr)
(let ((contact (make <mu-contact>
#:name (car name-addr)
#:email (cdr name-addr)
#:timestamp (date msg))))
(update-contacts-hash c-hash contact)))
(lambda (ct)
(let ((ct-ws (make <mu-contact-with-stats>
#:name (name ct)
#:email (email ct)
#:timestamp (date msg))))
(update-contacts-hash c-hash ct-ws)))
(contacts msg #t)))
expr)
;; c-hash now contains a map of email->contact
(hash-for-each
(lambda (email contact) (proc contact)) c-hash)))
(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>))
(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 (email nc))))

View File

@ -23,14 +23,11 @@
mu:for-each-message
mu:message-list
;; internal
mu:for-each-msg-internal
mu:get-contacts
mu:get-header
mu:get-field
;; message funcs
body
header
contacts
;; other symbols
mu:bcc
mu:body-html
@ -83,9 +80,6 @@
"Get an arbitrary header HDR from message MSG."
(mu:get-header (slot-ref msg 'msg) hdr))
(define-method (contacts (msg <mu-message>) contact-type)
(mu:get-contacts (slot-ref msg 'msg) contact-type))
(define* (mu:for-each-message func #:optional (expr #t))
"Execute function FUNC for each message that matches mu search expression EXPR.
If EXPR is not provided, match /all/ messages in the store."