scm: add utc-offset and date-object methods

Add methods for getting the utc-offset of message, and get the sent-date
as an SRFI-19 date object.
This commit is contained in:
Dirk-Jan C. Binnema
2026-07-27 23:55:25 +03:00
committed by Seth Ladygo
parent 0bea84adce
commit bb57f7a226
4 changed files with 57 additions and 8 deletions

View File

@ -1,6 +1,7 @@
;; unit tests
(use-modules (mu) (srfi srfi-64)
(srfi srfi-19)
(ice-9 textual-ports))
(define (test-store)
@ -60,10 +61,19 @@
(define (test-mfind)
(test-begin "test-mfind")
(let ((msg (car (mfind "to:a@example.com" #:sort-field 'date #:reverse? #t))))
(test-equal "test with multi to and cc" (subject msg) )
(let* ((msg (car (mfind "to:a@example.com" #:sort-field 'date #:reverse? #t)))
(dateobj (date-object msg)))
(test-equal "test with multi to and cc" (subject msg))
(test-equal "2016-05-15 16:57:25"
(time->string (date msg) #:format "%F %T" #:utc? #t)))
(time->string (date msg) #:format "%F %T" #:utc? #t))
(test-equal -7200 (utc-offset msg))
(test-equal 2016 (date-year dateobj))
(test-equal 5 (date-month dateobj))
(test-equal 15 (date-day dateobj))
(test-equal 14 (date-hour dateobj))
(test-equal 57 (date-minute dateobj))
(test-equal 25 (date-second dateobj))
(test-equal 0 (date-nanosecond dateobj)))
(test-end "test-mfind"))
(define (test-message-full)
@ -73,13 +83,11 @@
(test-equal "Motörhead" (header msg "Subject"))
(test-equal "Mü <testmu@testmu.xx>" (header msg "From"))
(test-equal #f (header msg "Bla"))
(test-equal (string-append "\nTest for issue #38, where apparently searching for "
"accented words in subject,\nto etc. fails.\n\n"
"What about here? Queensrÿche. Mötley Crüe.\n\n\n")
(body msg))
(test-equal #f (body msg #:html? #t))
(test-end "test-message-full")))
(define (test-message-more)
@ -107,7 +115,6 @@
(test-equal 'normal (assoc-ref alist 'priority))
(test-equal '((email . "anon@example.com") (name . "Mickey Mouse"))
(car (assoc-ref alist 'from)))
;; language
(test-equal (language msg)
(if (assoc-ref (configuration) 'language-enabled?) 'en #f))

View File

@ -21,6 +21,7 @@
:use-module (system foreign)
:use-module (rnrs bytevectors)
:use-module (srfi srfi-1) ;; lists
:use-module (srfi srfi-19) ;; date/time
:use-module (ice-9 optargs)
:use-module (ice-9 format)
:use-module (ice-9 binary-ports)
@ -40,6 +41,9 @@
message->alist
date
date-object
utc-offset
changed
message-id
@ -214,7 +218,6 @@ CONTENT-ONLY? is implied to be #t."
Either the 'filename' field in the mime-part and if that does not exist, use
'mime-part-<index>' with <index> being the number of the mime-part.")
(define* (make-output-file mime-part #:key (path #f) (overwrite? #f))
"Create a port for the file to write MIME-PART to.
@ -331,6 +334,21 @@ path of the message."
This is the number of seconds since epoch; #f if not found."
(assoc-ref (message->alist message) 'date))
(define-method (utc-offset (message <message>))
"Get the UTC offset in seconds for this MESSAGE.
I.e., the offset from the UTC for the time the message was sent.
#f if not available."
(assoc-ref (message->alist message) 'utc-offset))
(define-method (date-object (message <message>))
"Get an SRFI-19 date object for MESSAGE's sent date.
This includes the date and the timezone (if known). #f if not found."
(let ((unix-time (date message)) (offset (utc-offset message)))
(if unix-time
(time-utc->date (make-time 'time-utc 0 unix-time)
(or offset 0))
#f)))
(define-method (changed (message <message>))
"Get the timestamp for the last change to MESSAGE.
This is the number of seconds since epoch; #f if not found."
@ -661,7 +679,7 @@ If FIELD does not exist, return #f."
"Alist with user-preferences.
- short-date: a strftime-compatibie string for the display
format of short dates.
- utc? : whether to assume use UTC for dates/times")
- utc? : whether to assume UTC for dates/times")
(define (value-or-preference val key)
"If VAL is the symbol 'preference, return the value for KEY from %preferences.

View File

@ -613,6 +613,24 @@ For example:
=> 2025-06-16T09:00:31
@end lisp
@deffn {Scheme Procedure} date-object message
@end deffn
Get the message's @t{Date} field (the sent-date) in the form of an SRFI-19
date-object, or @t{#f} if there is none.
@deffn {Scheme Procedure} utc-offset message
@end deffn
Get the message's time-zone offset in seconds; negative for west of GMT,
positive for east of GMT, or @t{#f} if there is none.
For example:
@lisp
(date-object msg)
=> #<date nanosecond: 0 second: 25 minute: 57 hour: 14 day: 15 month: 5 year: 2016 zone-offset: -7200>
(utc-offset msg)
=> -7200
@end lisp
@deffn {Scheme Procedure} body message [#:html? #f]
@end deffn
Get the message body as a string, or return @code{#f} if not found.