diff --git a/scm/meson.build b/scm/meson.build index a20785a8..0c444e7c 100644 --- a/scm/meson.build +++ b/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: [ diff --git a/scm/mu-scm-contact.cc b/scm/mu-scm-contact.cc deleted file mode 100644 index 08fa3e0e..00000000 --- a/scm/mu-scm-contact.cc +++ /dev/null @@ -1,36 +0,0 @@ -/* -** Copyright (C) 2025 Dirk-Jan C. Binnema -** -** 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; -} diff --git a/scm/mu-scm-message.cc b/scm/mu-scm-message.cc new file mode 100644 index 00000000..902608f1 --- /dev/null +++ b/scm/mu-scm-message.cc @@ -0,0 +1,145 @@ +/* +** Copyright (C) 2025 Dirk-Jan C. Binnema +** +** 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 + +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; +static MessageMap message_map; +} + +static const Message& +to_message(SCM scm) +{ + scm_assert_foreign_object_type(message_type, scm); + return *reinterpret_cast(scm_foreign_object_ref(scm, 0)); +} + +static void +finalize_message(SCM scm) +{ + std::unique_lock lock{map_lock}; + const auto msg = reinterpret_cast(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(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(&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(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(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(subr_message_object_make)); + scm_c_define_gsubr("message-body", 2/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_message_body)); + scm_c_define_gsubr("message-header",2/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(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; +} diff --git a/scm/mu-scm-store.cc b/scm/mu-scm-store.cc index cd43a8d7..32ee41b1 100644 --- a/scm/mu-scm-store.cc +++ b/scm/mu-scm-store.cc @@ -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; +} diff --git a/scm/mu-scm-store.hh b/scm/mu-scm-store.hh deleted file mode 100644 index 41396ba8..00000000 --- a/scm/mu-scm-store.hh +++ /dev/null @@ -1,30 +0,0 @@ -/* -** Copyright (C) 2025 Dirk-Jan C. Binnema -** -** 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*/ diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm index 6438efb5..5ca1e64d 100644 --- a/scm/mu-scm-test.scm +++ b/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ü " (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) diff --git a/scm/mu-scm-contact.hh b/scm/mu-scm-types.hh similarity index 76% rename from scm/mu-scm-contact.hh rename to scm/mu-scm-types.hh index 9a5472db..810b82df 100644 --- a/scm/mu-scm-contact.hh +++ b/scm/mu-scm-types.hh @@ -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*/ diff --git a/scm/mu-scm.cc b/scm/mu-scm.cc index 9595b6e2..2d3ebac4 100644 --- a/scm/mu-scm.cc +++ b/scm/mu-scm.cc @@ -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 diff --git a/scm/mu-scm.hh b/scm/mu-scm.hh index f015eaaf..cbb2a15e 100644 --- a/scm/mu-scm.hh +++ b/scm/mu-scm.hh @@ -61,6 +61,7 @@ namespace Mu::Scm { */ Result 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(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*/ diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index 3861ffa0..b16dfd02 100644 --- a/scm/mu-scm.scm +++ b/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 is created from a message plist. +;; A 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 () - (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 )) + "Get the PLIST for this MESSAGE." + (slot-ref message 'plist)) + +(define-method (object (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 ) field) (plist-find (plist message) field)) @@ -200,7 +220,7 @@ Return #f otherwise." (find-field message ':flags)) (define-method (flag? (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 ) (field )) + "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 diff --git a/scm/mu-scm.texi b/scm/mu-scm.texi index a9b02977..509bedda 100644 --- a/scm/mu-scm.texi +++ b/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 -@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{} represents the mu database with information about messages @item from the store, you can find @t{} 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{} 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\" " +(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