mirror of https://github.com/djcb/mu.git
* updated the guile modules
This commit is contained in:
djcb
parent
ddb68cdea9
commit
e620a32ee7
|
|
@ -23,40 +23,42 @@
|
|||
:use-module (oop goops)
|
||||
:use-module (mu message)
|
||||
:export (
|
||||
<mu-contact>
|
||||
name email
|
||||
<mu:contact>
|
||||
mu:name
|
||||
mu:email
|
||||
mu:contact->string
|
||||
;;
|
||||
mu:for-each-contact
|
||||
;;
|
||||
contacts
|
||||
mu:contacts
|
||||
;;
|
||||
<mu-contact-with-stats>
|
||||
frequency last-seen
|
||||
<mu:contact-with-stats>
|
||||
mu:frequency
|
||||
mu:last-seen
|
||||
))
|
||||
|
||||
(define-class <mu-contact> ()
|
||||
(name #:init-value #f #:accessor name #:init-keyword #:name)
|
||||
(email #:init-value #f #:accessor email #:init-keyword #:email))
|
||||
(define-class <mu:contact> ()
|
||||
(name #:init-value #f #:accessor mu:name #:init-keyword #:name)
|
||||
(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>,
|
||||
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)))
|
||||
(make <mu:contact> #:name (car pair) #:email (cdr pair)))
|
||||
(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>
|
||||
objects."
|
||||
(contacts msg #t))
|
||||
(mu: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-class <mu:contact-with-stats> (<mu:contact>)
|
||||
(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 <mu-contact> instance
|
||||
|
|
@ -67,34 +69,61 @@ matching EXPR."
|
|||
(lambda (msg)
|
||||
(for-each
|
||||
(lambda (ct)
|
||||
(let ((ct-ws (make <mu-contact-with-stats>
|
||||
#:name (name ct)
|
||||
#:email (email ct)
|
||||
#:timestamp (date msg))))
|
||||
(let ((ct-ws (make <mu:contact-with-stats>
|
||||
#: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 <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."
|
||||
;; 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 <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")))))
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@
|
|||
(define-module (mu message)
|
||||
:use-module (oop goops)
|
||||
:export ( ;; classes
|
||||
<mu-message>
|
||||
<mu:message>
|
||||
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 <mu-message> ()
|
||||
(define-class <mu:message> ()
|
||||
(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 <mu-message>))
|
||||
(define-method (method-name (msg <mu:message>))
|
||||
(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 <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))
|
||||
|
||||
(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 <mu-message> #:msg msg)))
|
||||
(func (make <mu:message> #:msg msg)))
|
||||
expr))
|
||||
|
||||
(define* (mu:message-list #:optional (expr #t))
|
||||
|
|
|
|||
|
|
@ -22,30 +22,29 @@
|
|||
:use-module (mu message)
|
||||
:export (;; get-part
|
||||
;; classes
|
||||
<mu-part>
|
||||
<mu:part>
|
||||
;; message function
|
||||
attachments
|
||||
parts
|
||||
;; <mu-part> methods
|
||||
index
|
||||
name
|
||||
mime-type
|
||||
mu:attachments
|
||||
mu:parts
|
||||
;; <mu:part> methods
|
||||
mu:name
|
||||
mu:mime-type
|
||||
;; size
|
||||
save
|
||||
save-as))
|
||||
mu:save
|
||||
mu:save-as))
|
||||
|
||||
(define-class <mu-part> ()
|
||||
(define-class <mu:part> ()
|
||||
(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 <mu-message>) (files-only <boolean>))
|
||||
"Get the part for MSG as a list of <mu-part> objects; if FILES-ONLY is #t,
|
||||
(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,
|
||||
only get the part with file names."
|
||||
(map (lambda (part)
|
||||
(make <mu-part>
|
||||
(make <mu:part>
|
||||
#: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 <mu-message>))
|
||||
"Get the attachments for MSG as a list of <mu-part> objects."
|
||||
(define-method (mu:attachments (msg <mu:message>))
|
||||
"Get the attachments for MSG as a list of <mu:part> objects."
|
||||
(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-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
|
||||
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 <mu-part>) (filepath <string>))
|
||||
(define-method (mu:save-as (part <mu:part>) (filepath <string>))
|
||||
"Save message-part PART to file system path PATH."
|
||||
(copy-file (save part) filepath))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)."
|
||||
|
|
|
|||
Loading…
Reference in New Issue