From e620a32ee7f12372c894b4d84db37eacbf63c239 Mon Sep 17 00:00:00 2001 From: djcb Date: Sun, 15 Jan 2012 14:32:34 +0200 Subject: [PATCH] * updated the guile modules --- guile/mu/contact.scm | 95 +++++++++++++++++++++++++++++--------------- guile/mu/message.scm | 79 ++++++++++++++++++------------------ guile/mu/part.scm | 41 ++++++++++--------- guile/mu/plot.scm | 19 +++------ guile/mu/stats.scm | 4 +- 5 files changed, 129 insertions(+), 109 deletions(-) diff --git a/guile/mu/contact.scm b/guile/mu/contact.scm index 30ca1267..a75fbc3f 100644 --- a/guile/mu/contact.scm +++ b/guile/mu/contact.scm @@ -23,40 +23,42 @@ :use-module (oop goops) :use-module (mu message) :export ( - - name email + + mu:name + mu:email + mu:contact->string ;; mu:for-each-contact ;; - contacts + mu:contacts ;; - - frequency last-seen + + mu:frequency + mu:last-seen )) -(define-class () - (name #:init-value #f #:accessor name #:init-keyword #:name) - (email #:init-value #f #:accessor email #:init-keyword #:email)) +(define-class () + (name #:init-value #f #:accessor mu:name #:init-keyword #:name) + (email #:init-value #f #:accessor mu:email #:init-keyword #:email)) -(define-method (contacts (msg ) contact-type) +(define-method (mu:contacts (msg ) contact-type) "Get all contacts for MSG of the given CONTACT-TYPE. MSG is of type , 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 objects." (map (lambda (pair) ;; a pair (na . addr) - (make #:name (car pair) #:email (cdr pair))) + (make #:name (car pair) #:email (cdr pair))) (mu:get-contacts (slot-ref msg 'msg) contact-type))) -(define-method (contacts (msg )) +(define-method (mu:contacts (msg )) "Get contacts of all types for message MSG as a list of objects." - (contacts msg #t)) + (mu:contacts msg #t)) - -(define-class () - (tstamp #:init-value 0 #:accessor timestamp #:init-keyword #:timestamp) - (last-seen #:init-value 0 #:accessor last-seen) - (freq #:init-value 1 #:accessor frequency)) +(define-class () + (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 instance @@ -67,34 +69,61 @@ matching EXPR." (lambda (msg) (for-each (lambda (ct) - (let ((ct-ws (make - #:name (name ct) - #:email (email ct) - #:timestamp (date msg)))) + (let ((ct-ws (make + #:name (mu:name ct) + #:email (mu:email ct) + #:timestamp (mu:date msg)))) (update-contacts-hash c-hash ct-ws))) - (contacts msg #t))) + (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 )) +(define-method (update-contacts-hash c-hash (nc )) "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)))) + (let ((xc (hash-ref c-hash (mu:email nc)))) (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: (begin ;; 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 ;; in that case, also update the timestamp - (if (and (name nc) (> (string-length (name nc))) - (> (timestamp nc) (timestamp xc))) - (set! (name xc) (name nc)) - (set! (timestamp xc) (timestamp nc))) + (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 (> (timestamp nc) (last-seen xc)) - (set! (last-seen xc) (timestamp nc))) + (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 (email xc) xc))))) + (hash-set! c-hash (mu:email xc) xc))))) + +(define-method (mu:contact->string (contact ) (form )) + "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"))))) diff --git a/guile/mu/message.scm b/guile/mu/message.scm index 5d573286..efceb534 100644 --- a/guile/mu/message.scm +++ b/guile/mu/message.scm @@ -19,7 +19,7 @@ (define-module (mu message) :use-module (oop goops) :export ( ;; classes - + mu:for-each-message mu:message-list ;; internal @@ -27,58 +27,59 @@ mu:get-field mu:for-each-msg-internal ;; message funcs - body header ;; other symbols - mu:bcc - mu:body-html - mu:body-txt - mu:cc - mu:date - mu:flags - mu:from - mu:maildir - mu:message-id - mu:path - mu:prio - mu:refs - mu:size - mu:subject - mu:tags - mu:to)) + 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:to)) (load-extension "libguile-mu" "mu_guile_message_init") -(define-class () +(define-class () (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 )) + (define-method (method-name (msg )) (mu:get-field (slot-ref msg 'msg) field)) (export method-name))))) -(define-getter bcc mu:bcc) -(define-getter body-html mu:body-html) -(define-getter body-txt mu:body-txt) -(define-getter cc mu:cc) -(define-getter date mu:date) -(define-getter flags mu:flags) -(define-getter from mu:from) -(define-getter maildir mu:maildir) -(define-getter message-id mu:message-id) -(define-getter path mu:path) -(define-getter priority mu:prio) -(define-getter references mu:refs) -(define-getter size mu:size) -(define-getter subject mu:subject) -(define-getter tags mu:tags) -(define-getter to mu:to) +(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:to mu:field:to) -(define-method (header (msg ) (hdr )) - "Get an arbitrary header HDR from message MSG." + +(define-method (header (msg ) (hdr )) + "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)) @@ -86,7 +87,7 @@ If EXPR is not provided, match /all/ messages in the store." (mu:for-each-msg-internal (lambda (msg) - (func (make #:msg msg))) + (func (make #:msg msg))) expr)) (define* (mu:message-list #:optional (expr #t)) diff --git a/guile/mu/part.scm b/guile/mu/part.scm index 686781bc..4115422b 100644 --- a/guile/mu/part.scm +++ b/guile/mu/part.scm @@ -22,30 +22,29 @@ :use-module (mu message) :export (;; get-part ;; classes - + ;; message function - attachments - parts - ;; methods - index - name - mime-type + mu:attachments + mu:parts + ;; methods + mu:name + mu:mime-type ;; size - save - save-as)) + mu:save + mu:save-as)) -(define-class () +(define-class () (msgpath #:init-value #f #:init-keyword #:msgpath) (index #:init-value #f #:init-keyword #:index) - (name #:init-value #f #:getter name #:init-keyword #:name) - (mime-type #:init-value #f #:getter mime-type #:init-keyword #:mime-type) - (size #:init-value 0 #:getter size #:init-keyword #:size)) + (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 ) (files-only )) - "Get the part for MSG as a list of objects; if FILES-ONLY is #t, +(define-method (get-parts (msg ) (files-only )) + "Get the part for MSG as a list of objects; if FILES-ONLY is #t, only get the part with file names." (map (lambda (part) - (make + (make #:msgpath (list-ref part 0) #:index (list-ref part 1) #:name (list-ref part 2) @@ -53,20 +52,20 @@ only get the part with file names." #:size (list-ref part 4))) (mu:get-parts (slot-ref msg 'msg) files-only))) -(define-method (attachments (msg )) - "Get the attachments for MSG as a list of objects." +(define-method (mu:attachments (msg )) + "Get the attachments for MSG as a list of objects." (get-parts msg #t)) -(define-method (parts (msg )) +(define-method (mu:parts (msg )) "Get the MIME-parts for MSG as a list of objects." (get-parts msg #f)) -(define-method (save (part )) +(define-method (mu:save (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 (save-as (part ) (filepath )) +(define-method (mu:save-as (part ) (filepath )) "Save message-part PART to file system path PATH." (copy-file (save part) filepath)) diff --git a/guile/mu/plot.scm b/guile/mu/plot.scm index 94f8b955..6ff6ce69 100644 --- a/guile/mu/plot.scm +++ b/guile/mu/plot.scm @@ -19,8 +19,7 @@ (define-module (mu plot) :use-module (mu message) :use-module (ice-9 popen) - :export ( mu:plot-x11 - mu:plot-ascii)) + :export ( mu:plot)) (define (export-pairs pairs) "Write a temporary file with the list of PAIRS in table format, and @@ -34,14 +33,14 @@ return the file name." (close output) datafile)) -(define (mu:plot data title x-label y-label want-ascii) - "Plot DATA with TITLE, X-LABEL and X-LABEL. If WANT-ASCII is #t, -output in plain-text; otherwise use an X11 window." +(define* (mu:plot data title x-label y-label #:optional (ascii #f)) + "Plot DATA with TITLE, X-LABEL and X-LABEL. If ASCII is true, display +using raw text, otherwise, use a graphical window." (let ((datafile (export-pairs data)) (gnuplot (open-pipe "gnuplot -p" OPEN_WRITE))) (display (string-append "reset\n" - "set term " (if want-ascii "dumb" "x11") "\n" + "set term " (if ascii "wxt" "dumb") "\n" "set title \"" title "\"\n" "set xlabel \"" x-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") 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)) diff --git a/guile/mu/stats.scm b/guile/mu/stats.scm index 8b45dd8d..838c52bb 100644 --- a/guile/mu/stats.scm +++ b/guile/mu/stats.scm @@ -23,7 +23,7 @@ :use-module (ice-9 i18n) :export ( mu:tabulate-messages mu:average-messages - mu:day-numbers->names + mu:weekday-numbers->names mu:month-numbers->names)) (define* (mu:tabulate-messages func #:optional (expr #t)) @@ -65,7 +65,7 @@ icecream: (mu:average (lambda(msg) (size msg)) \"icecream\" ." (locale-day-short num)) (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) into a list of pairs with the car replaced by the corresponding day name (abbreviated)."