diff options
Diffstat (limited to 'scm')
| -rw-r--r-- | scm/mu-scm-store.cc | 22 | ||||
| -rw-r--r-- | scm/mu-scm-test.scm | 11 | ||||
| -rw-r--r-- | scm/mu-scm.cc | 14 | ||||
| -rw-r--r-- | scm/mu-scm.scm | 14 | ||||
| -rw-r--r-- | scm/mu-scm.texi | 17 |
5 files changed, 76 insertions, 2 deletions
diff --git a/scm/mu-scm-store.cc b/scm/mu-scm-store.cc index 94c4f1a..44cbcf1 100644 --- a/scm/mu-scm-store.cc +++ b/scm/mu-scm-store.cc @@ -178,6 +178,25 @@ subr_cc_store_mfind(SCM store_scm, SCM query_scm, SCM related_scm, SCM skip_dups err.throw_scm(); } +static SCM +subr_cc_store_all_labels(SCM store_scm) try { + + constexpr auto func{"cc-store-all-labels"}; + const auto& store{to_store(store_scm, func, 1)}; + + const auto label_map{store.label_map()}; + + SCM labels{SCM_EOL}; + for (const auto& [label, _n]: label_map) + labels = scm_append_x( + scm_list_2(labels, + scm_list_1(to_scm<std::string>(label)))); + return labels; + +} catch (const ScmError& err) { + err.throw_scm(); +} + static void init_subrs() @@ -192,7 +211,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-all-labels", 1/*req*/, 0/*opt*/, 0/*rst*/, + reinterpret_cast<scm_t_subr>(subr_cc_store_all_labels)); #pragma GCC diagnostic pop } diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm index 5d746ca..23cd027 100644 --- a/scm/mu-scm-test.scm +++ b/scm/mu-scm-test.scm @@ -120,6 +120,16 @@ (test-end "test-message-parts"))) +(define (test-message-labels) + (test-begin "test-message-labels") + (let* ((perfmsgs (mfind "label:performance"))) + (test-equal 4 (length perfmsgs)) + (for-each (lambda (msg) + (test-equal 1 (length (labels msg))) + (test-equal "performance" (car (labels msg)))) + perfmsgs)) + (test-end "test-message-labels")) + (define (test-message-new) (test-begin "test-message-new") (let ((msg (make-message (format #f "~a/testdir2/Foo/cur/mail5" (getenv "MU_TESTDATADIR")))) @@ -187,6 +197,7 @@ (test-message-full) (test-message-more) (test-message-parts) + (test-message-labels) (test-message-new) (test-options) (test-helpers) diff --git a/scm/mu-scm.cc b/scm/mu-scm.cc index 998b8d4..0a0f4e6 100644 --- a/scm/mu-scm.cc +++ b/scm/mu-scm.cc @@ -193,6 +193,20 @@ test_scm_script() g_assert_true(res); } + // add some label for testing + { + auto res = store->run_query("optimization"); + const Labels::DeltaLabelVec labels{*Labels::parse_delta_label("+performance")}; + assert_valid_result(res); + g_assert_cmpuint(res->size(), ==, 4); + for (auto& it: *res) { + auto msg{it.message()}; + g_assert_true(!!msg); + const auto updateres{store->update_labels(*msg, labels)}; + assert_valid_result(updateres); + } + } + Mu::Options opts{}; opts.scm.script_path = join_paths(MU_SCM_SRCDIR, "mu-scm-test.scm"); diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index 6604509..b7b53a6 100644 --- a/scm/mu-scm.scm +++ b/scm/mu-scm.scm @@ -44,6 +44,7 @@ path priority subject + labels references thread-id @@ -89,6 +90,7 @@ mfind mcount cfind + all-labels store->alist ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -350,6 +352,10 @@ fake-message-id (see impls) are filtered out. If there are no references, return #f." (assoc-ref (message->alist message) 'references)) +(define-method (labels (message <message>)) + "Get the list of labels for MESSAGE or #f if not available." + (assoc-ref (message->alist message) 'labels)) + (define-method (thread-id (message <message>)) "Get the oldest (first) reference for MESSAGE, or message-id if there are none. If neither are available, return #f. @@ -370,7 +376,7 @@ This is method is useful to determine the thread a message is in." (assoc-ref (message->alist message) 'flags)) (define-method (flag? (message <message>) flag) - "Does MESSAGE have FLAG?" + "Does MESSAGE have some FLAG?" (let ((flgs (flags message))) (if flgs (if (member flag flgs) #t #f) @@ -561,6 +567,12 @@ 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." + (cc-store-all-labels (cc-store store))) + ;;; Misc ;; Get an alist with the general options this instance of \"mu\" started with. diff --git a/scm/mu-scm.texi b/scm/mu-scm.texi index ccfb722..da2eb03 100644 --- a/scm/mu-scm.texi +++ b/scm/mu-scm.texi @@ -364,6 +364,11 @@ Example: (root-maildir . "/home/user/Maildir") (schema-version . 500)) @end lisp +@deffn {Scheme Procedure} all-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. + @node Message @section Message @@ -695,6 +700,17 @@ For example: => 2815 @end lisp +@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. + +For example: +@lisp +(labels msg) +=> ("foo" "bar") +@end lisp + @deffn {Scheme Procedure} language message @end deffn Get the ISO-639-1 language code for message's primary language or @code{#f} if not @@ -771,6 +787,7 @@ For example: => "gnu-emacs-sources.gnu.org" @end lisp + @c @deffn {Scheme Procedure} sexp message @c @end deffn @c Get the message's s-expression. |