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();
|
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
|
static SCM
|
||||||
subr_cc_store_all_labels(SCM store_scm) try {
|
subr_cc_store_all_labels(SCM store_scm) try {
|
||||||
|
|
||||||
@ -208,6 +222,8 @@ init_subrs()
|
|||||||
reinterpret_cast<scm_t_subr>(subr_cc_store_cfind));
|
reinterpret_cast<scm_t_subr>(subr_cc_store_cfind));
|
||||||
scm_c_define_gsubr("cc-store-alist", 1/*req*/, 0/*opt*/, 0/*rst*/,
|
scm_c_define_gsubr("cc-store-alist", 1/*req*/, 0/*opt*/, 0/*rst*/,
|
||||||
reinterpret_cast<scm_t_subr>(subr_cc_store_alist));
|
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*/,
|
scm_c_define_gsubr("cc-store-all-labels", 1/*req*/, 0/*opt*/, 0/*rst*/,
|
||||||
reinterpret_cast<scm_t_subr>(subr_cc_store_all_labels));
|
reinterpret_cast<scm_t_subr>(subr_cc_store_all_labels));
|
||||||
#pragma GCC diagnostic pop
|
#pragma GCC diagnostic pop
|
||||||
@ -233,7 +249,6 @@ Mu::Scm::init_store(const Store& store)
|
|||||||
initialized = true;
|
initialized = true;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
Mu::Scm::to_scm(const Contact& contact)
|
Mu::Scm::to_scm(const Contact& contact)
|
||||||
{
|
{
|
||||||
|
|||||||
@ -10,6 +10,9 @@
|
|||||||
(test-equal "cfind" 29 (length (cfind "")))
|
(test-equal "cfind" 29 (length (cfind "")))
|
||||||
(test-equal "mfind" 19 (length (mfind "")))
|
(test-equal "mfind" 19 (length (mfind "")))
|
||||||
|
|
||||||
|
(test-assert (personal? "user@example.com"))
|
||||||
|
(test-assert (not (personal? "user@anotherexample.com")))
|
||||||
|
|
||||||
(let ((info (store->alist)))
|
(let ((info (store->alist)))
|
||||||
(test-equal 50000 (assoc-ref info 'batch-size))
|
(test-equal 50000 (assoc-ref info 'batch-size))
|
||||||
(test-equal 100000000 (assoc-ref info 'max-message-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);
|
::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);
|
assert_valid_result(store);
|
||||||
|
|
||||||
{
|
{
|
||||||
|
|||||||
@ -91,7 +91,8 @@
|
|||||||
mfind
|
mfind
|
||||||
mcount
|
mcount
|
||||||
cfind
|
cfind
|
||||||
all-labels
|
labels
|
||||||
|
personal?
|
||||||
store->alist
|
store->alist
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
@ -118,7 +119,7 @@
|
|||||||
(define (set-documentation! symbol docstring)
|
(define (set-documentation! symbol docstring)
|
||||||
"Set the docstring for symbol in current module to docstring.
|
"Set the docstring for symbol in current module to docstring.
|
||||||
This is useful for symbols that do not support docstrings directly, such
|
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
|
;; https://git.wolfsden.cz/guile-wolfsden/tree/wolfsden/documentation.scm
|
||||||
(set-object-property! (module-ref (current-module) symbol)
|
(set-object-property! (module-ref (current-module) symbol)
|
||||||
'documentation docstring))
|
'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?))
|
(cc-mime-make-stream-port (cc-mimepart mime-part) content-only? decode?))
|
||||||
|
|
||||||
(define-method (filename (mime-part <mime-part>))
|
(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)))
|
(let ((alist (mime-part->alist mime-part)))
|
||||||
(or (assoc-ref alist 'filename)
|
(or (assoc-ref alist 'filename)
|
||||||
(format #f "mime-part-~d" (assoc-ref alist 'index)))))
|
(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))
|
(define* (make-output-file mime-part #:key (path #f) (overwrite? #f))
|
||||||
"Create a port for the file to write MIME-PART to.
|
"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
|
through make-message or by calling a function that needs a
|
||||||
full message, such as header or body, the cc-message is initialized.")
|
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."
|
"Create a <message> from file at PATH."
|
||||||
(make <message> #:cc-message (cc-message-make 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.
|
"Default store object.
|
||||||
This is defined in the C++ code, and represents a \"foreign\" Store* object.")
|
This is defined in the C++ code, and represents a \"foreign\" Store* object.")
|
||||||
|
|
||||||
(define* (store->alist #:key (store %default-store))
|
(define-method (store->alist (store <store>))
|
||||||
"Get an alist-representation for some store.
|
"Get an alist-representation for some STORE."
|
||||||
Keyword arguments:
|
|
||||||
#:store %default-store. Leave at default."
|
|
||||||
(when (not (slot-ref store 'alist))
|
(when (not (slot-ref store 'alist))
|
||||||
(slot-set! store 'alist (cc-store-alist (cc-store store))))
|
(slot-set! store 'alist (cc-store-alist (cc-store store))))
|
||||||
(slot-ref store 'alist))
|
(slot-ref store 'alist))
|
||||||
|
|
||||||
|
(define-method (store->alist)
|
||||||
|
"Get an alist-representation from the default store."
|
||||||
|
(store->alist %default-store))
|
||||||
|
|
||||||
(define* (mfind query
|
(define* (mfind query
|
||||||
#:key
|
#:key
|
||||||
(store %default-store)
|
(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
|
#:sort-field? field to sort by, a symbol. Default: date
|
||||||
#:reverse? sort in descending order (z-a)
|
#:reverse? sort in descending order (z-a)
|
||||||
#:max-results max. number of matches. Default: false (unlimited))."
|
#:max-results max. number of matches. Default: false (unlimited))."
|
||||||
(map (lambda (data)
|
(map (lambda (data)
|
||||||
(make <message> #:serialized data))
|
(make <message> #:serialized data))
|
||||||
(cc-store-mfind (cc-store store) query
|
(cc-store-mfind (cc-store store) query
|
||||||
related? skip-dups? sort-field
|
related? skip-dups? sort-field
|
||||||
reverse? max-results)))
|
reverse? max-results)))
|
||||||
|
|
||||||
(define* (mcount
|
|
||||||
#:key
|
|
||||||
(store %default-store))
|
|
||||||
"Get the number of messages."
|
|
||||||
(cc-store-mcount (cc-store store)))
|
|
||||||
|
|
||||||
(define* (cfind pattern
|
(define* (cfind pattern
|
||||||
#:key
|
#:key
|
||||||
@ -567,12 +567,34 @@ The pattern is mandatory; the other (keyword) arguments are optional.
|
|||||||
#:max-results max. number of matches. Default: false (unlimited))."
|
#:max-results max. number of matches. Default: false (unlimited))."
|
||||||
(cc-store-cfind (cc-store store) pattern personal? after max-results))
|
(cc-store-cfind (cc-store store) pattern personal? after max-results))
|
||||||
|
|
||||||
(define* (all-labels
|
(define-method (mcount (store <store>))
|
||||||
#:key
|
;; "Get the number of messages in STORE."
|
||||||
(store %default-store))
|
(cc-store-mcount (cc-store store)))
|
||||||
"Get the list of all labels in the 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)))
|
(cc-store-all-labels (cc-store store)))
|
||||||
|
|
||||||
|
(define-method (labels)
|
||||||
|
"Get the list of all labels in the default store."
|
||||||
|
(labels %default-store))
|
||||||
|
|
||||||
;;; Misc
|
;;; Misc
|
||||||
|
|
||||||
;; Get an alist with the general options this instance of \"mu\" started with.
|
;; 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.
|
stores information about messages and contacts.
|
||||||
|
|
||||||
While you could theoretically have @emph{multiple} stores, for now @t{mu-scm}
|
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
|
only supports a @emph{single} one, which is the store you opened when you
|
||||||
@command{mu scm}. For completeness and possible future use, store-related
|
started @command{mu scm}.
|
||||||
methods do take a @t{#:store} parameter, but you can (in fact, @emph{must})
|
|
||||||
leave it out, and use its default value.
|
|
||||||
|
|
||||||
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.
|
The store currently only exposes a few methods, described below.
|
||||||
|
|
||||||
@ -472,7 +475,7 @@ Example:
|
|||||||
(root-maildir . "/home/user/Maildir") (schema-version . 500))
|
(root-maildir . "/home/user/Maildir") (schema-version . 500))
|
||||||
@end lisp
|
@end lisp
|
||||||
|
|
||||||
@deffn {Scheme Procedure} all-labels
|
@deffn {Scheme Procedure} labels
|
||||||
@end deffn
|
@end deffn
|
||||||
Get the list of all labels present in the store, or @code{#f} if there are none.
|
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.
|
Not to be confused with @code{labels} procedure for a @code{message} object.
|
||||||
@ -811,7 +814,7 @@ For example:
|
|||||||
@deffn {Scheme Procedure} labels message
|
@deffn {Scheme Procedure} labels message
|
||||||
@end deffn
|
@end deffn
|
||||||
Get the list of labels for this message, or @code{#f} if there are none.
|
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:
|
For example:
|
||||||
@lisp
|
@lisp
|
||||||
|
|||||||
Reference in New Issue
Block a user