* 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) (define-module (mu contact)
:use-module (oop goops) :use-module (oop goops)
:use-module (mu message) :use-module (mu message)
:export ( ;; classes :export (
<mu-contact> <mu-contact>
;; global methods name email
;;
mu:for-each-contact mu:for-each-contact
;; contact methods ;;
name email timestamp frequency last-seen contacts
;;
<mu-contact-with-stats>
frequency last-seen
)) ))
(define-class <mu-contact> () (define-class <mu-contact> ()
(name #:init-value #f #:accessor name #:init-keyword #:name) (name #:init-value #f #:accessor name #:init-keyword #:name)
(email #:init-value #f #:accessor email #:init-keyword #:email) (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) (tstamp #:init-value 0 #:accessor timestamp #:init-keyword #:timestamp)
(last-seen #:init-value 0 #:accessor last-seen) (last-seen #:init-value 0 #:accessor last-seen)
(freq #:init-value 1 #:accessor frequency)) (freq #:init-value 1 #:accessor frequency))
(define* (mu:for-each-contact proc #:optional (expr #t)) (define* (mu:for-each-contact proc #:optional (expr #t))
"Execute PROC for each contact. PROC receives a <mu-contact> instance "Execute PROC for each contact. PROC receives a <mu-contact> instance
as parameter. If EXPR is specified, only consider contacts in messages as parameter. If EXPR is specified, only consider contacts in messages
@ -46,19 +65,18 @@ matching EXPR."
(mu:for-each-message (mu:for-each-message
(lambda (msg) (lambda (msg)
(for-each (for-each
(lambda (name-addr) (lambda (ct)
(let ((contact (make <mu-contact> (let ((ct-ws (make <mu-contact-with-stats>
#:name (car name-addr) #:name (name ct)
#:email (cdr name-addr) #:email (email ct)
#:timestamp (date msg)))) #:timestamp (date msg))))
(update-contacts-hash c-hash contact))) (update-contacts-hash c-hash ct-ws)))
(contacts msg #t))) (contacts msg #t)))
expr) expr)
;; c-hash now contains a map of email->contact (hash-for-each ;; c-hash now contains a map of email->contact
(hash-for-each (lambda (email ct-ws) (proc ct-ws)) c-hash)))
(lambda (email contact) (proc contact)) 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." "Update the contacts hash with a new and/or existing contact."
;; xc: existing-contact, nc: new contact ;; xc: existing-contact, nc: new contact
(let ((xc (hash-ref c-hash (email nc)))) (let ((xc (hash-ref c-hash (email nc))))

View File

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