From 7b4aea432ec37951d518ab9434fb7b4b983d202d Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Tue, 8 Jul 2025 19:04:31 +0300 Subject: [PATCH 1/6] mu-scm: add filename procedure for mime-part --- scm/mu-scm-test.scm | 6 +++++- scm/mu-scm.scm | 29 ++++++++++++++++++----------- scm/mu-scm.texi | 12 ++++++++++-- 3 files changed, 33 insertions(+), 14 deletions(-) diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm index e45bcc89..bde76488 100644 --- a/scm/mu-scm-test.scm +++ b/scm/mu-scm-test.scm @@ -121,10 +121,14 @@ ((index . 2) (content-type . "image/jpeg") (size . 21566) (filename . "custer.jpg"))) (map (lambda (part) (mime-part->alist part)) (mime-parts msg))) + (test-equal "mime-part-0" (filename (list-ref (mime-parts msg) 0))) + (test-equal "sittingbull.jpg" (filename (list-ref (mime-parts msg) 1))) + (test-equal "custer.jpg" (filename (list-ref (mime-parts msg) 2))) + (let* ((part (list-ref (mime-parts msg) 1)) (alist (mime-part->alist part)) (fname (format #f "~a/~a" tmpdir (assoc-ref alist 'filename)))) - (write-to-file part #:filename fname) + (write-to-file part #:path fname) (test-assert (access? fname R_OK)) ;; note, the 23881 is the _encoded_ size. (test-equal 17674 (stat:size (stat fname)))) diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index 197796ba..445921c6 100644 --- a/scm/mu-scm.scm +++ b/scm/mu-scm.scm @@ -28,6 +28,7 @@ mime-part->alist make-port + filename write-to-file ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Message @@ -159,27 +160,33 @@ If DECODE? is #t, decode the content (from e.g., base64); in that case, CONTENT-ONLY? is implied to be #t." (cc-mime-make-stream-port (slot-ref mime-part 'mimepart) content-only? decode?)) -(define* (make-output-file mime-part #:key (filename #f) (overwrite? #f)) +(define-method (filename (mime-part )) + "Determine the file-name for MIME-part. +Either the 'filename' field in the mime-part and if that does not exist, use +'mime-part-' with being the number of the mime-part." + (let ((alist (mime-part->alist mime-part))) + (or (assoc-ref alist 'filename) + (format #f "mime-part-~d" (assoc-ref alist 'index))))) + +(define* (make-output-file mime-part #:key (path #f) (overwrite? #f)) "Create a port for the file to write MIME-PART to. -FILENAME is the path to the file name. If not specified, use the 'filename' +PATH is file-name or path to the file name. If not specified, use the 'filename' field in the mime-part and if that does not exist, use 'mime-part-' with being the number of the mime-part. OVERWRITE? specifies whether existing files by the same name or overwritten. Otherwise, trying to overwrite an existing file raises an error." (let* ((alist (mime-part->alist mime-part)) - (filename (or filename - (assoc-ref alist 'filename) - (format #f "mime-part-~d" (assoc-ref alist 'index))))) - ;; we need an fd-based port since we want to support overwrite? - (open filename - (logior O_WRONLY O_CREAT O_TRUNC (if overwrite? O_EXCL 0)) #o644))) + (path (or path (filename mime-part)))) + ;; we need an fd-based port since we want to support overwrite? + (open path + (logior O_WRONLY O_CREAT O_TRUNC (if overwrite? O_EXCL 0)) #o644))) -(define* (write-to-file mime-part #:key (filename #f) (overwrite? #f)) +(define* (write-to-file mime-part #:key (path #f) (overwrite? #f)) "Write MIME-PART to a file. -FILENAME is the path to the file name. If not specified, use the 'filename' +PATH is the path/filename for the file. If not specified, use the 'filename' field in the mime-part and if that does not exist, use 'mime-part-' with being the number of the mime-part. @@ -187,7 +194,7 @@ OVERWRITE? specifies whether existing files by the same name or overwritten. Otherwise, trying to overwrite an existing file raises an error." (let* ((input (make-port mime-part)) (output (make-output-file mime-part - #:filename filename #:overwrite? overwrite?)) + #:path path #:overwrite? overwrite?)) (buf (make-bytevector 4096)) ;; just a guess... (bytes 0)) (while (not (eof-object? bytes)) ;; XXX do this in a more elegant way. diff --git a/scm/mu-scm.texi b/scm/mu-scm.texi index 19bd0aae..517cf82c 100644 --- a/scm/mu-scm.texi +++ b/scm/mu-scm.texi @@ -515,12 +515,20 @@ case, @code{content-only?} is implied to be #t. Write MIME-part to file. Use @code{filename} is the file/path to use for writing; if this is @code{#f}, -the name is taken from the @t{filename} property of the MIME-part alist. If that -does not exist, a generic name is chosen. +the name using the @code{filename} procedure. If @code{overwrite?} is true, overwrite existing files of the same name; otherwise, raise an error if the file already exists. + +@deffn {Scheme Procedure} filename mime-part +@end deffn +Determine a filename for the given MIME-part. + +This is either taken from the @t{filename} property of the MIME-part alist, or, +If that does not exist, a generic name. + + @subsection Contacts Message fields @t{To:}, @t{From:}, @t{Cc:} and @t{Bcc:} contain @emph{contacts}. From 8d46f80bb9fb98869e6eb5ce643418d6e2c639eb Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Wed, 9 Jul 2025 19:24:03 +0300 Subject: [PATCH 2/6] mu-config: split get() into get_str() and decode() Makes it easier to use elsewhere. --- lib/mu-config.hh | 90 +++++++++++++++++++++++++++++++----------------- 1 file changed, 58 insertions(+), 32 deletions(-) diff --git a/lib/mu-config.hh b/lib/mu-config.hh index eaa0cd94..c7fd1020 100644 --- a/lib/mu-config.hh +++ b/lib/mu-config.hh @@ -1,5 +1,5 @@ /* -** Copyright (C) 2023 Dirk-Jan C. Binnema +** Copyright (C) 2023-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 @@ -39,18 +39,18 @@ namespace Mu { struct Property { enum struct Id { - BatchSize, /**< Xapian batch-size */ - Contacts, /**< Cache of contact information */ - Created, /**< Time of creation */ - IgnoredAddresses,/**< Email addresses ignored for the contacts-cache */ - LastChange, /**< Time of last change */ - LastIndex, /**< Time of last index */ - MaxMessageSize, /**< Maximum message size (in bytes) */ + BatchSize, /**< Xapian batch-size */ + Contacts, /**< Cache of contact information */ + Created, /**< Time of creation */ + IgnoredAddresses, /**< Email addresses ignored for the contacts-cache */ + LastChange, /**< Time of last change */ + LastIndex, /**< Time of last index */ + MaxMessageSize, /**< Maximum message size (in bytes) */ PersonalAddresses, /**< List of personal e-mail addresses */ - RootMaildir, /**< Root maildir path */ - SchemaVersion, /**< Xapian DB schema version */ - SupportNgrams, /**< Support ngrams for indexing & querying - * for e.g. CJK languages */ + RootMaildir, /**< Root maildir path */ + SchemaVersion, /**< Xapian DB schema version */ + SupportNgrams, /**< Support ngrams for indexing & querying + * for e.g. CJK languages */ /* */ _count_ /* Number of Ids */ }; @@ -65,6 +65,7 @@ struct Property { Configurable = 1 << 1, /**< A user-configurable parameter; name * starts with 'conf-' */ Internal = 1 << 2, /**< Mu-internal field */ + Runtime = 1 << 3, /**< May change at runtime */ }; enum struct Type { Boolean, /**< Some boolean value */ @@ -132,7 +133,7 @@ public: { Id::LastChange, Type::Timestamp, - Flags::ReadOnly, + Flags::ReadOnly | Flags::Runtime, MetadataIface::last_change_key, {}, "Time when last change occurred" @@ -140,7 +141,7 @@ public: { Id::LastIndex, Type::Timestamp, - Flags::ReadOnly, + Flags::ReadOnly | Flags::Runtime, "last-index", {}, "Time when last indexing operation was completed" @@ -222,6 +223,47 @@ public: return Nothing; } + + /** + * Get the string-value for prop. + * + * For internal use + * + * @param prop some property + * + * @return a string + */ + std::string get_str(const Property& prop) const { + const auto str = cstore_.metadata(std::string{prop.name}); + return str.empty() ? std::string{prop.default_val} : str; + } + + + /** + * Get the property value decoded based on the type + * + * @param prop_id a property id + * + * @return the value or Nothing + */ + template + static constexpr auto decode(const std::string& str) { + if constexpr (type == Type::Number) + return static_cast(str.empty() ? 0 : std::atoll(str.c_str())); + if constexpr (type == Type::Boolean) + return static_cast(str.empty() ? false : + std::atol(str.c_str()) != 0); + else if constexpr (type == Type::Timestamp) + return static_cast(str.empty() ? 0 : std::atoll(str.c_str())); + else if constexpr (type == Type::Path || type == Type::String) + return str; + else if constexpr (type == Type::StringList) + return split(str, SepaChar1); + throw std::logic_error("invalid type"); + } + + + /** * Get the property value of the correct type * @@ -231,24 +273,8 @@ public: */ template auto get() const { - constexpr auto&& prop{property()}; - const auto str = std::invoke([&]()->std::string { - const auto str = cstore_.metadata(std::string{prop.name}); - return str.empty() ? std::string{prop.default_val} : str; - }); - if constexpr (prop.type == Type::Number) - return static_cast(str.empty() ? 0 : std::atoll(str.c_str())); - if constexpr (prop.type == Type::Boolean) - return static_cast(str.empty() ? false : - std::atol(str.c_str()) != 0); - else if constexpr (prop.type == Type::Timestamp) - return static_cast(str.empty() ? 0 : std::atoll(str.c_str())); - else if constexpr (prop.type == Type::Path || prop.type == Type::String) - return str; - else if constexpr (prop.type == Type::StringList) - return split(str, SepaChar1); - - throw std::logic_error("invalid prop " + std::string{prop.name}); + constexpr auto& prop{property()}; + return decode(get_str(prop)); } /** From 6d72aa5c7f545e8267228451bfe919fd4055b378 Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Wed, 9 Jul 2025 21:50:31 +0300 Subject: [PATCH 3/6] mu-scm: implement store->alist Get information about the store as an alist. Scm + cc + test + doc. --- scm/mu-scm-store.cc | 58 +++++++++++++++++++++++++++++++++++++++++++-- scm/mu-scm-test.scm | 14 ++++++----- scm/mu-scm.hh | 7 ++++++ scm/mu-scm.scm | 22 ++++++++++++----- scm/mu-scm.texi | 14 ++++++++++- 5 files changed, 100 insertions(+), 15 deletions(-) diff --git a/scm/mu-scm-store.cc b/scm/mu-scm-store.cc index 17f6dd03..420c66f8 100644 --- a/scm/mu-scm-store.cc +++ b/scm/mu-scm-store.cc @@ -38,6 +38,57 @@ to_store(SCM scm, const char *func, int pos) return *reinterpret_cast(scm_foreign_object_ref(scm, 0)); } +static SCM +subr_cc_store_alist(SCM store_scm) try { + constexpr auto func{"cc-store-alist"}; + + SCM alist{SCM_EOL}; + const auto& conf{to_store(store_scm, func, 1).config()}; + + using MuConfig = Mu::Config; + using Type = MuConfig::Type; + + for (const auto& prop: Mu::Config::properties) { + + // don't expose internal values & values that may change during + // runtime + if (any_of(prop.flags & + (MuConfig::Flags::Internal | MuConfig::Flags::Runtime))) + continue; + + const auto str{conf.get_str(prop)}; + if (str.empty()) + continue; + + const auto name{make_symbol(prop.name)}; + const auto val = std::invoke([&]() { + switch (prop.type) { + case Type::Number: + return to_scm(MuConfig::decode(str)); + case Type::Boolean: + return to_scm(MuConfig::decode(str)); + case Type::Timestamp: + return to_scm(MuConfig::decode(str)); + case Type::Path: + return to_scm(MuConfig::decode(str)); + case Type::String: + return to_scm(MuConfig::decode(str)); + case Type::StringList: + return to_scm(MuConfig::decode(str)); + default: + throw ScmError{ScmError::Id::WrongType, func, 1, store_scm, "store"}; + } + }); + + alist = scm_acons(name, val, alist); + } + + return scm_reverse_x(alist, SCM_EOL); + +} catch (const ScmError& err) { + err.throw_scm(); +} + static SCM subr_cc_store_mcount(SCM store_scm) try { return to_scm(to_store(store_scm, "cc-store-mcount", 1).size()); @@ -139,6 +190,9 @@ init_subrs() reinterpret_cast(subr_cc_store_mcount)); scm_c_define_gsubr("cc-store-cfind", 5/*req*/, 0/*opt*/, 0/*rst*/, reinterpret_cast(subr_cc_store_cfind)); + scm_c_define_gsubr("cc-store-alist", 1/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast(subr_cc_store_alist)); + #pragma GCC diagnostic pop } @@ -167,8 +221,8 @@ Mu::Scm::init_store(const Store& store) SCM Mu::Scm::to_scm(const Contact& contact) { - static SCM email{scm_from_utf8_symbol("email")}; - static SCM name{scm_from_utf8_symbol("name")}; + static SCM email{make_symbol("email")}; + static SCM name{make_symbol("name")}; SCM alist = scm_acons(email, to_scm(contact.email), SCM_EOL); if (!contact.name.empty()) diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm index bde76488..234a527e 100644 --- a/scm/mu-scm-test.scm +++ b/scm/mu-scm-test.scm @@ -3,14 +3,18 @@ (use-modules (mu) (srfi srfi-64) (ice-9 textual-ports)) -(define (test-basic) - (test-begin "test-basic") +(define (test-store) + (test-begin "test-store") (test-equal "mcount" 19 (mcount)) (test-equal "cfind" 29 (length (cfind ""))) (test-equal "mfind" 19 (length (mfind ""))) - (test-end "test-basic")) + (let ((info (store->alist))) + (test-equal 50000 (assoc-ref info 'batch-size)) + (test-equal 100000000 (assoc-ref info 'max-message-size))) + + (test-end "test-store")) (define (test-basic-mfind) @@ -33,10 +37,8 @@ (let ((recip (car (to msg)))) (test-equal "Bilbo Baggins" (assoc-ref recip 'name)) (test-equal "bilbo@anotherexample.com" (assoc-ref recip 'email))) - ;; no date (test-assert (not (date msg))) - ;; flags (test-equal '(unread) (flags msg)) (test-assert (unread? msg)) @@ -171,7 +173,7 @@ (test-with-runner runner (test-begin "mu-scm-tests") - (test-basic) + (test-store) (test-basic-mfind) (test-mfind) (test-message-full) diff --git a/scm/mu-scm.hh b/scm/mu-scm.hh index e16760c0..02a9cb9f 100644 --- a/scm/mu-scm.hh +++ b/scm/mu-scm.hh @@ -221,6 +221,13 @@ namespace Mu::Scm { return scm_from_utf8_stringn(val.data(), val.size()); else if constexpr (is_char_array_v|| std::is_same_v) return scm_from_utf8_string(val); + else if constexpr (std::is_same_v>) { + SCM lst{SCM_EOL}; + for (const auto& s: val) + lst = scm_append_x(scm_list_2(lst, + scm_list_1(to_scm(s)))); + return lst; + } else if constexpr (std::is_same_v) return scm_from_bool(val); else if constexpr (std::is_same_v) diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index 445921c6..8a4ae850 100644 --- a/scm/mu-scm.scm +++ b/scm/mu-scm.scm @@ -87,6 +87,7 @@ mfind mcount cfind + store->alist ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Other @@ -453,7 +454,8 @@ This is a list of objects." ;; the 'store-object' is a foreign object wrapping a const Store*. (define-class () - (store-object #:init-keyword #:store-object #:getter store-object)) + (store-object #:init-keyword #:store-object #:getter store-object) + (alist #:init-value #f)) ;; not exported (define-method (make-store store-object) @@ -464,6 +466,14 @@ This is a list of objects." ;; %default-store-object is defined in mu-scm-store.cc (make-store %default-store-object)) +(define* (store->alist #:key (store %default-store)) + "Get an alist-representation for some store. +Keyword arguments: + #:store %default-store. Leave at default." + (when (not (slot-ref store 'alist)) + (slot-set! store 'alist (cc-store-alist (store-object store)))) + (slot-ref store 'alist)) + (define* (mfind query #:key (store %default-store) @@ -472,7 +482,7 @@ This is a list of objects." (sort-field 'date) (reverse? #f) (max-results #f)) - "Find messages matching some query. + "Find messages matching some query. The query is mandatory, the other (keyword) arguments are optional. (mfind QUERY @@ -482,10 +492,10 @@ The query is mandatory, the other (keyword) arguments are optional. #:sort-field? field to sort by, a symbol. Default: date #:reverse? sort in descending order (z-a) #:max-results max. number of matches. Default: false (unlimited))." - (map (lambda (plist) - (make #:plist plist)) - (cc-store-mfind (store-object store) query - related? skip-dups? sort-field reverse? max-results))) + (map (lambda (plist) + (make #:plist plist)) + (cc-store-mfind (store-object store) query + related? skip-dups? sort-field reverse? max-results))) (define* (mcount #:key diff --git a/scm/mu-scm.texi b/scm/mu-scm.texi index 517cf82c..36e658f7 100644 --- a/scm/mu-scm.texi +++ b/scm/mu-scm.texi @@ -260,7 +260,7 @@ few key concepts, represented in some GOOP objects and other data-structures: @end itemize @menu -* Store:: the database of all information +* Store:: where message information lives * Message:: inspecting individual messages * Miscellaneous:: other functions * Helpers:: some helper functions @@ -352,6 +352,18 @@ Example usage: => 140728 @end lisp +@deffn {Scheme Procedure} store->alist +@end deffn +Retrieve an association list (``alist'') with information about the store. + +Example: +@lisp +(store->alist) +=> ((batch-size . 50000) (created . 1741180008) (max-message-size . 100000000) + (personal-addresses "djcb@@example.com" "msx@@example.com") + (root-maildir . "/home/user/Maildir") (schema-version . 500)) +@end lisp + @node Message @section Message From 5c52ccc25616089ebf54b0e1c66beb5d261fa82b Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Thu, 10 Jul 2025 08:51:14 +0300 Subject: [PATCH 4/6] mu-scm: add docstrings for symbols Use some snippet from https://git.wolfsden.cz/guile-wolfsden/tree/wolfsden/documentation.scm and document some symbols (variables, classes etc.) --- scm/mu-scm.scm | 88 +++++++++++++++++++++++++++++++++++++------------- 1 file changed, 66 insertions(+), 22 deletions(-) diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index 8a4ae850..e9e1a22d 100644 --- a/scm/mu-scm.scm +++ b/scm/mu-scm.scm @@ -102,6 +102,19 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; + +(define (set-documentation! symbol docstring) + "Set the docstring for symbol in current module to docstring. +This is useful for symbols that do not support docstrings directly, such +add + (define foo 123) +" + ;; https://git.wolfsden.cz/guile-wolfsden/tree/wolfsden/documentation.scm + (set-object-property! (module-ref (current-module) symbol) + 'documentation docstring)) + ;; some helpers for dealing with plists / alists (define (plist-for-each func plist) "Call FUNC for each key/value in the PLIST. @@ -144,15 +157,17 @@ If not found, return #f." alist)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; MIME-parts -;; -;; A has two slots: -;; partobj --> wraps a GMimePart* as a "foreign object" -;; alist --> alist with information about some MIME-part (define-class () - (mimepart #:init-value #f #:init-keyword #:mimepart) - (alist #:init-value #f #:init-keyword #:alist #:getter mime-part->alist)) + (cc-mimepart #:init-value #f #:init-keyword #:mimepart #:getter cc-mimepart) + (alist #:init-value #f #:init-keyword #:alist #:getter mime-part->alist)) + +(set-documentation! + ' + "A represents the information about a message's MIME-part. +It has a few slots: + - cc-mimepart: a 'foreign object' wrapping a GMimePart* + - alist: the association-list representation of the MIME-part.") (define* (make-port mime-part #:key (content-only? #t) (decode? #t)) "Create a read port for MIME-PART. @@ -205,21 +220,33 @@ Otherwise, trying to overwrite an existing file raises an error." (close output))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; Message -;; -;; 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" -;; parts --> MIME-parts -;; generally the plist is a bit cheaper, since the mu-message -;; captures a file-descriptor. - (define-class () (object #:init-value #f #:init-keyword #:object) (plist #:init-value #f #:init-keyword #:plist) (parts #:init-value #f #:init-keyword #:parts)) +(set-documentation! + ' + "A represents the information about a message. + +Exactly what information depends on how the object came to be; +these are the slots: + +- cc-message: this is a foreign-object representing the mu + message object, and needs to be passed to some 'cc-' methods. +- parts: a list of objects +- plist: this is an Emacs-style property list which is cached + for each message in the store; this was originally added + for use in mu4e, but we re-use it here. +- alist: an association list; this is just more 'scheme-like' + version of the plist, it is created on-demand (message->alist). + +A message that came from a search such as 'mfind' initially only +has the plist, but when a message is loaded from file, either +through make-message or by calling a function that needs a +full message, such as header or body, the cc-message is initialized. + +Only having a plist is cheaper.") (define (make-message path) "Create a from file at PATH." @@ -457,6 +484,16 @@ This is a list of objects." (store-object #:init-keyword #:store-object #:getter store-object) (alist #:init-value #f)) +(set-documentation! + ' + "A represents mu's message store (database). + +It has a few slots: +- cc-store: this is a foreign-object for a Mu::Store*. + It needs to be passed to some 'cc-' methods. +- alist: an association list; this is the cached representation + of some store properties.") + ;; not exported (define-method (make-store store-object) "Make a store from some STORE-OBJECT." @@ -465,6 +502,11 @@ This is a list of objects." (define %default-store ;; %default-store-object is defined in mu-scm-store.cc (make-store %default-store-object)) +(set-documentation! '%default-store "Default store.") + +(set-documentation! '%cc-default-store + "Default store object. +This is defined in the C++ code, and represents a \"foreign\" Store* object.") (define* (store->alist #:key (store %default-store)) "Get an alist-representation for some store. @@ -528,16 +570,18 @@ The pattern is mandatory; the other (keyword) arguments are optional. ;; The alist maps symbols to values; a value of #f indicates that the value is at ;; its default. %options ;; defined in c++ +(set-documentation! '%options + "Alist with the command-line parameters.") -;; Alist of user-preferences. -;; -;; - short-date: a strftime-compatibie string for the display -;; format of short dates. -;; - utc? : whether to assume use UTC for dates/times (define %preferences '( (short-date . "%F %T") (utc? . #f))) ;; XXX; not exposed yet. Perhaps we need a "fluid" here? +(set-documentation! '%preferences + "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") (define (value-or-preference val key) "If VAL is the symbol 'preference, return the value for KEY from %preferences. From d24d87336a02e3f652ee55d8fc5719400013c516 Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Thu, 10 Jul 2025 09:55:23 +0300 Subject: [PATCH 5/6] mu-scm: use cc-prefix for C++ objects Both in SCM and C++, use cc- for functions and objects defined in C++. Makes it a little easier to track. --- scm/mu-scm-store.cc | 2 +- scm/mu-scm.scm | 65 ++++++++++++++++++++++----------------------- 2 files changed, 33 insertions(+), 34 deletions(-) diff --git a/scm/mu-scm-store.cc b/scm/mu-scm-store.cc index 420c66f8..94c4f1ac 100644 --- a/scm/mu-scm-store.cc +++ b/scm/mu-scm-store.cc @@ -210,7 +210,7 @@ Mu::Scm::init_store(const Store& store) default_store = scm_make_foreign_object_1( store_type, const_cast(&store)); - scm_c_define("%default-store-object", default_store); + scm_c_define("%cc-default-store", default_store); init_subrs(); diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index e9e1a22d..f6816cf9 100644 --- a/scm/mu-scm.scm +++ b/scm/mu-scm.scm @@ -102,8 +102,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; +;; Helpers (define (set-documentation! symbol docstring) "Set the docstring for symbol in current module to docstring. @@ -174,7 +174,7 @@ It has a few slots: If CONTENT-ONLY? is #t, only include the contents, not headers. If DECODE? is #t, decode the content (from e.g., base64); in that case, CONTENT-ONLY? is implied to be #t." - (cc-mime-make-stream-port (slot-ref mime-part 'mimepart) content-only? decode?)) + (cc-mime-make-stream-port (cc-mimepart mime-part) content-only? decode?)) (define-method (filename (mime-part )) "Determine the file-name for MIME-part. @@ -222,9 +222,11 @@ Otherwise, trying to overwrite an existing file raises an error." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Message (define-class () - (object #:init-value #f #:init-keyword #:object) + (cc-message #:init-value #f #:init-keyword #:cc-message) + (parts #:init-value #f #:init-keyword #:parts) (plist #:init-value #f #:init-keyword #:plist) - (parts #:init-value #f #:init-keyword #:parts)) + (alist #:init-value #f)) + (set-documentation! ' "A represents the information about a message. @@ -250,21 +252,21 @@ Only having a plist is cheaper.") (define (make-message path) "Create a from file at PATH." - (make #:object (cc-message-make path))) + (make #:cc-message (cc-message-make path))) (define-method (plist (message )) "Get the PLIST for this MESSAGE." (when (not (slot-ref message 'plist)) - (slot-set! message 'plist (cc-message-plist (object message)))) + (slot-set! message 'plist (cc-message-plist (cc-message message)))) (slot-ref message 'plist)) -(define-method (object (message )) +(define-method (cc-message (message )) "Get the foreign object for this MESSAGE. If MESSAGE does not have such an object yet, create it from the path of the message." - (if (not (slot-ref message 'object)) - (slot-set! message 'object (cc-message-make (path message)))) - (slot-ref message 'object)) + (if (not (slot-ref message 'cc-message)) + (slot-set! message 'cc-message (cc-message-make (path message)))) + (slot-ref message 'cc-message)) (define-method (find-field (message ) field) (plist-find (plist message) field)) @@ -451,37 +453,33 @@ not found." "Get the MESSAGE body or #f if not found If #:html is non-#f, instead search for the HTML body. Requires the full message." - (cc-message-body (object message) html?)) + (cc-message-body (cc-message 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." - (cc-message-header (object message) field)) + (cc-message-header (cc-message message) field)) (define-method (mime-parts (message )) "Get the MIME-parts for this message. This is a list of objects." - (let ((msgobj (object message))) - (map (lambda (mimepart-alist) - (make - #:mimepart (car mimepart-alist) - #:alist (cdr mimepart-alist))) - (cc-message-parts msgobj)))) + (map (lambda (mimepart-alist) + (make + #:mimepart (car mimepart-alist) + #:alist (cdr mimepart-alist))) + (cc-message-parts (cc-message message)))) ;; Store ;; -;; Note: we have a %default-store, which is the store we opened during -;; startup; for now that's the only store supported, but we keep things -;; open. +;; Note: we have a %default-store, which is the store we opened during startup; +;; for now that's the only store supported, but we keep things open. ;; ;; Since it's the default store, we'd like to call the methods without ;; explicitly using %default-store; with GOOPS, we cannot pass a default for ;; that, nor can we use keyword arguments (I think?). So use define* for that. - -;; the 'store-object' is a foreign object wrapping a const Store*. (define-class () - (store-object #:init-keyword #:store-object #:getter store-object) + (cc-store #:init-keyword #:cc-store #:getter cc-store) (alist #:init-value #f)) (set-documentation! @@ -495,13 +493,14 @@ It has a few slots: of some store properties.") ;; not exported -(define-method (make-store store-object) - "Make a store from some STORE-OBJECT." - (make #:store-object store-object)) +(define-method (make-store store-obj) + "Make a store from some STORE-OBJ. +STORE-OBJ a 'foreign-object' for a mu Store pointer." + (make #:cc-store store-obj)) (define %default-store - ;; %default-store-object is defined in mu-scm-store.cc - (make-store %default-store-object)) + (make-store %cc-default-store)) + (set-documentation! '%default-store "Default store.") (set-documentation! '%cc-default-store @@ -513,7 +512,7 @@ This is defined in the C++ code, and represents a \"foreign\" Store* object.") Keyword arguments: #:store %default-store. Leave at default." (when (not (slot-ref store 'alist)) - (slot-set! store 'alist (cc-store-alist (store-object store)))) + (slot-set! store 'alist (cc-store-alist (cc-store store)))) (slot-ref store 'alist)) (define* (mfind query @@ -536,14 +535,14 @@ The query is mandatory, the other (keyword) arguments are optional. #:max-results max. number of matches. Default: false (unlimited))." (map (lambda (plist) (make #:plist plist)) - (cc-store-mfind (store-object store) query + (cc-store-mfind (cc-store store) query related? skip-dups? sort-field reverse? max-results))) (define* (mcount #:key (store %default-store)) "Get the number of messages." - (cc-store-mcount (store-object store))) + (cc-store-mcount (cc-store store))) (define* (cfind pattern #:key @@ -559,7 +558,7 @@ The pattern is mandatory; the other (keyword) arguments are optional. #:personal? only include 'personal' contacts. Default: all #:after only include contacts last seen time_t: Default all #:max-results max. number of matches. Default: false (unlimited))." - (cc-store-cfind (store-object store) pattern personal? after max-results)) + (cc-store-cfind (cc-store store) pattern personal? after max-results)) ;;; Misc From 1b3199a5524dade9755ed7ba0c1d365fa1d28396 Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Thu, 10 Jul 2025 20:27:59 +0300 Subject: [PATCH 6/6] 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. --- scm/mu-scm-test.scm | 12 +++++- scm/mu-scm.scm | 101 ++++++++++++++++++++++---------------------- scm/mu-scm.texi | 12 +++--- 3 files changed, 67 insertions(+), 58 deletions(-) diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm index 234a527e..5d746ca6 100644 --- a/scm/mu-scm-test.scm +++ b/scm/mu-scm-test.scm @@ -82,13 +82,21 @@ (references 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 "klub" (header msg "precedence")) (test-equal "gcc-help.gcc.gnu.org" (mailing-list msg)) (test-equal #f (references 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")) diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index f6816cf9..6604509d 100644 --- a/scm/mu-scm.scm +++ b/scm/mu-scm.scm @@ -35,8 +35,10 @@ make-message + message->alist + date - last-change + changed message-id path @@ -108,9 +110,7 @@ (define (set-documentation! symbol docstring) "Set the docstring for symbol in current module to docstring. This is useful for symbols that do not support docstrings directly, such -add - (define foo 123) -" +as (define foo 123)." ;; https://git.wolfsden.cz/guile-wolfsden/tree/wolfsden/documentation.scm (set-object-property! (module-ref (current-module) symbol) 'documentation docstring)) @@ -144,15 +144,29 @@ If not found, return #f." (string->symbol (string-drop name 1)) 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) - "Convert a plist into an alist." + "Convert a plist into an alist. +This is specific for message plists." (let ((alist '())) (plist-for-each (lambda (k v) - (set! alist - (append! alist - (list (cons (decolonize-symbol k) - v))))) + (let ((key (decolonize-symbol k))) + (set! alist + (append! alist + (list (cons key + (cond + ((member key '(from to cc bcc)) + (map plist->alist v)) + ((member key '(date changed)) + (emacs-time->epoch-secs v)) + (else v)))))))) plist) alist)) @@ -260,6 +274,12 @@ Only having a plist is cheaper.") (slot-set! message 'plist (cc-message-plist (cc-message message)))) (slot-ref message 'plist)) +(define-method (message->alist (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 )) "Get the foreign object for this MESSAGE. 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-ref message 'cc-message)) -(define-method (find-field (message ) field) - (plist-find (plist message) field)) - (define-method (sexp (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." (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 (define-method (subject (message )) "Get the subject for MESSAGE or #f if not found." - (find-field message ':subject)) + (assoc-ref (message->alist message) 'subject)) (define-method (maildir (message )) "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 )) "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 )) - "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." - (emacs-time->epoch-secs (find-field message ':date))) + (assoc-ref (message->alist message) 'date)) -(define-method (last-change (message )) - "Get the date for the last change to MESSAGE. +(define-method (changed (message )) + "Get the timestamp for the last change to MESSAGE. 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 )) "Get the file-system path for MESSAGE. 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 )) "Get the priority for MESSAGE. 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 )) "Get the ISO-639-1 language code for the MESSAGE as a symbol, if detected. Return #f otherwise." - (let ((lang (find-field message ':language))) + (let ((lang ( (assoc-ref (message->alist message) 'language)))) (if lang (string->symbol lang) #f))) @@ -330,7 +340,7 @@ Return #f otherwise." (define-method (size (message )) "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 )) "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 fake-message-id (see impls) are filtered out. If there are no references, return #f." - (find-field message ':references)) + (assoc-ref (message->alist message) 'references)) (define-method (thread-id (message )) "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 )) "Get the mailing-list id for MESSAGE or #f if not available." - (find-field message ':list)) + (assoc-ref (message->alist message) 'list)) ;; Flags. (define-method (flags (message )) "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 ) flag) "Does MESSAGE have FLAG?" - (let ((flags - (find-field message ':flags))) - (if flags - (if (member flag flags) #t #f) + (let ((flgs (flags message))) + (if flgs + (if (member flag flgs) #t #f) #f))) (define-method (draft? (message )) @@ -423,31 +432,23 @@ This is method is useful to determine the thread a message is in." "Does MESSAGE have a calender invitation?" (flag? message 'calendar)) -(define-method (find-contact-field (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 )) "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 )) "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 )) "Get the (intended) carbon-copy recipient for MESSAGE (the Cc: field) or #f if not found." - (find-contact-field message ':cc)) + (assoc-ref (message->alist message) 'cc)) (define-method (bcc (message )) "Get the (intended) blind carbon-copy recipient for MESSAGE (the Bcc: field) or #f if not found." - (find-contact-field message ':bcc)) + (assoc-ref (message->alist message) 'bcc)) (define* (body message #:key (html? #f)) "Get the MESSAGE body or #f if not found diff --git a/scm/mu-scm.texi b/scm/mu-scm.texi index 36e658f7..ccfb722d 100644 --- a/scm/mu-scm.texi +++ b/scm/mu-scm.texi @@ -658,13 +658,13 @@ Is this a personal message? Returns @t{#t} or @t{#f}. @deffn {Scheme Procedure} calendar? message @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 -@deffn {Scheme Procedure} last-change message +@deffn {Scheme Procedure} changed message @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, @t{time_t}. @@ -677,7 +677,7 @@ For example: @deffn {Scheme Procedure} priority message @end deffn 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: @lisp @@ -697,7 +697,7 @@ For example: @deffn {Scheme Procedure} language message @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 @command{mu info}. The language code is represented as a symbol, such as @t{en}, @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. @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 @appendix GNU Free Documentation License