* updated the guile modules

This commit is contained in:
djcb 2012-01-15 14:32:34 +02:00
parent ddb68cdea9
commit e620a32ee7
5 changed files with 129 additions and 109 deletions

View File

@ -23,40 +23,42 @@
:use-module (oop goops) :use-module (oop goops)
:use-module (mu message) :use-module (mu message)
:export ( :export (
<mu-contact> <mu:contact>
name email mu:name
mu:email
mu:contact->string
;; ;;
mu:for-each-contact mu:for-each-contact
;; ;;
contacts mu:contacts
;; ;;
<mu-contact-with-stats> <mu:contact-with-stats>
frequency last-seen mu:frequency
mu:last-seen
)) ))
(define-class <mu-contact> () (define-class <mu:contact> ()
(name #:init-value #f #:accessor name #:init-keyword #:name) (name #:init-value #f #:accessor mu:name #:init-keyword #:name)
(email #:init-value #f #:accessor email #:init-keyword #:email)) (email #:init-value #f #:accessor mu:email #:init-keyword #:email))
(define-method (contacts (msg <mu-message>) contact-type) (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>, "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' 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 to get the corresponding type of contacts, or #t to get all. Returns a
list of <mu-contact> objects." list of <mu-contact> objects."
(map (lambda (pair) ;; a pair (na . addr) (map (lambda (pair) ;; a pair (na . addr)
(make <mu-contact> #:name (car pair) #:email (cdr pair))) (make <mu:contact> #:name (car pair) #:email (cdr pair)))
(mu:get-contacts (slot-ref msg 'msg) contact-type))) (mu:get-contacts (slot-ref msg 'msg) contact-type)))
(define-method (contacts (msg <mu-message>)) (define-method (mu:contacts (msg <mu:message>))
"Get contacts of all types for message MSG as a list of <mu-contact> "Get contacts of all types for message MSG as a list of <mu-contact>
objects." objects."
(contacts msg #t)) (mu:contacts msg #t))
(define-class <mu:contact-with-stats> (<mu:contact>)
(define-class <mu-contact-with-stats> (<mu-contact>) (tstamp #:init-value 0 #:accessor mu:timestamp #:init-keyword #:timestamp)
(tstamp #:init-value 0 #:accessor timestamp #:init-keyword #:timestamp) (last-seen #:init-value 0 #:accessor mu:last-seen)
(last-seen #:init-value 0 #:accessor last-seen) (freq #:init-value 1 #:accessor mu: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
@ -67,34 +69,61 @@ matching EXPR."
(lambda (msg) (lambda (msg)
(for-each (for-each
(lambda (ct) (lambda (ct)
(let ((ct-ws (make <mu-contact-with-stats> (let ((ct-ws (make <mu:contact-with-stats>
#:name (name ct) #:name (mu:name ct)
#:email (email ct) #:email (mu:email ct)
#:timestamp (date msg)))) #:timestamp (mu:date msg))))
(update-contacts-hash c-hash ct-ws))) (update-contacts-hash c-hash ct-ws)))
(contacts msg #t))) (mu:contacts msg #t)))
expr) expr)
(hash-for-each ;; c-hash now contains a map of email->contact (hash-for-each ;; c-hash now contains a map of email->contact
(lambda (email ct-ws) (proc ct-ws)) c-hash))) (lambda (email ct-ws) (proc ct-ws)) c-hash)))
(define-method (update-contacts-hash c-hash (nc <mu-contact-with-stats>)) (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 (mu:email nc))))
(if (not xc) ;; no existing contact with this email address? (if (not xc) ;; no existing contact with this email address?
(hash-set! c-hash (email nc) nc) ;; store the new contact. (hash-set! c-hash (mu:email nc) nc) ;; store the new contact.
;; otherwise: ;; otherwise:
(begin (begin
;; 1) update the frequency for the existing contact ;; 1) update the frequency for the existing contact
(set! (frequency xc) (1+ (frequency xc))) (set! (mu:frequency xc) (1+ (mu:frequency xc)))
;; 2) update the name if the new one is not empty and its timestamp is newer ;; 2) update the name if the new one is not empty and its timestamp is newer
;; in that case, also update the timestamp ;; in that case, also update the timestamp
(if (and (name nc) (> (string-length (name nc))) (if (and (mu:name nc) (> (string-length (mu:name nc)))
(> (timestamp nc) (timestamp xc))) (> (mu:timestamp nc) (mu:timestamp xc)))
(set! (name xc) (name nc)) (set! (mu:name xc) (mu:name nc))
(set! (timestamp xc) (timestamp nc))) (set! (mu:timestamp xc) (mu:timestamp nc)))
;; 3) update last-seen with timestamp, if x's timestamp is newer ;; 3) update last-seen with timestamp, if x's timestamp is newer
(if (> (timestamp nc) (last-seen xc)) (if (> (mu:timestamp nc) (mu:last-seen xc))
(set! (last-seen xc) (timestamp nc))) (set! (mu:last-seen xc) (mu:timestamp nc)))
;; okay --> now xc has been updated; but it back in the hash ;; okay --> now xc has been updated; but it back in the hash
(hash-set! c-hash (email xc) xc))))) (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\" \"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" (if name 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 "")))
(else (error "Unsupported format")))))

View File

@ -19,7 +19,7 @@
(define-module (mu message) (define-module (mu message)
:use-module (oop goops) :use-module (oop goops)
:export ( ;; classes :export ( ;; classes
<mu-message> <mu:message>
mu:for-each-message mu:for-each-message
mu:message-list mu:message-list
;; internal ;; internal
@ -27,58 +27,59 @@
mu:get-field mu:get-field
mu:for-each-msg-internal mu:for-each-msg-internal
;; message funcs ;; message funcs
body
header header
;; other symbols ;; other symbols
mu:bcc mu:field:bcc
mu:body-html mu:field:body-html
mu:body-txt mu:field:body-txt
mu:cc mu:field:cc
mu:date mu:field:date
mu:flags mu:field:flags
mu:from mu:field:from
mu:maildir mu:field:maildir
mu:message-id mu:field:message-id
mu:path mu:field:path
mu:prio mu:field:prio
mu:refs mu:field:refs
mu:size mu:field:size
mu:subject mu:field:subject
mu:tags mu:field:tags
mu:to)) mu:field:to))
(load-extension "libguile-mu" "mu_guile_message_init") (load-extension "libguile-mu" "mu_guile_message_init")
(define-class <mu-message> () (define-class <mu:message> ()
(msg #:init-keyword #:msg)) ;; the MuMsg-smob we're wrapping (msg #:init-keyword #:msg)) ;; the MuMsg-smob we're wrapping
(define-syntax define-getter (define-syntax define-getter
(syntax-rules () (syntax-rules ()
((define-getter method-name field) ((define-getter method-name field)
(begin (begin
(define-method (method-name (msg <mu-message>)) (define-method (method-name (msg <mu:message>))
(mu:get-field (slot-ref msg 'msg) field)) (mu:get-field (slot-ref msg 'msg) field))
(export method-name))))) (export method-name)))))
(define-getter bcc mu:bcc) (define-getter mu:bcc mu:field:bcc)
(define-getter body-html mu:body-html) (define-getter mu:body-html mu:field:body-html)
(define-getter body-txt mu:body-txt) (define-getter mu:body-txt mu:field:body-txt)
(define-getter cc mu:cc) (define-getter mu:cc mu:field:cc)
(define-getter date mu:date) (define-getter mu:date mu:field:date)
(define-getter flags mu:flags) (define-getter mu:flags mu:field:flags)
(define-getter from mu:from) (define-getter mu:from mu:field:from)
(define-getter maildir mu:maildir) (define-getter mu:maildir mu:field:maildir)
(define-getter message-id mu:message-id) (define-getter mu:message-id mu:field:message-id)
(define-getter path mu:path) (define-getter mu:path mu:field:path)
(define-getter priority mu:prio) (define-getter mu:priority mu:field:prio)
(define-getter references mu:refs) (define-getter mu:references mu:field:refs)
(define-getter size mu:size) (define-getter mu:size mu:field:size)
(define-getter subject mu:subject) (define-getter mu:subject mu:field:subject)
(define-getter tags mu:tags) (define-getter mu:tags mu:field:tags)
(define-getter to mu:to) (define-getter mu:to mu:field:to)
(define-method (header (msg <mu-message>) (hdr <string>))
"Get an arbitrary header HDR from message MSG." (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)) (mu:get-header (slot-ref msg 'msg) hdr))
(define* (mu:for-each-message func #:optional (expr #t)) (define* (mu:for-each-message func #:optional (expr #t))
@ -86,7 +87,7 @@
If EXPR is not provided, match /all/ messages in the store." If EXPR is not provided, match /all/ messages in the store."
(mu:for-each-msg-internal (mu:for-each-msg-internal
(lambda (msg) (lambda (msg)
(func (make <mu-message> #:msg msg))) (func (make <mu:message> #:msg msg)))
expr)) expr))
(define* (mu:message-list #:optional (expr #t)) (define* (mu:message-list #:optional (expr #t))

View File

@ -22,30 +22,29 @@
:use-module (mu message) :use-module (mu message)
:export (;; get-part :export (;; get-part
;; classes ;; classes
<mu-part> <mu:part>
;; message function ;; message function
attachments mu:attachments
parts mu:parts
;; <mu-part> methods ;; <mu:part> methods
index mu:name
name mu:mime-type
mime-type
;; size ;; size
save mu:save
save-as)) mu:save-as))
(define-class <mu-part> () (define-class <mu:part> ()
(msgpath #:init-value #f #:init-keyword #:msgpath) (msgpath #:init-value #f #:init-keyword #:msgpath)
(index #:init-value #f #:init-keyword #:index) (index #:init-value #f #:init-keyword #:index)
(name #:init-value #f #:getter name #:init-keyword #:name) (name #:init-value #f #:getter mu:name #:init-keyword #:name)
(mime-type #:init-value #f #:getter mime-type #:init-keyword #:mime-type) (mime-type #:init-value #f #:getter mu:mime-type #:init-keyword #:mime-type)
(size #:init-value 0 #:getter size #:init-keyword #:size)) (size #:init-value 0 #:getter mu:size #:init-keyword #:size))
(define-method (get-parts (msg <mu-message>) (files-only <boolean>)) (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, "Get the part for MSG as a list of <mu:part> objects; if FILES-ONLY is #t,
only get the part with file names." only get the part with file names."
(map (lambda (part) (map (lambda (part)
(make <mu-part> (make <mu:part>
#:msgpath (list-ref part 0) #:msgpath (list-ref part 0)
#:index (list-ref part 1) #:index (list-ref part 1)
#:name (list-ref part 2) #:name (list-ref part 2)
@ -53,20 +52,20 @@ only get the part with file names."
#:size (list-ref part 4))) #:size (list-ref part 4)))
(mu:get-parts (slot-ref msg 'msg) files-only))) (mu:get-parts (slot-ref msg 'msg) files-only)))
(define-method (attachments (msg <mu-message>)) (define-method (mu:attachments (msg <mu:message>))
"Get the attachments for MSG as a list of <mu-part> objects." "Get the attachments for MSG as a list of <mu:part> objects."
(get-parts msg #t)) (get-parts msg #t))
(define-method (parts (msg <mu-message>)) (define-method (mu:parts (msg <mu:message>))
"Get the MIME-parts for MSG as a list of <mu-part> objects." "Get the MIME-parts for MSG as a list of <mu-part> objects."
(get-parts msg #f)) (get-parts msg #f))
(define-method (save (part <mu-part>)) (define-method (mu:save (part <mu:part>))
"Save PART to a temporary file, and return the file name. If the "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; part had a filename, the temporary file's file name will be just that;
otherwise a name is made up." otherwise a name is made up."
(mu:save-part (slot-ref part 'msgpath) (slot-ref part 'index))) (mu:save-part (slot-ref part 'msgpath) (slot-ref part 'index)))
(define-method (save-as (part <mu-part>) (filepath <string>)) (define-method (mu:save-as (part <mu:part>) (filepath <string>))
"Save message-part PART to file system path PATH." "Save message-part PART to file system path PATH."
(copy-file (save part) filepath)) (copy-file (save part) filepath))

View File

@ -19,8 +19,7 @@
(define-module (mu plot) (define-module (mu plot)
:use-module (mu message) :use-module (mu message)
:use-module (ice-9 popen) :use-module (ice-9 popen)
:export ( mu:plot-x11 :export ( mu:plot))
mu:plot-ascii))
(define (export-pairs pairs) (define (export-pairs pairs)
"Write a temporary file with the list of PAIRS in table format, and "Write a temporary file with the list of PAIRS in table format, and
@ -34,14 +33,14 @@ return the file name."
(close output) (close output)
datafile)) datafile))
(define (mu:plot data title x-label y-label want-ascii) (define* (mu:plot data title x-label y-label #:optional (ascii #f))
"Plot DATA with TITLE, X-LABEL and X-LABEL. If WANT-ASCII is #t, "Plot DATA with TITLE, X-LABEL and X-LABEL. If ASCII is true, display
output in plain-text; otherwise use an X11 window." using raw text, otherwise, use a graphical window."
(let ((datafile (export-pairs data)) (let ((datafile (export-pairs data))
(gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE)))
(display (string-append (display (string-append
"reset\n" "reset\n"
"set term " (if want-ascii "dumb" "x11") "\n" "set term " (if ascii "wxt" "dumb") "\n"
"set title \"" title "\"\n" "set title \"" title "\"\n"
"set xlabel \"" x-label "\"\n" "set xlabel \"" x-label "\"\n"
"set ylabel \"" y-label "\"\n" "set ylabel \"" y-label "\"\n"
@ -49,11 +48,3 @@ output in plain-text; otherwise use an X11 window."
"plot \"" datafile "\" using 2:xticlabels(1) with boxes fs solid\n") "plot \"" datafile "\" using 2:xticlabels(1) with boxes fs solid\n")
gnuplot) gnuplot)
(close-pipe gnuplot))) (close-pipe gnuplot)))
(define* (mu:plot-ascii data #:optional (title "Title") (x-label "X") (y-label "Y"))
"Plot DATA with TITLE, X-LABEL and X-LABEL in plain-text."
(mu:plot data title x-label y-label #t))
(define* (mu:plot-x11 data #:optional (title "Title") (x-label "X") (y-label "Y"))
"Plot DATA with TITLE, X-LABEL and X-LABEL in an X11 window."
(mu:plot data title x-label y-label #f))

View File

@ -23,7 +23,7 @@
:use-module (ice-9 i18n) :use-module (ice-9 i18n)
:export ( mu:tabulate-messages :export ( mu:tabulate-messages
mu:average-messages mu:average-messages
mu:day-numbers->names mu:weekday-numbers->names
mu:month-numbers->names)) mu:month-numbers->names))
(define* (mu:tabulate-messages func #:optional (expr #t)) (define* (mu:tabulate-messages func #:optional (expr #t))
@ -65,7 +65,7 @@ icecream: (mu:average (lambda(msg) (size msg)) \"icecream\" ."
(locale-day-short num)) (locale-day-short num))
(iota 7 1))) (iota 7 1)))
(define (mu:day-numbers->names table) (define (mu:weekday-numbers->names table)
"Convert a list of pairs with the car denoting a day number (0-6) "Convert a list of pairs with the car denoting a day number (0-6)
into a list of pairs with the car replaced by the corresponding day into a list of pairs with the car replaced by the corresponding day
name (abbreviated)." name (abbreviated)."