* guile: updates for contact.scm, message.scm
This commit is contained in:
@ -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))))
|
||||||
|
|||||||
@ -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."
|
||||||
|
|||||||
Reference in New Issue
Block a user