mu-scm: add full-message support (body/header)

Implement support for "header" and "body" procedures, with require loading the
message file from disk, and create a foreign object for the message.

We keep those alive in a vector, and hook up a finalizer.

Update docs & tests as well.
This commit is contained in:
Dirk-Jan C. Binnema
2025-06-21 11:53:18 +03:00
parent 812d78be49
commit ca46c09ccb
11 changed files with 303 additions and 124 deletions

View File

@ -20,7 +20,7 @@ lib_mu_scm=static_library(
'mu-scm',
[
'mu-scm.cc',
'mu-scm-contact.cc',
'mu-scm-message.cc',
'mu-scm-store.cc'
],
dependencies: [

View File

@ -1,36 +0,0 @@
/*
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
**
** This program is free software; you can redistribute it and/or modify it
** under the terms of the GNU General Public License as published by the
** Free Software Foundation; either version 3, or (at your option) any
** later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software Foundation,
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
**
*/
#include "mu-scm-contact.hh"
using namespace Mu::Scm;
SCM
Mu::Scm::to_scm(const Contact& contact)
{
static SCM email{scm_from_utf8_symbol("email")};
static SCM name{scm_from_utf8_symbol("name")};
SCM alist = scm_acons(email, to_scm(contact.email), SCM_EOL);
if (!contact.name.empty())
alist = scm_acons(name, to_scm(contact.name), alist);
return alist;
}

145
scm/mu-scm-message.cc Normal file
View File

@ -0,0 +1,145 @@
/*
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
**
** This program is free software; you can redistribute it and/or modify it
** under the terms of the GNU General Public License as published by the
** Free Software Foundation; either version 3, or (at your option) any
** later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software Foundation,
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
**
*/
#include "mu-scm-types.hh"
#include "message/mu-message.hh"
#include <mutex>
using namespace Mu;
using namespace Mu::Scm;
namespace {
static SCM message_type;
static bool initialized;
std::mutex map_lock;
constexpr auto max_message_map_size{512};
struct MessageObject {
const Message message;
SCM foreign_object{};
};
using MessageMap = std::unordered_map<std::string, MessageObject>;
static MessageMap message_map;
}
static const Message&
to_message(SCM scm)
{
scm_assert_foreign_object_type(message_type, scm);
return *reinterpret_cast<Message*>(scm_foreign_object_ref(scm, 0));
}
static void
finalize_message(SCM scm)
{
std::unique_lock lock{map_lock};
const auto msg = reinterpret_cast<const Message*>(scm_foreign_object_ref(scm, 0));
//mu_debug("finalizing message @ {}", msg->path());
if (const auto n = message_map.erase(msg->path()); n != 1)
mu_warning("huh?! deleted {}", n);
}
static SCM
subr_message_object_make(SCM message_path_scm)
{
// message objects eat fds, tickle the gc... letting it handle it
// automatically is not soon enough.
if (message_map.size() >= 0.8 * max_message_map_size)
scm_gc();
std::unique_lock lock{map_lock};
// qttempt to give an good error message rather then getting something
// from GMime)
if (message_map.size() >= max_message_map_size)
raise_error("failure", "message-object",
"too many open messages");
// if we already have the message in our map, return it.
auto path{from_scm<std::string>(message_path_scm)};
if (const auto it = message_map.find(path); it != message_map.end())
return it->second.foreign_object;
// don't have it yet; attempt to create one
if (auto res{Message::make_from_path(path)}; !res) {
raise_error("failure", "message-object",
"failed to create message from {}: {}", path, res.error());
return SCM_BOOL_F;
} else {
// create a new object, store it in our map and return the foreign ptr.
auto it = message_map.emplace(std::move(path), std::move(*res));
return it.first->second.foreign_object = scm_make_foreign_object_1(
message_type, const_cast<Message*>(&it.first->second.message));
}
}
static SCM
subr_message_body(SCM message_scm, SCM html_scm)
{
const auto& message{to_message(message_scm)};
const auto html{from_scm<bool>(html_scm)};
if (const auto body{html ? message.body_html() : message.body_text()}; body)
return to_scm(*body);
else
return SCM_BOOL_F;
}
static SCM
subr_message_header(SCM message_scm, SCM field_scm)
{
const auto& message{to_message(message_scm)};
const auto field{from_scm<std::string>(field_scm)};
if (const auto val{message.header(field)}; val)
return to_scm(*val);
else
return SCM_BOOL_F;
}
static void
init_subrs()
{
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wcast-function-type"
scm_c_define_gsubr("message-object-make", 1/*req*/, 0/*opt*/, 0/*rst*/,
reinterpret_cast<scm_t_subr>(subr_message_object_make));
scm_c_define_gsubr("message-body", 2/*req*/, 0/*opt*/, 0/*rst*/,
reinterpret_cast<scm_t_subr>(subr_message_body));
scm_c_define_gsubr("message-header",2/*req*/, 0/*opt*/, 0/*rst*/,
reinterpret_cast<scm_t_subr>(subr_message_header));
#pragma GCC diagnostic pop
}
void
Mu::Scm::init_message()
{
if (initialized)
return;
message_type = scm_make_foreign_object_type(
make_symbol("message"),
scm_list_1(make_symbol("data")),
finalize_message);
init_subrs();
initialized = true;
}

View File

@ -17,8 +17,7 @@
**
*/
#include "mu-scm-store.hh"
#include "mu-scm-contact.hh"
#include "mu-scm-types.hh"
using namespace Mu;
using namespace Mu::Scm;
@ -154,3 +153,17 @@ Mu::Scm::init_store(const Store& store)
initialized = true;
}
SCM
Mu::Scm::to_scm(const Contact& contact)
{
static SCM email{scm_from_utf8_symbol("email")};
static SCM name{scm_from_utf8_symbol("name")};
SCM alist = scm_acons(email, to_scm(contact.email), SCM_EOL);
if (!contact.name.empty())
alist = scm_acons(name, to_scm(contact.name), alist);
return alist;
}

View File

@ -1,30 +0,0 @@
/*
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
**
** This program is free software; you can redistribute it and/or modify it
** under the terms of the GNU General Public License as published by the
** Free Software Foundation; either version 3, or (at your option) any
** later version.
**
** This program is distributed in the hope that it will be useful,
** but WITHOUT ANY WARRANTY; without even the implied warranty of
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
** GNU General Public License for more details.
**
** You should have received a copy of the GNU General Public License
** along with this program; if not, write to the Free Software Foundation,
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
**
*/
#ifndef MU_SCM_STORE_HH
#define MU_SCM_STORE_HH
#include "lib/mu-store.hh"
#include "mu-scm.hh"
namespace Mu::Scm {
void init_store(const Mu::Store& store);
} // Mu::Scm
#endif /*MU_SCM_STORE_HH*/

View File

@ -54,6 +54,22 @@
(test-end "test-mfind"))
(define (test-message-full)
(test-begin "test-message-full")
(let ((msg (cadr (mfind ""))))
(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-misc)
(let ((opts (options)))
(test-assert (>= (length opts) 4))
@ -79,6 +95,7 @@
(test-basic)
(test-basic-mfind)
(test-mfind)
(test-message-full)
(test-misc)
(test-helpers)

View File

@ -17,13 +17,30 @@
**
*/
#ifndef MU_SCM_CONTACT_HH
#define MU_SCM_CONTACT_HH
#ifndef MU_SCM_TYPES_HH
#define MU_SCM_TYPES_HH
#include "lib/mu-store.hh"
#include "message/mu-contact.hh"
#include "mu-scm.hh"
namespace Mu::Scm {
/**
* Initialize SCM/Store support.
*
* @param store a store
*/
void init_store(const Mu::Store& store);
/**
* Initialize SCM/Message support.
*
* @param store a store
*/
void init_message();
/**
* Convert a Contact to an SCM
*
@ -35,4 +52,4 @@ SCM to_scm(const Contact& contact);
} // Mu::Scm
#endif /*MU_SCM_CONTACT_HH*/
#endif /*MU_SCM_TYPES_HH*/

View File

@ -25,8 +25,7 @@
#include "mu-utils.hh"
#include "config.h"
#include "mu-scm-contact.hh"
#include "mu-scm-store.hh"
#include "mu-scm-types.hh"
using namespace Mu;
using namespace Mu::Scm;
@ -62,6 +61,7 @@ init_module_mu(void* _data)
{
init_options(config->options);
init_store(config->store);
init_message();
}
static const Result<std::string>

View File

@ -61,6 +61,7 @@ namespace Mu::Scm {
*/
Result<void> run(const Config& conf);
/**
* Helpers
*
@ -225,18 +226,4 @@ namespace Mu::Scm {
/**@}*/
}
/**
* SCM formatter, for use with fmt
*
* @param scm some object
*
* @return string representation of scm
*/
// static inline std::string format_as(SCM scm) {
// return Mu::Scm::from_scm<std::string>(scm_object_to_string(scm, SCM_UNSPECIFIED));
// }
// XXX doesn't work:
// "static assertion failed: Formatting of non-void pointers is disallowed"
#endif /*MU_SCM_HH*/

View File

@ -68,6 +68,10 @@
cc
bcc
;; message-body
body
header
;; misc
options
@ -120,14 +124,30 @@ If not found, return #f."
;; Message
;;
;; A <message> is created from a message plist.
;; A <message> has two slots:
;; plist --> this is the message sexp cached in the database;
;; for each message (for mu4e, but we reuse here)
;; object--> wraps a Mu::Message* as a "foreign object"
;;
;; generally the plist is a bit cheaper, since the mu-message
;; captures a file-deescriptor.
;; In mu, we have store a plist sexp for each message in the database,
;; for use with mu4e. But, that very plist is useful here as well.
(define-class <message> ()
(plist #:init-keyword #:plist #:getter plist))
(plist #:init-value #f #:init-keyword #:plist)
(object #:init-value #f #:init-keyword #:object))
;; using the plist as-is makes for O(n) access to the various fields
(define-method (plist (message <message>))
"Get the PLIST for this MESSAGE."
(slot-ref message 'plist))
(define-method (object (message <message>))
"Get the foreign object for this MESSAGE.
If MESSAGE does not have such an object yet, crate it from the
path of the message."
(if (not (slot-ref message 'object))
(slot-set! message 'object
(message-object-make (path message))))
(slot-ref message 'object))
(define-method (find-field (message <message>) field)
(plist-find (plist message) field))
@ -200,7 +220,7 @@ Return #f otherwise."
(find-field message ':flags))
(define-method (flag? (message <message>) flag)
"Does MESSAGE have FLAG?."
"Does MESSAGE have FLAG?"
(let ((flags
(find-field message ':flags)))
(if flags
@ -289,6 +309,18 @@ not found."
#f if not found."
(find-contact-field message ':bcc))
(define* (body message #:key (html? #f))
"Get the MESSAGE body or #f if not found.
If #:html is non-#f, instead search for the HTML body.
Requires the full message."
(message-body (object message) html?))
(define-method (header (message <message>) (field <string>))
"Get the raw MESSAGE header FIELD or #f if not found.
FIELD is case-insensitive and should not have the ':' suffix.
Requires the full message."
(message-header (object message) field))
;; Store
;;
;; Note: we have a %default-store, which is the store we opened during
@ -322,7 +354,7 @@ not found."
(max-results #f))
"Find messages matching some query.
The query is mandatory, the other (keyword) arguments are optional.
The query is mandatory, the other (keyword) arguments are optional.
(mfind QUERY
#:store %default-store. Leave at default.
#:related? include related messages? Default: false

View File

@ -68,13 +68,13 @@ like emacs-lisp, @emph{Racket}, Common Lisp.
@t{mu-scm} is replacing the older @t{mu-guile} bindings; some notable
differences are:
@itemize
@item No separate 'module', instead use mu itself.
@item No separate 'module', instead use mu itself:
This greatly reduces the number of 'moving parts' and mysterious errors for users
@item Automatically set up a reasonable environment
@item Automatically set up a reasonable environment:
@t{mu scm} simply reuses the user's @t{mu} configuration, simplifying setup
@item API improvements
@item API improvements:
@t{mu-scm} has learned from @t{mu-guile} to make its APIs nicer to use
@item However, some parts are missing...
@item However, some parts are still missing:
@t{mu-scm} does not yet support all that @t{mu-guile} did. It's just getting
started.
@end itemize
@ -87,7 +87,7 @@ now, and APIs can still change without warning.
* Getting started::
* Shell::
* Scripts::
* API Reference::
* API Reference with examples::
Appendices
* GNU Free Documentation License:: The license of this manual.
@ -244,8 +244,8 @@ running script /home/user/myscript.scm and arguments ("some" "args" "123")
Quite likely, your output will differ from the above.
@node API Reference
@chapter API Reference
@node API Reference with examples
@chapter API Reference with examples
This chapter goes through the @t{mu-scm} API. For this, we need to understand a
few key concepts, represented in some GOOP objects and other data-structures:
@ -253,9 +253,9 @@ few key concepts, represented in some GOOP objects and other data-structures:
@itemize
@item the @t{<store>} represents the mu database with information about messages
@item from the store, you can find @t{<message>} objects, each of which represent a specific message
I.e., what you get from @code{mu find}
(similar to what you get from @code{mu find})
@item the store also exposes tha contacts in the store as alists (``association lists'')
I.e., the information from @code{mu cfind}
(similar to what you get from @code{mu cfind})
@end itemize
@menu
@ -289,16 +289,16 @@ Perform a query for messages in the store, and return a list of message objects
(@xref{Message}) for the matches.
@itemize
@item @t{query} is a Mu query; see @t{mu-query} man-page for details
@item @t{#:related?} (optional) whether @emph{related} messages should be included
@item @var{query} is a Mu query; see the @t{mu-query} man-page for details
@item @var{#:related?} whether @emph{related} messages should be included.
This is similar to the @t{--include-related} parameter for @command{mu find}
@item @t{#:skip-dups?} (optional) whether to exclude duplicate messages
@item @var{#:skip-dups?} whether to exclude duplicate messages
This is similar to the @t{--skip-dups} parameter for @command{mu find}
@item @t{#:sort-field} (optional) a symbol, the message field to sort by
@item @var{#:sort-field} a symbol, the message field to sort by
You can sort by the fields (see @command{mu info fields} that have a @t{value=yes})
@item @t{#:reverse?} (optional) whether to reverse the sort-direction (make it descending)
@item @t{#:max-results} (optional) the maximum number of results
By default, @emph{all} matches are returned
@item @var{#:reverse?} whether to reverse the sort-direction (make it descending)
@item @var{#:max-results} the maximum number of results
By default @emph{all} matches are returned
@end itemize
@t{mfind} mimics the @command{mu find} command-line command.
@ -318,17 +318,17 @@ e-mail address as its value, and possibly a @t{name} key with the contact's
name. In the future, other fields may be added.
@itemize
@item @t{pattern} is a basic case-insensitive PCRE-compatible regular expression
@item @var{pattern} is a basic case-insensitive PCRE-compatible regular expression
see the @t{pcre(3)} man-page for details
@item @t{#:personal} (optional) if true, only match @emph{personal} contacts
@item @var{#:personal?} if true, only match @emph{personal} contacts
A personal contact is a contact seen in message where ``you'' were an explicit
sender or recipient, thus excluding mailing-list. Personal addresses are those
that were specified at store creation time - see the @t{mu-init} man-page, in
particular the @t{--personal-address} parameter
@item @t{#:after} (optional) only include contacts last-seen after some time-point
@item @var{#:after} only include contacts last-seen after some time-point
Specified as the number of seconds since epoch. Helper-function
@code{iso-date->time-t} can be useful here.
@item @t{#:max-results} (optional) the maximum number of results
@item @var{#:max-results} (optional) the maximum number of results
By default, @emph{all} matches are returned
@end itemize
@ -358,12 +358,19 @@ A message represents the information about some e-mail message whose information
has been extracted and store in the @t{mu} store (database).
You can retrieve lists of @t{<message>} objects with @t{mfind} method, as
explained in @xref{Store}. In the following, we use some message-object
@t{msg}, e.g.
explained in @xref{Store}. In the following, we use some message-object @t{msg},
e.g.
@lisp
(define msg (car (mfind "hello")))
l(define msg (car (mfind "hello")))
@end lisp
@anchor{full-message} Many of the procedures below use the internal
representation of the message from the database; this re-uses the same
information that @t{mu4e} uses. However, that is not sufficient for all:
@code{body} and @code{header} need the full message. To get this, it needs to
open the message file from the file-system. Much of this is internal to
@t{mu-scm}, except that full-method-procedures are relatively a bit slower.
@subsection Basics
@deffn {Scheme Procedure} subject message
@ -422,6 +429,14 @@ For example:
=> 2025-06-16T09:00:31
@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.
If @var{#:html?} is non-@t{#f}, get the HTML-body instead.
This requires the @ref{full-message,,full message}.
@subsection Contacts
Message fields @t{To:}, @t{From:}, @t{Cc:} and @t{Bcc:} contain @emph{contacts}.
@ -540,7 +555,7 @@ Is this a personal message? Returns @t{#t} or @t{#f}.
@deffn {Scheme Procedure} calendar? message
@end deffn
Does this message have a calendar invitation? Returns @t{#t} or @t{#f}.
Does this message include a calendar invitation? Returns @t{#t} or @t{#f}.
@subsection Miscellaneous
@ -558,7 +573,7 @@ For example:
@deffn {Scheme Procedure} priority message
@end deffn
Get the message's priority. This is 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.
For example:
@ -590,6 +605,25 @@ For example:
=> en
@end lisp
@deffn {Scheme Procedure} header message
@end deffn
Get some arbitrary, raw header from the message.
The @var{header} parameter is a case-insensitive string @emph{without} the colon
(@t{:}).
This requires the @ref{full-message,,full message}.
For example:
@lisp
(header msg "subject")
=> "Re: Musical chairs"
(header msg "From")
=> "\"Raul Endymion\" <raul@@example.com>"
(header msg "Something")
=> #f
@end lisp
@c @deffn {Scheme Procedure} sexp message
@c @end deffn
@c Get the message's s-expression.
@ -619,14 +653,14 @@ scm}. Values at @t{#f} indicate that the value is at its default.
@deffn {Scheme Procedure} iso-date->time-t iso-date
@end deffn
Convert some ISO-8601 compatible time-point (assuming UTC) to a
seconds-since-epoch @t{time_t} value. The ISO date is expected to be in the
@t{strftime}-format @t{%F%T}, or any prefix thereof. Non-numerical characters
are ignored.
seconds-since-epoch @t{time_t} value. @var{iso-date} is expected to be in the
@t{strftime}-format @t{%F%T}, or a prefix thereof. Non-numerical characters are
ignored.
@deffn {Scheme Procedure} time-t->iso-date time-t
@end deffn
Convert a @t{time_t} value to an ISO-8601 compatible string (assuming UTC). If
@t{time_t} is @t{#f}, return an empty string of the same length.
@var{time_t} is @t{#f}, return an empty string of the same length.
@node GNU Free Documentation License
@appendix GNU Free Documentation License