mu-scm: implement message->alist

Implement message->alist; i.e. to convert the mu4e-style plist into an idiomatic
alist. Add it as a message slot, initializing it lazily.

Update the message accessors to use the alist.

Add tests, docs.
This commit is contained in:
Dirk-Jan C. Binnema
2025-07-10 20:27:59 +03:00
parent d24d87336a
commit 1b3199a552
3 changed files with 67 additions and 58 deletions

View File

@ -82,13 +82,21 @@
(references msg)) (references msg))
(test-equal "439C1136.90504@euler.org" (thread-id msg))) (test-equal "439C1136.90504@euler.org" (thread-id msg)))
(let ((msg (car (mfind "subject:\"gcc include search order\"")))) (let* ((msg (car (mfind "subject:\"gcc include search order\"")))
(alist (message->alist msg)))
(test-equal "gcc include search order" (subject msg)) (test-equal "gcc include search order" (subject msg))
(test-equal "klub" (header msg "precedence")) (test-equal "klub" (header msg "precedence"))
(test-equal "gcc-help.gcc.gnu.org" (mailing-list msg)) (test-equal "gcc-help.gcc.gnu.org" (mailing-list msg))
(test-equal #f (references msg)) (test-equal #f (references msg))
(test-equal "3BE9E6535E3029448670913581E7A1A20D852173@emss35m06.us.lmco.com" (message-id msg)) (test-equal "3BE9E6535E3029448670913581E7A1A20D852173@emss35m06.us.lmco.com" (message-id msg))
(test-equal "3BE9E6535E3029448670913581E7A1A20D852173@emss35m06.us.lmco.com" (thread-id msg))) (test-equal "3BE9E6535E3029448670913581E7A1A20D852173@emss35m06.us.lmco.com" (thread-id msg))
;; alist
(test-equal "gcc include search order" (assoc-ref alist 'subject))
(test-equal 'normal (assoc-ref alist 'priority))
(test-equal '((email . "anon@example.com") (name . "Mickey Mouse"))
(car (assoc-ref alist 'from))))
(test-end "test-message-more")) (test-end "test-message-more"))

View File

@ -35,8 +35,10 @@
<message> <message>
make-message make-message
message->alist
date date
last-change changed
message-id message-id
path path
@ -108,9 +110,7 @@
(define (set-documentation! symbol docstring) (define (set-documentation! symbol docstring)
"Set the docstring for symbol in current module to docstring. "Set the docstring for symbol in current module to docstring.
This is useful for symbols that do not support docstrings directly, such This is useful for symbols that do not support docstrings directly, such
add as (define foo 123)."
(define foo 123)
"
;; https://git.wolfsden.cz/guile-wolfsden/tree/wolfsden/documentation.scm ;; https://git.wolfsden.cz/guile-wolfsden/tree/wolfsden/documentation.scm
(set-object-property! (module-ref (current-module) symbol) (set-object-property! (module-ref (current-module) symbol)
'documentation docstring)) 'documentation docstring))
@ -144,15 +144,29 @@ If not found, return #f."
(string->symbol (string-drop name 1)) (string->symbol (string-drop name 1))
sym))) sym)))
(define (emacs-time->epoch-secs lst)
"Convert emacs-style timestamp LST to a number of seconds since epoch.
If LST is #f, return #f."
(if lst
(+ (ash (car lst) 16) (cadr lst))
#f))
(define (plist->alist plist) (define (plist->alist plist)
"Convert a plist into an alist." "Convert a plist into an alist.
This is specific for message plists."
(let ((alist '())) (let ((alist '()))
(plist-for-each (plist-for-each
(lambda (k v) (lambda (k v)
(let ((key (decolonize-symbol k)))
(set! alist (set! alist
(append! alist (append! alist
(list (cons (decolonize-symbol k) (list (cons key
v))))) (cond
((member key '(from to cc bcc))
(map plist->alist v))
((member key '(date changed))
(emacs-time->epoch-secs v))
(else v))))))))
plist) plist)
alist)) alist))
@ -260,6 +274,12 @@ Only having a plist is cheaper.")
(slot-set! message 'plist (cc-message-plist (cc-message message)))) (slot-set! message 'plist (cc-message-plist (cc-message message))))
(slot-ref message 'plist)) (slot-ref message 'plist))
(define-method (message->alist (message <message>))
"Get an association-list (alist) representation for MESSAGE."
(when (not (slot-ref message 'alist))
(slot-set! message 'alist (plist->alist (plist message))))
(slot-ref message 'alist))
(define-method (cc-message (message <message>)) (define-method (cc-message (message <message>))
"Get the foreign object for this MESSAGE. "Get the foreign object for this MESSAGE.
If MESSAGE does not have such an object yet, create it from the If MESSAGE does not have such an object yet, create it from the
@ -268,9 +288,6 @@ path of the message."
(slot-set! message 'cc-message (cc-message-make (path message)))) (slot-set! message 'cc-message (cc-message-make (path message))))
(slot-ref message 'cc-message)) (slot-ref message 'cc-message))
(define-method (find-field (message <message>) field)
(plist-find (plist message) field))
(define-method (sexp (message <message>)) (define-method (sexp (message <message>))
"Get the s-expression (plist) for this MESSAGE. "Get the s-expression (plist) for this MESSAGE.
@ -278,51 +295,44 @@ This is an internal data-structure, originally for use with mu4e, but useful
here as well. However, the precise details are not part of mu-scm API." here as well. However, the precise details are not part of mu-scm API."
(plist message)) (plist message))
(define (emacs-time->epoch-secs lst)
"Convert emacs-style timestamp LST to a number of seconds since epoch.
If LST is #f, return #f."
(if lst
(+ (ash (car lst) 16) (cadr lst))
#f))
;; Accessors for the fields ;; Accessors for the fields
(define-method (subject (message <message>)) (define-method (subject (message <message>))
"Get the subject for MESSAGE or #f if not found." "Get the subject for MESSAGE or #f if not found."
(find-field message ':subject)) (assoc-ref (message->alist message) 'subject))
(define-method (maildir (message <message>)) (define-method (maildir (message <message>))
"Get the maildir for MESSAGE or #f if not found." "Get the maildir for MESSAGE or #f if not found."
(find-field message ':maildir)) (assoc-ref (message->alist message) 'maildir))
(define-method (message-id (message <message>)) (define-method (message-id (message <message>))
"Get the message-id for MESSAGE or #f if not found." "Get the message-id for MESSAGE or #f if not found."
(find-field message ':message-id)) (assoc-ref (message->alist message) 'message-id))
(define-method (date (message <message>)) (define-method (date (message <message>))
"Get the date for MESSAGE was sent. "Get the timestamp for MESSAGE was sent.
This is the number of seconds since epoch; #f if not found." This is the number of seconds since epoch; #f if not found."
(emacs-time->epoch-secs (find-field message ':date))) (assoc-ref (message->alist message) 'date))
(define-method (last-change (message <message>)) (define-method (changed (message <message>))
"Get the date for the last change to MESSAGE. "Get the timestamp for the last change to MESSAGE.
This is the number of seconds since epoch; #f if not found." This is the number of seconds since epoch; #f if not found."
(emacs-time->epoch-secs (find-field message ':changed))) (assoc-ref (message->alist message) 'changed))
(define-method (path (message <message>)) (define-method (path (message <message>))
"Get the file-system path for MESSAGE. "Get the file-system path for MESSAGE.
A symbol, either 'high, 'low or 'normal, or #f if not found." A symbol, either 'high, 'low or 'normal, or #f if not found."
(find-field message ':path)) (assoc-ref (message->alist message) 'path))
(define-method (priority (message <message>)) (define-method (priority (message <message>))
"Get the priority for MESSAGE. "Get the priority for MESSAGE.
A symbol, either 'high, 'low or 'normal, or #f if not found." A symbol, either 'high, 'low or 'normal, or #f if not found."
(find-field message ':priority)) (assoc-ref (message->alist message) 'priority))
(define-method (language (message <message>)) (define-method (language (message <message>))
"Get the ISO-639-1 language code for the MESSAGE as a symbol, if detected. "Get the ISO-639-1 language code for the MESSAGE as a symbol, if detected.
Return #f otherwise." Return #f otherwise."
(let ((lang (find-field message ':language))) (let ((lang ( (assoc-ref (message->alist message) 'language))))
(if lang (if lang
(string->symbol lang) (string->symbol lang)
#f))) #f)))
@ -330,7 +340,7 @@ Return #f otherwise."
(define-method (size (message <message>)) (define-method (size (message <message>))
"Get the size of the MESSAGE in bytes or #f if not available." "Get the size of the MESSAGE in bytes or #f if not available."
(find-field message ':size)) (assoc-ref (message->alist message) 'size))
(define-method (references (message <message>)) (define-method (references (message <message>))
"Get the list of reference of MESSAGE or #f if not available. "Get the list of reference of MESSAGE or #f if not available.
@ -338,7 +348,7 @@ Return #f otherwise."
reference (message-id) will appear at most once, duplicates and reference (message-id) will appear at most once, duplicates and
fake-message-id (see impls) are filtered out. If there are no references, return fake-message-id (see impls) are filtered out. If there are no references, return
#f." #f."
(find-field message ':references)) (assoc-ref (message->alist message) 'references))
(define-method (thread-id (message <message>)) (define-method (thread-id (message <message>))
"Get the oldest (first) reference for MESSAGE, or message-id if there are none. "Get the oldest (first) reference for MESSAGE, or message-id if there are none.
@ -351,20 +361,19 @@ This is method is useful to determine the thread a message is in."
(define-method (mailing-list (message <message>)) (define-method (mailing-list (message <message>))
"Get the mailing-list id for MESSAGE or #f if not available." "Get the mailing-list id for MESSAGE or #f if not available."
(find-field message ':list)) (assoc-ref (message->alist message) 'list))
;; Flags. ;; Flags.
(define-method (flags (message <message>)) (define-method (flags (message <message>))
"Get the size of the MESSAGE in bytes or #f if not available." "Get the size of the MESSAGE in bytes or #f if not available."
(find-field message ':flags)) (assoc-ref (message->alist message) 'flags))
(define-method (flag? (message <message>) flag) (define-method (flag? (message <message>) flag)
"Does MESSAGE have FLAG?" "Does MESSAGE have FLAG?"
(let ((flags (let ((flgs (flags message)))
(find-field message ':flags))) (if flgs
(if flags (if (member flag flgs) #t #f)
(if (member flag flags) #t #f)
#f))) #f)))
(define-method (draft? (message <message>)) (define-method (draft? (message <message>))
@ -423,31 +432,23 @@ This is method is useful to determine the thread a message is in."
"Does MESSAGE have a calender invitation?" "Does MESSAGE have a calender invitation?"
(flag? message 'calendar)) (flag? message 'calendar))
(define-method (find-contact-field (message <message>) field)
"Get contact FIELD from MESSAGE as an alist.
Helper method "
(let ((cs (find-field message field)))
(if cs
(map plist->alist cs)
#f)))
(define-method (from (message <message>)) (define-method (from (message <message>))
"Get the sender (the From: field) for MESSAGE or #f if not found." "Get the sender (the From: field) for MESSAGE or #f if not found."
(find-contact-field message ':from)) (assoc-ref (message->alist message) 'from))
(define-method (to (message <message>)) (define-method (to (message <message>))
"Get the (intended) recipient for MESSAGE (the To: field) or #f if not found." "Get the (intended) recipient for MESSAGE (the To: field) or #f if not found."
(find-contact-field message ':to)) (assoc-ref (message->alist message) 'to))
(define-method (cc (message <message>)) (define-method (cc (message <message>))
"Get the (intended) carbon-copy recipient for MESSAGE (the Cc: field) or #f if "Get the (intended) carbon-copy recipient for MESSAGE (the Cc: field) or #f if
not found." not found."
(find-contact-field message ':cc)) (assoc-ref (message->alist message) 'cc))
(define-method (bcc (message <message>)) (define-method (bcc (message <message>))
"Get the (intended) blind carbon-copy recipient for MESSAGE (the Bcc: field) or "Get the (intended) blind carbon-copy recipient for MESSAGE (the Bcc: field) or
#f if not found." #f if not found."
(find-contact-field message ':bcc)) (assoc-ref (message->alist message) 'bcc))
(define* (body message #:key (html? #f)) (define* (body message #:key (html? #f))
"Get the MESSAGE body or #f if not found "Get the MESSAGE body or #f if not found

View File

@ -658,13 +658,13 @@ Is this a personal message? Returns @t{#t} or @t{#f}.
@deffn {Scheme Procedure} calendar? message @deffn {Scheme Procedure} calendar? message
@end deffn @end deffn
Does this message include a calendar invitation? Returns @t{#t} or @t{#f}. Does this message include a calendar invitation? Returns @t{#t} or @code{#f}.
@subsection Miscellaneous @subsection Miscellaneous
@deffn {Scheme Procedure} last-change message @deffn {Scheme Procedure} changed message
@end deffn @end deffn
Get the time of the message's last change (through @t{mu}), or @t{#f} if there Get the time of the message's last change (through @t{mu}), or @code{#f} if there
is none. The time is expressed the data as the number of seconds since epoch, is none. The time is expressed the data as the number of seconds since epoch,
@t{time_t}. @t{time_t}.
@ -677,7 +677,7 @@ For example:
@deffn {Scheme Procedure} priority message @deffn {Scheme Procedure} priority message
@end deffn @end deffn
Get the message's priority. This is a symbol, either @t{high}, @t{normal} or Get the message's priority. This is a symbol, either @t{high}, @t{normal} or
@t{low}, or @t{#f} if not present. @t{low}, or @code{#f} if not present.
For example: For example:
@lisp @lisp
@ -697,7 +697,7 @@ For example:
@deffn {Scheme Procedure} language message @deffn {Scheme Procedure} language message
@end deffn @end deffn
Get the ISO-639-1 language code for message's primary language or @t{#f} if not Get the ISO-639-1 language code for message's primary language or @code{#f} if not
found. This is available only if @t{mu} was built with CLD2 support, see found. This is available only if @t{mu} was built with CLD2 support, see
@command{mu info}. The language code is represented as a symbol, such as @t{en}, @command{mu info}. The language code is represented as a symbol, such as @t{en},
@t{nl} or @t{fi}. @t{nl} or @t{fi}.
@ -833,7 +833,7 @@ Convert a @t{time_t} value (``seconds-since-epoch'') to a string. The optional
output format, while the @code{#:utc?} determines whether to use UTC. output format, while the @code{#:utc?} determines whether to use UTC.
@c Defaults are determined by the @code{%preferences} variable. @c Defaults are determined by the @code{%preferences} variable.
If @var{time_t} is @t{#f}, return @code{#f}. If @var{time_t} is @code{#f}, return @code{#f}.
@node GNU Free Documentation License @node GNU Free Documentation License
@appendix GNU Free Documentation License @appendix GNU Free Documentation License