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.

scm/meson.build

@@ -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: [

scm/mu-scm-contact.cc

@@ -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;
-}

scm/mu-scm-message.cc

@@ -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;
+}

scm/mu-scm-store.cc

@@ -17,8 +17,7 @@
 **
 */
 
-#include "mu-scm-store.hh"
+#include "mu-scm-types.hh"
-#include "mu-scm-contact.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;
+}

scm/mu-scm-store.hh

@@ -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*/

scm/mu-scm-test.scm

@@ -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)
 

scm/mu-scm-types.hh

@@ -17,13 +17,30 @@
 **
 */
 
-#ifndef MU_SCM_CONTACT_HH
+#ifndef MU_SCM_TYPES_HH
-#define MU_SCM_CONTACT_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*/

scm/mu-scm.cc

@@ -25,8 +25,7 @@
 #include "mu-utils.hh"
 #include "config.h"
 
-#include "mu-scm-contact.hh"
+#include "mu-scm-types.hh"
-#include "mu-scm-store.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>

scm/mu-scm.hh

@@ -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*/

scm/mu-scm.scm

@@ -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

scm/mu-scm.texi

@@ -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
+@node API Reference with examples
-@chapter API Reference
+@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 @var{query} is a Mu query; see the @t{mu-query} man-page for details
-@item @t{#:related?} (optional) whether @emph{related} messages should be included
+@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 @var{#:reverse?} whether to reverse the sort-direction (make it descending)
-@item @t{#:max-results} (optional) the maximum number of results
+@item @var{#:max-results} the maximum number of results
-By default, @emph{all} matches are returned
+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
+explained in @xref{Store}. In the following, we use some message-object @t{msg},
-@t{msg}, e.g.
+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
+seconds-since-epoch @t{time_t} value. @var{iso-date} is expected to be in the
-@t{strftime}-format @t{%F%T}, or any prefix thereof. Non-numerical characters
+@t{strftime}-format @t{%F%T}, or a prefix thereof. Non-numerical characters are
-are ignored.
+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