From 702da53ad9394cba42f5bbb9896cdd925814c569 Mon Sep 17 00:00:00 2001 From: "Dirk-Jan C. Binnema" Date: Sun, 26 Jul 2026 13:00:19 +0300 Subject: [PATCH] scm: implement field / fields procedures Add procedures field & fields to get information about mu's database fields, similar to "mu info fields". Add docs & tests as well. --- NEWS.org | 4 ++++ scm/mu-scm-test.scm | 9 +++++++- scm/mu-scm.cc | 35 +++++++++++++++++++++++++++++++ scm/mu-scm.hh | 2 ++ scm/mu-scm.scm | 17 ++++++++++++++- scm/mu-scm.texi | 50 ++++++++++++++++++++++++++++++++++++++++++--- 6 files changed, 112 insertions(+), 5 deletions(-) diff --git a/NEWS.org b/NEWS.org index e5264249..155f96bf 100644 --- a/NEWS.org +++ b/NEWS.org @@ -73,6 +73,10 @@ #+end_example (1.14.0) + - add procedures ~configuration~ (an alist with the system configuration) and + ~fields~/~field~ (alists with metadata about database fields). See the SCM + reference documentation for further details (1.14.3). + * 1.12 (released on February 24, 2024) The 1.12 series has been "stable" for a fairly long time, and gained many diff --git a/scm/mu-scm-test.scm b/scm/mu-scm-test.scm index 0acbcba8..f5ded8ea 100644 --- a/scm/mu-scm-test.scm +++ b/scm/mu-scm-test.scm @@ -110,7 +110,7 @@ ;; language (test-equal (language msg) - (if (assoc-ref (configuration) 'language-enabled?) 'en nil)) + (if (assoc-ref (configuration) 'language-enabled?) 'en #f)) ;; cc, bc, labels (test-equal '() (cc msg)) @@ -197,6 +197,13 @@ (test-equal "2025-06-16 15:43:12" (time->string 1750077792 #:utc? #f)) (test-equal "12:43:12" (time->string 1750077792 #:utc? #t #:format "%T")) + (let* ((subject (field 'subject))) + (test-assert subject) + (test-equal (assoc-ref subject 'name) "subject") + (test-equal (assoc-ref subject 'shortcut) #\s) + (test-equal (assoc-ref subject 'search-type) 'phrase) + (test-assert (assoc-ref subject 'value?))) + ;; (define old-prefs %preferences) ;; (define %preferences '((utc? . #t) (short-date . "%T %F"))) ;; (test-equal "12:43:12 2025-06-16" (time->string 1750077792)) diff --git a/scm/mu-scm.cc b/scm/mu-scm.cc index 7920a4da..b983b0a8 100644 --- a/scm/mu-scm.cc +++ b/scm/mu-scm.cc @@ -101,6 +101,39 @@ init_configuration() scm_c_define("%configuration", scm_reverse_x(conf, SCM_EOL)); } +static void +init_fields_info() +{ + SCM fields_scm{SCM_EOL}; + + const auto search_type = [&](const Field& field)->SCM { + if (field.is_boolean_term()) + return make_symbol("boolean"); + else if (field.is_phrasable_term()) + return make_symbol("phrase"); + else if (field.is_contact()) + return make_symbol("contact"); + else if (field.is_range()) + return make_symbol("range"); + else + return SCM_BOOL_F; + }; + + field_for_each([&](const auto& field) { + SCM field_scm = alist_add(SCM_EOL, + make_symbol("field"), make_symbol(field.name), + make_symbol("name"), field.name, + make_symbol("shortcut"), + field.shortcut ? to_scm(field.shortcut) : SCM_BOOL_F, + make_symbol("value?"), field.is_value(), + make_symbol("search-type"), search_type(field)); + fields_scm = scm_cons(scm_reverse_x(field_scm, SCM_EOL), fields_scm); + }); + + scm_c_define("%fields", scm_reverse_x(fields_scm, SCM_EOL)); +} + + static void init_misc() { @@ -217,6 +250,8 @@ init_module_mu(void* data) init_options(conf.opts); init_configuration(); + init_fields_info(); + init_misc(); init_subrs(); diff --git a/scm/mu-scm.hh b/scm/mu-scm.hh index 83d6f4e3..00d19980 100644 --- a/scm/mu-scm.hh +++ b/scm/mu-scm.hh @@ -271,6 +271,8 @@ namespace Mu::Scm { } else if constexpr (std::is_same_v) return scm_from_bool(val); + else if constexpr (std::is_same_v) + return SCM_MAKE_CHAR(static_cast(val)); else if constexpr (std::is_same_v) return scm_from_size_t(val); else if constexpr (std::is_same_v) diff --git a/scm/mu-scm.scm b/scm/mu-scm.scm index 0efc7b92..5b2433e7 100644 --- a/scm/mu-scm.scm +++ b/scm/mu-scm.scm @@ -20,6 +20,7 @@ :use-module (oop goops) :use-module (system foreign) :use-module (rnrs bytevectors) + :use-module (srfi srfi-1) ;; lists :use-module (ice-9 optargs) :use-module (ice-9 format) :use-module (ice-9 binary-ports) @@ -102,6 +103,8 @@ ;; misc options configuration + fields + field %options ;; deprecated, use (options) @@ -635,9 +638,21 @@ init'. Uses the default-store." (set-documentation! '%configuration "Alist with the mu system configuration parameters.") (define (configuration) - "Alist with the mu system configuration parameters.." + "Alist with the mu system configuration parameters." %configuration) +%fields ;; defined in c++ +(set-documentation! '%fields + "Alist with information about mu database fields.") +(define (fields) + "Alist with information about mu database fields." + %fields) + +(define (field field-id) + "Get the information alist for FIELD-ID. +If FIELD does not exist, return #f." + (find (lambda(item) (eq? (assoc-ref item 'field) field-id)) (fields))) + (define %preferences '( (short-date . "%F %T") (utc? . #f))) diff --git a/scm/mu-scm.texi b/scm/mu-scm.texi index 86b1ea3e..ae829a1e 100644 --- a/scm/mu-scm.texi +++ b/scm/mu-scm.texi @@ -968,14 +968,58 @@ Other options may be added. @deffn {Scheme Procedure} configuration @end deffn -An association-list (alist) of the @t{mu} system configuration. This might look -something like: +An association-list (alist) of the @t{mu} system configuration, similar to what +you get with the @code{mu info} command. This might look something like: @lisp (configuration) -((mu-version . "1.14.3") (xapian-version . "1.4.30") (glib-version . "2.88.2") +=> ((mu-version . "1.14.3") (xapian-version . "1.4.30") (glib-version . "2.88.2") (gmime-version . "3.2.15") (scm-enabled? . #t) (language-enabled? . #t)) @end lisp + +@deffn {Scheme Procedure} fields +@end deffn + +An association-list (alist) with information about @t{mu}'s database fields, +similar to what you get with the @command{mu info fields} command. This looks something like: + +@lisp +(fields) +=> (((field . bcc) (name . "bcc") (shortcut . #\h) (value? . #t) (search-type . phrase)) +((field . body) (name . "body") (shortcut . #\b) (value? . #f) (search-type . phrase)) +((field . cc) (name . "cc") (shortcut . #\c) (value? . #t) (search-type . phrase)) +((field . changed) (name . "changed") (shortcut . #\k) (value? . #t) (search-type . range)) +((field . date) (name . "date") (shortcut . #\d) (value? . #t) (search-type . range)) +((field . embed) (name . "embed") (shortcut . #\e) (value? . #f) (search-type . phrase)) +((field . file) (name . "file") (shortcut . #\j) (value? . #f) (search-type . boolean)) +((field . flags) (name . "flags") (shortcut . #\g) (value? . #t) (search-type . boolean)) +((field . from) (name . "from") (shortcut . #\f) (value? . #t) (search-type . phrase)) +((field . language) (name . "language") (shortcut . #\a) (value? . #t) (search-type . boolean)) +((field . maildir) (name . "maildir") (shortcut . #\m) (value? . #t) (search-type . boolean)) +((field . list) (name . "list") (shortcut . #\v) (value? . #t) (search-type . boolean)) +((field . message-id) (name . "message-id") (shortcut . #\i) (value? . #t) (search-type . boolean)) +((field . mime) (name . "mime") (shortcut . #\y) (value? . #f) (search-type . boolean)) +((field . path) (name . "path") (shortcut . #\l) (value? . #t) (search-type . boolean)) +((field . priority) (name . "priority") (shortcut . #\p) (value? . #t) (search-type . boolean)) +((field . references) (name . "references") (shortcut . #\r) (value? . #t) (search-type . boolean)) +((field . size) (name . "size") (shortcut . #\z) (value? . #t) (search-type . range)) +((field . subject) (name . "subject") (shortcut . #\s) (value? . #t) (search-type . phrase)) +((field . tags) (name . "tags") (shortcut . #\x) (value? . #t) (search-type . boolean)) +((field . thread) (name . "thread") (shortcut . #\w) (value? . #t) (search-type . boolean)) +((field . to) (name . "to") (shortcut . #\t) (value? . #t) (search-type . phrase)) +((field . labels) (name . "labels") (shortcut . #\q) (value? . #t) (search-type . boolean))) +@end lisp + +@deffn {Scheme Procedure} field +@end deffn + +Gets information about one specific fields (from @code{fields}). E.g. + +@lisp +(field 'subject) +=> ((field . subject) (name . "subject") (shortcut . #\s) (value? . #t) (search-type . phrase)) +@end lisp + @c @defvar %preferences @c @end defvar