mirror of https://github.com/djcb/mu.git
* updated the guile modules
This commit is contained in:
parent
ddb68cdea9
commit
e620a32ee7
|
@ -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")))))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))
|
|
||||||
|
|
|
@ -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)."
|
||||||
|
|
Loading…
Reference in New Issue