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:
@ -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)
|
||||
{
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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);
|
||||
|
||||
{
|
||||
|
||||
@ -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)
|
||||
@ -539,17 +545,11 @@ 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 (data)
|
||||
(make <message> #:serialized data))
|
||||
(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 (cc-store store)))
|
||||
(map (lambda (data)
|
||||
(make <message> #:serialized data))
|
||||
(cc-store-mfind (cc-store store) query
|
||||
related? skip-dups? sort-field
|
||||
reverse? max-results)))
|
||||
|
||||
(define* (cfind pattern
|
||||
#:key
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user