scm: implement store personal?, rename all-labels->labels

Add a method personal? to check if some string looks like a personal address;
add docs / tests as well.

Rename the all-labels method into simply 'labels'

Make some define* into define-method, for consistency.
This commit is contained in:
Dirk-Jan C. Binnema
2025-08-26 21:29:18 +03:00
committed by Seth Ladygo
parent 5e87a9c81e
commit f8160e152b
5 changed files with 82 additions and 34 deletions

View File

@ -176,6 +176,20 @@ subr_cc_store_mfind(SCM store_scm, SCM query_scm, SCM related_scm, SCM skip_dups
err.throw_scm();
}
static SCM
subr_cc_store_is_personal(SCM store_scm, SCM address_scm) try {
constexpr auto func{"cc-store-is-personal"};
const auto& store{to_store(store_scm, func, 1)};
const auto& address{from_scm<std::string>(address_scm, func, 2)};
return to_scm(store.contacts_cache().is_personal(address));
} catch (const ScmError& err) {
err.throw_scm();
}
static SCM
subr_cc_store_all_labels(SCM store_scm) try {
@ -208,6 +222,8 @@ init_subrs()
reinterpret_cast<scm_t_subr>(subr_cc_store_cfind));
scm_c_define_gsubr("cc-store-alist", 1/*req*/, 0/*opt*/, 0/*rst*/,
reinterpret_cast<scm_t_subr>(subr_cc_store_alist));
scm_c_define_gsubr("cc-store-is-personal", 2/*req*/, 0/*opt*/, 0/*rst*/,
reinterpret_cast<scm_t_subr>(subr_cc_store_is_personal));
scm_c_define_gsubr("cc-store-all-labels", 1/*req*/, 0/*opt*/, 0/*rst*/,
reinterpret_cast<scm_t_subr>(subr_cc_store_all_labels));
#pragma GCC diagnostic pop
@ -233,7 +249,6 @@ Mu::Scm::init_store(const Store& store)
initialized = true;
}
SCM
Mu::Scm::to_scm(const Contact& contact)
{

View File

@ -10,6 +10,9 @@
(test-equal "cfind" 29 (length (cfind "")))
(test-equal "mfind" 19 (length (mfind "")))
(test-assert (personal? "user@example.com"))
(test-assert (not (personal? "user@anotherexample.com")))
(let ((info (store->alist)))
(test-equal 50000 (assoc-ref info 'batch-size))
(test-equal 100000000 (assoc-ref info 'max-message-size)))

View File

@ -290,7 +290,12 @@ test_scm_script()
::setenv("MU_TESTTEMPDIR", tempdir.path().c_str(), 1);
auto store{Store::make_new(tempdir.path(), MuTestMaildir)};
MemDb mdb;
Config conf{mdb};
; conf.set<Config::Id::PersonalAddresses>(
std::vector<std::string>{"user@example.com"});
auto store{Store::make_new(tempdir.path(), MuTestMaildir, conf)};
assert_valid_result(store);
{

View File

@ -91,7 +91,8 @@
mfind
mcount
cfind
all-labels
labels
personal?
store->alist
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -118,7 +119,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
as (define foo 123)."
as (define foo 123) and, apparently, define-method."
;; https://git.wolfsden.cz/guile-wolfsden/tree/wolfsden/documentation.scm
(set-object-property! (module-ref (current-module) symbol)
'documentation docstring))
@ -199,13 +200,16 @@ CONTENT-ONLY? is implied to be #t."
(cc-mime-make-stream-port (cc-mimepart mime-part) content-only? decode?))
(define-method (filename (mime-part <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-<index>' with <index> 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)))))
(set-documentation! 'filename
"Determine the file-name for MIME-part.
Either the 'filename' field in the mime-part and if that does not exist, use
'mime-part-<index>' with <index> being the number of the mime-part.")
(define* (make-output-file mime-part #:key (path #f) (overwrite? #f))
"Create a port for the file to write MIME-PART to.
@ -270,7 +274,7 @@ has the data, 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.")
(define (make-message path)
(define-method (make-message (path <string>))
"Create a <message> from file at PATH."
(make <message> #:cc-message (cc-message-make path)))
@ -513,14 +517,16 @@ STORE-OBJ a 'foreign-object' for a mu Store pointer."
"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.
Keyword arguments:
#:store %default-store. Leave at default."
(define-method (store->alist (store <store>))
"Get an alist-representation for some STORE."
(when (not (slot-ref store 'alist))
(slot-set! store 'alist (cc-store-alist (cc-store store))))
(slot-ref store 'alist))
(define-method (store->alist)
"Get an alist-representation from the default store."
(store->alist %default-store))
(define* (mfind query
#:key
(store %default-store)
@ -545,12 +551,6 @@ The query is mandatory, the other (keyword) arguments are optional.
related? skip-dups? sort-field
reverse? max-results)))
(define* (mcount
#:key
(store %default-store))
"Get the number of messages."
(cc-store-mcount (cc-store store)))
(define* (cfind pattern
#:key
(store %default-store)
@ -567,12 +567,34 @@ The pattern is mandatory; the other (keyword) arguments are optional.
#:max-results max. number of matches. Default: false (unlimited))."
(cc-store-cfind (cc-store store) pattern personal? after max-results))
(define* (all-labels
#:key
(store %default-store))
"Get the list of all labels in the store."
(define-method (mcount (store <store>))
;; "Get the number of messages in STORE."
(cc-store-mcount (cc-store store)))
(define-method (mcount)
"Get the number of messages in the default store."
(mcount %default-store))
(define-method (personal? (store <store>) (address <string>))
"Does the given email ADDRESS match the personal addresses in STORE?
I.e., the personal addresses / regular expressions as specified during `mu
init'."
(cc-store-is-personal (cc-store store) address))
(define-method (personal? (address <string>))
"Does the given email ADDRESS match the personal addresses?
I.e., the personal addresses / regular expressions as specified during `mu
init'. Uses the default-store."
(personal? %default-store address))
(define-method (labels (store <store>))
"Get the list of all labels in STORE."
(cc-store-all-labels (cc-store store)))
(define-method (labels)
"Get the list of all labels in the default store."
(labels %default-store))
;;; Misc
;; Get an alist with the general options this instance of \"mu\" started with.

View File

@ -381,12 +381,15 @@ The store represents the @t{mu} database, i.e., the place where @t{mu index}
stores information about messages and contacts.
While you could theoretically have @emph{multiple} stores, for now @t{mu-scm}
only supports a single one, which is the store you opened when you started
@command{mu scm}. For completeness and possible future use, store-related
methods do take a @t{#:store} parameter, but you can (in fact, @emph{must})
leave it out, and use its default value.
only supports a @emph{single} one, which is the store you opened when you
started @command{mu scm}.
Hence, in the API descriptions below, we leave out the @t{#:store} argument.
For completeness and possible future use, store-related methods do take a
@t{store} parameter or a @t{#:store} keyword parameter, but it can be left out
for for now.
Hence, for brevity, in the API descriptions below, the @t{store} parameter is
implicit.
The store currently only exposes a few methods, described below.
@ -472,7 +475,7 @@ Example:
(root-maildir . "/home/user/Maildir") (schema-version . 500))
@end lisp
@deffn {Scheme Procedure} all-labels
@deffn {Scheme Procedure} labels
@end deffn
Get the list of all labels present in the store, or @code{#f} if there are none.
Not to be confused with @code{labels} procedure for a @code{message} object.
@ -811,7 +814,7 @@ For example:
@deffn {Scheme Procedure} labels message
@end deffn
Get the list of labels for this message, or @code{#f} if there are none.
Not to be confused with the @code{all-labels} procedure for a Store.
Not to be confused with the @code{labels} procedure for a Store.
For example:
@lisp