scm: new guile/scheme bindings
This implements the new scm/guile bindings for mu, to replace the deprecated guile/ (at some point in the future). For now, we allow for creating a guile shell with mu support.
This commit is contained in:
Dirk-Jan C. Binnema
@ -34,7 +34,7 @@ mu = executable(
|
|||||||
'mu-cmd-view.cc',
|
'mu-cmd-view.cc',
|
||||||
'mu-cmd.cc'
|
'mu-cmd.cc'
|
||||||
],
|
],
|
||||||
dependencies: [ glib_dep, gmime_dep, lib_mu_dep, thread_dep, config_h_dep ],
|
dependencies: [ glib_dep, gmime_dep, lib_mu_dep, mu_scm_dep, thread_dep, config_h_dep ],
|
||||||
cpp_args: ['-DMU_SCRIPTS_DIR="'+ join_paths(datadir, 'mu', 'scripts') + '"'],
|
cpp_args: ['-DMU_SCRIPTS_DIR="'+ join_paths(datadir, 'mu', 'scripts') + '"'],
|
||||||
install: true)
|
install: true)
|
||||||
#
|
#
|
||||||
|
|||||||
58
scm/meson.build
Normal file
58
scm/meson.build
Normal file
@ -0,0 +1,58 @@
|
|||||||
|
## Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
##
|
||||||
|
## This program is free software; you can redistribute it and/or modify
|
||||||
|
## it under the terms of the GNU General Public License as published by
|
||||||
|
## the Free Software Foundation; either version 3 of the License, or
|
||||||
|
## (at your option) any later version.
|
||||||
|
##
|
||||||
|
## This program is distributed in the hope that it will be useful,
|
||||||
|
## but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
## GNU General Public License for more details.
|
||||||
|
##
|
||||||
|
## You should have received a copy of the GNU General Public License
|
||||||
|
## along with this program; if not, write to the Free Software Foundation,
|
||||||
|
## Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
mu_scm_dir=join_paths(datadir, 'mu', 'scm')
|
||||||
|
mu_scm_dir_arg='-DMU_SCM_DIR="' + mu_scm_dir + '"'
|
||||||
|
|
||||||
|
lib_mu_scm=static_library(
|
||||||
|
'mu-scm',
|
||||||
|
[
|
||||||
|
'mu-scm.cc',
|
||||||
|
'mu-scm-contact.cc',
|
||||||
|
'mu-scm-store.cc'
|
||||||
|
],
|
||||||
|
dependencies: [
|
||||||
|
guile_dep,
|
||||||
|
config_h_dep,
|
||||||
|
lib_mu_dep,
|
||||||
|
lib_mu_utils_dep,
|
||||||
|
lib_mu_message_dep],
|
||||||
|
install: false,
|
||||||
|
cpp_args: [mu_scm_dir_arg])
|
||||||
|
|
||||||
|
install_data(['mu-scm.scm', 'mu-scm-shell.scm'], install_dir : mu_scm_dir)
|
||||||
|
|
||||||
|
# note: top-level meson.build defines a dummy replacement for this.
|
||||||
|
mu_scm_dep = declare_dependency(
|
||||||
|
link_with: lib_mu_scm,
|
||||||
|
dependencies: [guile_dep, lib_mu_dep, config_h_dep, thread_dep ],
|
||||||
|
include_directories:
|
||||||
|
include_directories(['.', '..']))
|
||||||
|
|
||||||
|
if makeinfo.found()
|
||||||
|
custom_target('mu_scm_info',
|
||||||
|
input: 'mu-scm.texi',
|
||||||
|
output: 'mu-scm.info',
|
||||||
|
install: true,
|
||||||
|
install_dir: infodir,
|
||||||
|
command: [makeinfo,
|
||||||
|
'-o', join_paths(meson.current_build_dir(), 'mu-scm.info'),
|
||||||
|
join_paths(meson.current_source_dir(), 'mu-scm.texi'),
|
||||||
|
'-I', join_paths(meson.current_build_dir(), '..')])
|
||||||
|
if install_info.found()
|
||||||
|
infodir = join_paths(get_option('prefix') / get_option('infodir'))
|
||||||
|
meson.add_install_script(install_info_script, infodir, 'mu-scm.info')
|
||||||
|
endif
|
||||||
|
endif
|
||||||
36
scm/mu-scm-contact.cc
Normal file
36
scm/mu-scm-contact.cc
Normal file
@ -0,0 +1,36 @@
|
|||||||
|
/*
|
||||||
|
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
**
|
||||||
|
** This program is free software; you can redistribute it and/or modify it
|
||||||
|
** under the terms of the GNU General Public License as published by the
|
||||||
|
** Free Software Foundation; either version 3, or (at your option) any
|
||||||
|
** later version.
|
||||||
|
**
|
||||||
|
** This program is distributed in the hope that it will be useful,
|
||||||
|
** but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
** GNU General Public License for more details.
|
||||||
|
**
|
||||||
|
** You should have received a copy of the GNU General Public License
|
||||||
|
** along with this program; if not, write to the Free Software Foundation,
|
||||||
|
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
**
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
#include "mu-scm-contact.hh"
|
||||||
|
|
||||||
|
using namespace Mu::Scm;
|
||||||
|
|
||||||
|
SCM
|
||||||
|
Mu::Scm::to_scm(const Contact& contact)
|
||||||
|
{
|
||||||
|
static SCM email{scm_from_utf8_symbol("email")};
|
||||||
|
static SCM name{scm_from_utf8_symbol("name")};
|
||||||
|
|
||||||
|
SCM alist = scm_acons(email, to_scm(contact.email), SCM_EOL);
|
||||||
|
if (!contact.name.empty())
|
||||||
|
alist = scm_acons(name, to_scm(contact.name), alist);
|
||||||
|
|
||||||
|
return alist;
|
||||||
|
}
|
||||||
38
scm/mu-scm-contact.hh
Normal file
38
scm/mu-scm-contact.hh
Normal file
@ -0,0 +1,38 @@
|
|||||||
|
/*
|
||||||
|
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
**
|
||||||
|
** This program is free software; you can redistribute it and/or modify it
|
||||||
|
** under the terms of the GNU General Public License as published by the
|
||||||
|
** Free Software Foundation; either version 3, or (at your option) any
|
||||||
|
** later version.
|
||||||
|
**
|
||||||
|
** This program is distributed in the hope that it will be useful,
|
||||||
|
** but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
** GNU General Public License for more details.
|
||||||
|
**
|
||||||
|
** You should have received a copy of the GNU General Public License
|
||||||
|
** along with this program; if not, write to the Free Software Foundation,
|
||||||
|
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
**
|
||||||
|
*/
|
||||||
|
|
||||||
|
#ifndef MU_SCM_CONTACT_HH
|
||||||
|
#define MU_SCM_CONTACT_HH
|
||||||
|
|
||||||
|
#include "message/mu-contact.hh"
|
||||||
|
#include "mu-scm.hh"
|
||||||
|
|
||||||
|
namespace Mu::Scm {
|
||||||
|
/**
|
||||||
|
* Convert a Contact to an SCM
|
||||||
|
*
|
||||||
|
* @param contact a contact
|
||||||
|
*
|
||||||
|
* @return SCM
|
||||||
|
*/
|
||||||
|
SCM to_scm(const Contact& contact);
|
||||||
|
|
||||||
|
} // Mu::Scm
|
||||||
|
|
||||||
|
#endif /*MU_SCM_CONTACT_HH*/
|
||||||
18
scm/mu-scm-shell.scm
Normal file
18
scm/mu-scm-shell.scm
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
;; Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
;;
|
||||||
|
;; This program is free software; you can redistribute it and/or modify it
|
||||||
|
;; under the terms of the GNU General Public License as published by the
|
||||||
|
;; Free Software Foundation; either version 3, or (at your option) any
|
||||||
|
;; later version.
|
||||||
|
;;
|
||||||
|
;; This program is distributed in the hope that it will be useful,
|
||||||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;; GNU General Public License for more details.
|
||||||
|
;;
|
||||||
|
;; You should have received a copy of the GNU General Public License
|
||||||
|
;; along with this program; if not, write to the Free Software Foundation,
|
||||||
|
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
|
||||||
|
(display "Welcome to the mu shell!\n\n")
|
||||||
|
(use-modules (mu))
|
||||||
156
scm/mu-scm-store.cc
Normal file
156
scm/mu-scm-store.cc
Normal file
@ -0,0 +1,156 @@
|
|||||||
|
/*
|
||||||
|
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
**
|
||||||
|
** This program is free software; you can redistribute it and/or modify it
|
||||||
|
** under the terms of the GNU General Public License as published by the
|
||||||
|
** Free Software Foundation; either version 3, or (at your option) any
|
||||||
|
** later version.
|
||||||
|
**
|
||||||
|
** This program is distributed in the hope that it will be useful,
|
||||||
|
** but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
** GNU General Public License for more details.
|
||||||
|
**
|
||||||
|
** You should have received a copy of the GNU General Public License
|
||||||
|
** along with this program; if not, write to the Free Software Foundation,
|
||||||
|
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
**
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include "mu-scm-store.hh"
|
||||||
|
#include "mu-scm-contact.hh"
|
||||||
|
|
||||||
|
using namespace Mu;
|
||||||
|
using namespace Mu::Scm;
|
||||||
|
|
||||||
|
// types
|
||||||
|
namespace {
|
||||||
|
static SCM store_type;
|
||||||
|
static SCM default_store;
|
||||||
|
static bool initialized;
|
||||||
|
}
|
||||||
|
|
||||||
|
static const Store&
|
||||||
|
to_store(SCM scm)
|
||||||
|
{
|
||||||
|
scm_assert_foreign_object_type(store_type, scm);
|
||||||
|
return *reinterpret_cast<Store*>(scm_foreign_object_ref(scm, 0));
|
||||||
|
}
|
||||||
|
|
||||||
|
static SCM
|
||||||
|
subr_mcount(SCM store_scm)
|
||||||
|
{
|
||||||
|
return to_scm(to_store(store_scm).size());
|
||||||
|
}
|
||||||
|
|
||||||
|
static SCM
|
||||||
|
subr_cfind(SCM store_scm, SCM pattern_scm, SCM personal_scm, SCM after_scm, SCM max_results_scm)
|
||||||
|
{
|
||||||
|
SCM contacts{SCM_EOL};
|
||||||
|
const auto pattern{from_scm<std::string>(pattern_scm)};
|
||||||
|
const auto personal{from_scm<bool>(personal_scm)};
|
||||||
|
const auto after{from_scm_with_default(after_scm, 0)};
|
||||||
|
|
||||||
|
// 0 means "unlimited"
|
||||||
|
const size_t maxnum = from_scm_with_default(max_results_scm, 0U);
|
||||||
|
|
||||||
|
to_store(store_scm).contacts_cache().for_each(
|
||||||
|
[&](const auto& contact)->bool {
|
||||||
|
contacts = scm_append_x(scm_list_2(contacts, scm_list_1(to_scm(contact))));
|
||||||
|
return true;
|
||||||
|
}, pattern, personal, after, maxnum);
|
||||||
|
return contacts;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Field::Id
|
||||||
|
to_sort_field_id(SCM field)
|
||||||
|
{
|
||||||
|
if (scm_is_false(field))
|
||||||
|
return Field::Id::Date;
|
||||||
|
|
||||||
|
const auto sym{from_scm<std::string>(scm_symbol_to_string(field))};
|
||||||
|
if (const auto field_opt{field_from_name(sym)}; !field_opt) {
|
||||||
|
raise_error("invalid symbol", "mfind",
|
||||||
|
"expected sort-field symbol, but got {}", sym);
|
||||||
|
return Field::Id::Date;
|
||||||
|
} else
|
||||||
|
return field_opt->id;
|
||||||
|
}
|
||||||
|
|
||||||
|
static SCM
|
||||||
|
subr_mfind(SCM store_scm, SCM query_scm, SCM related_scm, SCM skip_dups_scm,
|
||||||
|
SCM sort_field_scm, SCM reverse_scm, SCM max_results_scm)
|
||||||
|
{
|
||||||
|
const auto& store{to_store(store_scm)};
|
||||||
|
const auto query{from_scm<std::string>(query_scm)};
|
||||||
|
const auto related(from_scm<bool>(related_scm));
|
||||||
|
const auto skip_dups(from_scm<bool>(skip_dups_scm));
|
||||||
|
const auto reverse(from_scm<bool>(reverse_scm));
|
||||||
|
|
||||||
|
SCM_ASSERT_TYPE(scm_is_false(sort_field_scm) || scm_is_symbol(sort_field_scm),
|
||||||
|
sort_field_scm, SCM_ARG5, __func__, "symbol or #f");
|
||||||
|
|
||||||
|
const auto sort_field_id = to_sort_field_id(sort_field_scm);
|
||||||
|
|
||||||
|
// 0 means "unlimited"
|
||||||
|
const size_t maxnum = from_scm_with_default(max_results_scm, 0U);
|
||||||
|
|
||||||
|
// XXX date/reverse/maxnum
|
||||||
|
|
||||||
|
const QueryFlags qflags = QueryFlags::SkipUnreadable |
|
||||||
|
(skip_dups ? QueryFlags::SkipDuplicates : QueryFlags::None) |
|
||||||
|
(related ? QueryFlags::IncludeRelated: QueryFlags::None ) |
|
||||||
|
(reverse ? QueryFlags::Descending : QueryFlags::None);
|
||||||
|
|
||||||
|
SCM msgs{SCM_EOL};
|
||||||
|
std::lock_guard lock{store.lock()};
|
||||||
|
const auto qres = store.run_query(query, sort_field_id, qflags, maxnum);
|
||||||
|
|
||||||
|
SCM_ASSERT(qres, query_scm, SCM_ARG1, __func__);
|
||||||
|
|
||||||
|
for (const auto& mi: *qres) {
|
||||||
|
if (auto plist{mi.document()->get_data()}; plist.empty())
|
||||||
|
continue;
|
||||||
|
else {
|
||||||
|
SCM scm_plist{scm_c_eval_string(("'" + plist).c_str())};
|
||||||
|
msgs = scm_append_x(scm_list_2( msgs, scm_list_1(scm_plist)));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return msgs;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void
|
||||||
|
init_subrs()
|
||||||
|
{
|
||||||
|
#pragma GCC diagnostic push
|
||||||
|
#pragma GCC diagnostic ignored "-Wcast-function-type"
|
||||||
|
scm_c_define_gsubr("store-mfind", 7/*req*/, 0/*opt*/, 0/*rst*/,
|
||||||
|
reinterpret_cast<scm_t_subr>(subr_mfind));
|
||||||
|
scm_c_define_gsubr("store-mcount", 1/*req*/, 0/*opt*/, 0/*rst*/,
|
||||||
|
reinterpret_cast<scm_t_subr>(subr_mcount));
|
||||||
|
scm_c_define_gsubr("store-cfind", 5/*req*/, 0/*opt*/, 0/*rst*/,
|
||||||
|
reinterpret_cast<scm_t_subr>(subr_cfind));
|
||||||
|
#pragma GCC diagnostic pop
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
void
|
||||||
|
Mu::Scm::init_store(const Store& store)
|
||||||
|
{
|
||||||
|
if (initialized)
|
||||||
|
return;
|
||||||
|
|
||||||
|
store_type = scm_make_foreign_object_type(
|
||||||
|
scm_from_utf8_symbol("store"),
|
||||||
|
scm_list_1 (scm_from_utf8_symbol("data")),
|
||||||
|
{}); // no finalizer
|
||||||
|
|
||||||
|
default_store = scm_make_foreign_object_1(
|
||||||
|
store_type, const_cast<Store*>(&store));
|
||||||
|
scm_c_define("default-store-object", default_store);
|
||||||
|
|
||||||
|
init_subrs();
|
||||||
|
|
||||||
|
initialized = true;
|
||||||
|
}
|
||||||
30
scm/mu-scm-store.hh
Normal file
30
scm/mu-scm-store.hh
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
/*
|
||||||
|
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
**
|
||||||
|
** This program is free software; you can redistribute it and/or modify it
|
||||||
|
** under the terms of the GNU General Public License as published by the
|
||||||
|
** Free Software Foundation; either version 3, or (at your option) any
|
||||||
|
** later version.
|
||||||
|
**
|
||||||
|
** This program is distributed in the hope that it will be useful,
|
||||||
|
** but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
** GNU General Public License for more details.
|
||||||
|
**
|
||||||
|
** You should have received a copy of the GNU General Public License
|
||||||
|
** along with this program; if not, write to the Free Software Foundation,
|
||||||
|
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
**
|
||||||
|
*/
|
||||||
|
|
||||||
|
#ifndef MU_SCM_STORE_HH
|
||||||
|
#define MU_SCM_STORE_HH
|
||||||
|
|
||||||
|
#include "lib/mu-store.hh"
|
||||||
|
#include "mu-scm.hh"
|
||||||
|
|
||||||
|
namespace Mu::Scm {
|
||||||
|
void init_store(const Mu::Store& store);
|
||||||
|
} // Mu::Scm
|
||||||
|
|
||||||
|
#endif /*MU_SCM_STORE_HH*/
|
||||||
160
scm/mu-scm.cc
Normal file
160
scm/mu-scm.cc
Normal file
@ -0,0 +1,160 @@
|
|||||||
|
/*
|
||||||
|
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
**
|
||||||
|
** This program is free software; you can redistribute it and/or modify it
|
||||||
|
** under the terms of the GNU General Public License as published by the
|
||||||
|
** Free Software Foundation; either version 3, or (at your option) any
|
||||||
|
** later version.
|
||||||
|
**
|
||||||
|
** This program is distributed in the hope that it will be useful,
|
||||||
|
** but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
** GNU General Public License for more details.
|
||||||
|
**
|
||||||
|
** You should have received a copy of the GNU General Public License
|
||||||
|
** along with this program; if not, write to the Free Software Foundation,
|
||||||
|
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
**
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include "mu-scm.hh"
|
||||||
|
|
||||||
|
#include <unistd.h>
|
||||||
|
#include <errno.h>
|
||||||
|
|
||||||
|
#include "mu-utils.hh"
|
||||||
|
#include "config.h"
|
||||||
|
|
||||||
|
#include "mu-scm-contact.hh"
|
||||||
|
#include "mu-scm-store.hh"
|
||||||
|
|
||||||
|
using namespace Mu;
|
||||||
|
using namespace Mu::Scm;
|
||||||
|
|
||||||
|
namespace {
|
||||||
|
static const Mu::Scm::Config *config{};
|
||||||
|
static SCM mu_mod; // The mu module
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Create a plist for the relevant configuration items
|
||||||
|
*
|
||||||
|
* @param opts
|
||||||
|
*/
|
||||||
|
static void
|
||||||
|
init_config (const Options& opts)
|
||||||
|
{
|
||||||
|
scm_c_define("options",
|
||||||
|
alist_add(
|
||||||
|
SCM_EOL,
|
||||||
|
make_symbol("mu-home"), opts.muhome,
|
||||||
|
make_symbol("verbose"), opts.verbose,
|
||||||
|
make_symbol("debug"), opts.debug,
|
||||||
|
make_symbol("quiet"), opts.quiet));
|
||||||
|
}
|
||||||
|
|
||||||
|
static void
|
||||||
|
init_module_mu(void* _data)
|
||||||
|
{
|
||||||
|
init_config(config->options);
|
||||||
|
init_store(config->store);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const Result<std::string>
|
||||||
|
make_mu_scm_path(const std::string& fname) {
|
||||||
|
|
||||||
|
const std::string dir = []() {
|
||||||
|
if (const char *altpath{::getenv("MU_SCM_DIR")}; altpath)
|
||||||
|
return altpath;
|
||||||
|
else
|
||||||
|
return MU_SCM_DIR;
|
||||||
|
}();
|
||||||
|
|
||||||
|
auto fpath{join_paths(dir, fname)};
|
||||||
|
if (::access(fpath.c_str(), R_OK) != 0)
|
||||||
|
return Err(Error::Code::File, "cannot read {}: {}",
|
||||||
|
fpath, ::strerror(errno));
|
||||||
|
else
|
||||||
|
return Ok(std::move(fpath));
|
||||||
|
}
|
||||||
|
|
||||||
|
namespace {
|
||||||
|
static std::string mu_scm_path;
|
||||||
|
static std::string mu_scm_shell_path;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
static Result<void>
|
||||||
|
prepare_run(const Mu::Scm::Config& conf)
|
||||||
|
{
|
||||||
|
if (config)
|
||||||
|
return Err(Error{Error::Code::AccessDenied,
|
||||||
|
"already prepared"});
|
||||||
|
config = &conf;
|
||||||
|
|
||||||
|
// do a checks _before_ entering guile, so we get a bit more civilized
|
||||||
|
// error message.
|
||||||
|
|
||||||
|
if (const auto path = make_mu_scm_path("mu-scm.scm"); path)
|
||||||
|
mu_scm_path = *path;
|
||||||
|
else
|
||||||
|
return Err(path.error());
|
||||||
|
|
||||||
|
if (const auto path = make_mu_scm_path("mu-scm-shell.scm"); path)
|
||||||
|
mu_scm_shell_path = *path;
|
||||||
|
else
|
||||||
|
return Err(path.error());
|
||||||
|
|
||||||
|
|
||||||
|
if (config->options.scm.script_path) {
|
||||||
|
const auto path{config->options.scm.script_path->c_str()};
|
||||||
|
if (const auto res = ::access(path, R_OK); res != 0) {
|
||||||
|
return Err(Error::Code::InvalidArgument,
|
||||||
|
"cannot read '{}': {}", path, ::strerror(errno));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
return Ok();
|
||||||
|
}
|
||||||
|
|
||||||
|
Result<void>
|
||||||
|
Mu::Scm::run(const Mu::Scm::Config& conf) {
|
||||||
|
|
||||||
|
if (const auto res = prepare_run(conf); !res)
|
||||||
|
return Err(res.error());
|
||||||
|
|
||||||
|
scm_boot_guile(0, {}, [](void *data, int argc, char **argv) {
|
||||||
|
mu_mod = scm_c_define_module ("mu", init_module_mu, {});
|
||||||
|
|
||||||
|
std::vector<const char*> args {
|
||||||
|
"mu",
|
||||||
|
"-l", mu_scm_path.c_str(),
|
||||||
|
};
|
||||||
|
std::string cmd;
|
||||||
|
const auto opts{config->options.scm};
|
||||||
|
// if a script-path was specified, run a script
|
||||||
|
if (opts.script_path) {
|
||||||
|
// XXX: couldn't get another combination of -l/-s/-e/-c to work
|
||||||
|
// a) invokes `main' with arguments, and
|
||||||
|
// b) exits (rather than drop to a shell)
|
||||||
|
// but, what works is to manually specify (main ....)
|
||||||
|
cmd = "(main " + quote(*opts.script_path);
|
||||||
|
for (const auto& scriptarg : opts.params)
|
||||||
|
cmd += " " + quote(scriptarg);
|
||||||
|
cmd += ")";
|
||||||
|
for (const auto& arg: {
|
||||||
|
"-l", opts.script_path->c_str(),
|
||||||
|
"-c", cmd.c_str()})
|
||||||
|
args.emplace_back(arg);
|
||||||
|
} else {
|
||||||
|
// otherwise, drop us into an interactive shell/repl (and
|
||||||
|
// shell spec)
|
||||||
|
args.emplace_back("-l");
|
||||||
|
args.emplace_back(mu_scm_shell_path.c_str());
|
||||||
|
}
|
||||||
|
/* ahem...*/
|
||||||
|
scm_shell(std::size(args), const_cast<char**>(args.data()));
|
||||||
|
}, {}); // never returns.
|
||||||
|
|
||||||
|
return Ok();
|
||||||
|
}
|
||||||
242
scm/mu-scm.hh
Normal file
242
scm/mu-scm.hh
Normal file
@ -0,0 +1,242 @@
|
|||||||
|
/*
|
||||||
|
** Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
**
|
||||||
|
** This program is free software; you can redistribute it and/or modify it
|
||||||
|
** under the terms of the GNU General Public License as published by the
|
||||||
|
** Free Software Foundation; either version 3, or (at your option) any
|
||||||
|
** later version.
|
||||||
|
**
|
||||||
|
** This program is distributed in the hope that it will be useful,
|
||||||
|
** but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
** GNU General Public License for more details.
|
||||||
|
**
|
||||||
|
** You should have received a copy of the GNU General Public License
|
||||||
|
** along with this program; if not, write to the Free Software Foundation,
|
||||||
|
** Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
**
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
#ifndef MU_SCM_HH
|
||||||
|
#define MU_SCM_HH
|
||||||
|
|
||||||
|
#include <string>
|
||||||
|
#include <string_view>
|
||||||
|
#include <type_traits>
|
||||||
|
|
||||||
|
#pragma GCC diagnostic push
|
||||||
|
#pragma GCC diagnostic ignored "-Wredundant-decls"
|
||||||
|
#include <libguile.h>
|
||||||
|
#pragma GCC diagnostic pop
|
||||||
|
|
||||||
|
#include "utils/mu-result.hh"
|
||||||
|
#include "mu/mu-options.hh"
|
||||||
|
#include "mu-store.hh"
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Namespace for the Scm (Guile) subsystem
|
||||||
|
*
|
||||||
|
*/
|
||||||
|
namespace Mu::Scm {
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Configuration object
|
||||||
|
*
|
||||||
|
*/
|
||||||
|
struct Config {
|
||||||
|
const Mu::Store& store;
|
||||||
|
const Options& options;
|
||||||
|
};
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Start a guile shell
|
||||||
|
*
|
||||||
|
* Initialize the Scm sub-system, then start a shell or run a script,
|
||||||
|
* based on the configuration.
|
||||||
|
*
|
||||||
|
* @param conf a Config object
|
||||||
|
*
|
||||||
|
* @return Ok() or some error
|
||||||
|
*/
|
||||||
|
Result<void> run(const Config& conf);
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Helpers
|
||||||
|
*
|
||||||
|
* @{*/
|
||||||
|
|
||||||
|
// https://www.open-std.org/jtc1/sc22/wg21/docs/papers/2022/p2593r0.html
|
||||||
|
template<typename T> struct always_false : std::false_type {};
|
||||||
|
|
||||||
|
template<typename T> constexpr bool is_char_array_v =
|
||||||
|
std::is_array_v<T> &&
|
||||||
|
std::is_same_v<std::remove_extent_t<T>, char>;
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Make SCM symbol from string-like value
|
||||||
|
*
|
||||||
|
* @param val some value
|
||||||
|
*
|
||||||
|
* @return an SCM symbol
|
||||||
|
*/
|
||||||
|
template<typename T>
|
||||||
|
SCM make_symbol(const T& val){
|
||||||
|
using Type = std::remove_const_t<T>; // *not* std::remove_const
|
||||||
|
if constexpr (std::is_same_v<Type, std::string> ||
|
||||||
|
std::is_same_v<Type, std::string_view>)
|
||||||
|
return scm_from_utf8_symboln(val.data(), val.size());
|
||||||
|
else if constexpr (is_char_array_v<Type>|| std::is_same_v<Type, const char*>)
|
||||||
|
return scm_from_utf8_symbol(val);
|
||||||
|
else {
|
||||||
|
static_assert(always_false<Type>::value, "source type not supported");
|
||||||
|
return SCM_UNSPECIFIED;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Get some C++ value from an SCM object, generically.
|
||||||
|
*
|
||||||
|
* @param ARG some SCM object
|
||||||
|
*
|
||||||
|
* @return C++ value
|
||||||
|
*/
|
||||||
|
template<typename T>
|
||||||
|
T from_scm(SCM ARG) {
|
||||||
|
using Type = std::remove_const_t<T>; // *not* std::remove_const
|
||||||
|
if constexpr (std::is_same_v<Type, std::string>) {
|
||||||
|
SCM_ASSERT(scm_string_p(ARG), ARG, SCM_ARG1, __func__);
|
||||||
|
auto str{scm_to_utf8_string(ARG)};
|
||||||
|
std::string res{str};
|
||||||
|
::free(str);
|
||||||
|
return res;
|
||||||
|
} else if constexpr (std::is_same_v<Type, char>) {
|
||||||
|
SCM_ASSERT(scm_char_p(ARG), ARG, SCM_ARG1, __func__);
|
||||||
|
return scm_to_char(ARG);
|
||||||
|
} else if constexpr (std::is_same_v<Type, bool>) {
|
||||||
|
SCM_ASSERT(scm_boolean_p(ARG), ARG, SCM_ARG1, __func__);
|
||||||
|
return scm_to_bool(ARG);
|
||||||
|
} else if constexpr (std::is_same_v<Type, int>) {
|
||||||
|
SCM_ASSERT(scm_is_signed_integer(ARG, std::numeric_limits<int>::min(),
|
||||||
|
std::numeric_limits<int>::max()),
|
||||||
|
ARG, SCM_ARG1, __func__);
|
||||||
|
return scm_to_int(ARG);
|
||||||
|
} else if constexpr (std::is_same_v<Type, uint>) {
|
||||||
|
SCM_ASSERT(scm_is_unsigned_integer(ARG, std::numeric_limits<uint>::min(),
|
||||||
|
std::numeric_limits<uint>::max()),
|
||||||
|
ARG, SCM_ARG1, __func__);
|
||||||
|
return scm_to_uint(ARG);
|
||||||
|
} else if constexpr (std::is_same_v<Type, SCM>) {
|
||||||
|
return ARG;
|
||||||
|
} else {
|
||||||
|
static_assert(always_false<Type>::value, "target type not supported");
|
||||||
|
return {};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/**
|
||||||
|
* Like from_SCM, but if ARG is boolean false, return default value.
|
||||||
|
*
|
||||||
|
* @param ARG argument
|
||||||
|
* @param default_value default value
|
||||||
|
*
|
||||||
|
* @return value
|
||||||
|
*/
|
||||||
|
template<typename T>
|
||||||
|
T from_scm_with_default(SCM ARG, const T default_value) {
|
||||||
|
return (scm_is_bool(ARG) && scm_is_false(ARG)) ? default_value : from_scm<T>(ARG);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Get some SCM from a C++ value, generically.
|
||||||
|
*
|
||||||
|
* @param val some C++ object
|
||||||
|
*
|
||||||
|
* @return an SCM
|
||||||
|
*/
|
||||||
|
template<typename T>
|
||||||
|
SCM to_scm(const T& val) {
|
||||||
|
using Type = std::remove_const_t<T>;
|
||||||
|
if constexpr (std::is_same_v<Type, std::string> ||
|
||||||
|
std::is_same_v<Type, std::string_view>)
|
||||||
|
return scm_from_utf8_stringn(val.data(), val.size());
|
||||||
|
else if constexpr (is_char_array_v<Type>|| std::is_same_v<Type, const char*>)
|
||||||
|
return scm_from_utf8_string(val);
|
||||||
|
else if constexpr (std::is_same_v<Type, bool>)
|
||||||
|
return scm_from_bool(val);
|
||||||
|
else if constexpr (std::is_same_v<Type, size_t>)
|
||||||
|
return scm_from_size_t(val);
|
||||||
|
else if constexpr (std::is_same_v<Type, int64_t>)
|
||||||
|
return scm_from_int64(val);
|
||||||
|
else if constexpr (std::is_same_v<Type, uint64_t>)
|
||||||
|
return scm_from_uint64(val);
|
||||||
|
else if constexpr (std::is_same_v<Type, SCM>)
|
||||||
|
return val;
|
||||||
|
else {
|
||||||
|
static_assert(always_false<Type>::value,
|
||||||
|
"source type not supported");
|
||||||
|
return SCM_UNSPECIFIED;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// base case.
|
||||||
|
static inline SCM alist_add(SCM alist) {
|
||||||
|
return alist;
|
||||||
|
}
|
||||||
|
/**
|
||||||
|
* Add key-value pair to an alist
|
||||||
|
*
|
||||||
|
* This assumes that keys are unique ("acons")
|
||||||
|
*
|
||||||
|
* @param alist some alist
|
||||||
|
* @param key key
|
||||||
|
* @param val value
|
||||||
|
* @param keyvals... 0 or more key, value parmeters
|
||||||
|
*
|
||||||
|
* @return the updated alist
|
||||||
|
*/
|
||||||
|
template<typename Key, typename Value, typename... KeyVals>
|
||||||
|
static inline SCM alist_add(SCM alist, const Key& key, const Value& val,
|
||||||
|
KeyVals... keyvals) {
|
||||||
|
SCM res = scm_acons(to_scm(key), to_scm(val), alist);
|
||||||
|
return alist_add(res, std::forward<KeyVals>(keyvals)...);
|
||||||
|
}
|
||||||
|
|
||||||
|
/**
|
||||||
|
* Make an SCM error
|
||||||
|
*
|
||||||
|
* @param err name of the error
|
||||||
|
* @param subr function name
|
||||||
|
* @param frm... args format string
|
||||||
|
*
|
||||||
|
* @return an error (type)
|
||||||
|
*/
|
||||||
|
template<typename...T>
|
||||||
|
void raise_error(const std::string& err,
|
||||||
|
const std::string& subr,
|
||||||
|
fmt::format_string<T...> frm, T&&... args) noexcept {
|
||||||
|
static SCM mu_scm_error = scm_from_utf8_symbol("mu-scm-error");
|
||||||
|
scm_error(mu_scm_error,
|
||||||
|
subr.c_str(),
|
||||||
|
fmt::format(frm, std::forward<T>(args)...).c_str(),
|
||||||
|
SCM_BOOL_F, SCM_BOOL_F);
|
||||||
|
}
|
||||||
|
|
||||||
|
/**@}*/
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/**
|
||||||
|
* SCM formatter, for use with fmt
|
||||||
|
*
|
||||||
|
* @param scm some object
|
||||||
|
*
|
||||||
|
* @return string representation of scm
|
||||||
|
*/
|
||||||
|
// static inline std::string format_as(SCM scm) {
|
||||||
|
// return Mu::Scm::from_scm<std::string>(scm_object_to_string(scm, SCM_UNSPECIFIED));
|
||||||
|
// }
|
||||||
|
// XXX doesn't work:
|
||||||
|
// "static assertion failed: Formatting of non-void pointers is disallowed"
|
||||||
|
|
||||||
|
#endif /*MU_SCM_HH*/
|
||||||
384
scm/mu-scm.scm
Normal file
384
scm/mu-scm.scm
Normal file
@ -0,0 +1,384 @@
|
|||||||
|
;; Copyright (C) 2025 Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
||||||
|
;;
|
||||||
|
;; This program is free software; you can redistribute it and/or modify it
|
||||||
|
;; under the terms of the GNU General Public License as published by the
|
||||||
|
;; Free Software Foundation; either version 3, or (at your option) any
|
||||||
|
;; later version.
|
||||||
|
;;
|
||||||
|
;; This program is distributed in the hope that it will be useful,
|
||||||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;; GNU General Public License for more details.
|
||||||
|
;;
|
||||||
|
;; You should have received a copy of the GNU General Public License
|
||||||
|
;; along with this program; if not, write to the Free Software Foundation,
|
||||||
|
;; Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||||
|
|
||||||
|
;; Note: this Scheme code depends on being loaded as part of "mu scm"
|
||||||
|
;; which does so automatically. It is not a general Guile module.
|
||||||
|
|
||||||
|
(define-module (mu)
|
||||||
|
:use-module (oop goops)
|
||||||
|
:use-module (system foreign)
|
||||||
|
:use-module (ice-9 optargs)
|
||||||
|
#:export (
|
||||||
|
;; classes
|
||||||
|
<store>
|
||||||
|
*default-store*
|
||||||
|
|
||||||
|
mfind
|
||||||
|
mcount
|
||||||
|
cfind
|
||||||
|
|
||||||
|
<message>
|
||||||
|
sexp
|
||||||
|
|
||||||
|
date
|
||||||
|
iso-date
|
||||||
|
last-change
|
||||||
|
|
||||||
|
message-id
|
||||||
|
path
|
||||||
|
priority
|
||||||
|
subject
|
||||||
|
|
||||||
|
language
|
||||||
|
size
|
||||||
|
|
||||||
|
;; message flags / predicates
|
||||||
|
flags
|
||||||
|
flag?
|
||||||
|
draft?
|
||||||
|
flagged?
|
||||||
|
passed?
|
||||||
|
replied?
|
||||||
|
seen?
|
||||||
|
trashed?
|
||||||
|
new?
|
||||||
|
signed?
|
||||||
|
encrypted?
|
||||||
|
attach?
|
||||||
|
unread?
|
||||||
|
list?
|
||||||
|
personal?
|
||||||
|
calendar?
|
||||||
|
|
||||||
|
;; contact fields
|
||||||
|
from
|
||||||
|
to
|
||||||
|
cc
|
||||||
|
bcc
|
||||||
|
|
||||||
|
;; helpers
|
||||||
|
iso-date->time-t
|
||||||
|
time-t->iso-date))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; some helpers for dealing with plists / alists
|
||||||
|
(define (plist-for-each func plist)
|
||||||
|
"Call FUNC for each key/value in the PLIST.
|
||||||
|
PLIST is a property-list with alternating key and value.
|
||||||
|
Stops when FUNC returns #f."
|
||||||
|
(when (and (not (null? plist))
|
||||||
|
(func (car plist) (cadr plist)))
|
||||||
|
(plist-for-each func (cddr plist))))
|
||||||
|
|
||||||
|
(define (plist-find plist key)
|
||||||
|
"Find the value for the first occurrence of KEY in PLIST.
|
||||||
|
If not found, return #f."
|
||||||
|
(let ((val #f))
|
||||||
|
(plist-for-each
|
||||||
|
(lambda (k v)
|
||||||
|
(if (eq? k key)
|
||||||
|
(begin
|
||||||
|
(set! val v) #f)
|
||||||
|
#t))
|
||||||
|
plist)
|
||||||
|
val))
|
||||||
|
|
||||||
|
(define (decolonize-symbol sym)
|
||||||
|
"Remove :-prefix from symbol."
|
||||||
|
(let ((name (symbol->string sym)))
|
||||||
|
(if (string-prefix? ":" name)
|
||||||
|
(string->symbol (string-drop name 1))
|
||||||
|
sym)))
|
||||||
|
|
||||||
|
(define (plist->alist plist)
|
||||||
|
"Convert a plist into an alist."
|
||||||
|
(let ((alist '()))
|
||||||
|
(plist-for-each
|
||||||
|
(lambda (k v)
|
||||||
|
(set! alist
|
||||||
|
(append! alist
|
||||||
|
(list (cons (decolonize-symbol k)
|
||||||
|
v)))))
|
||||||
|
plist)
|
||||||
|
alist))
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; Message
|
||||||
|
;;
|
||||||
|
;; A <message> is created from a message plist.
|
||||||
|
|
||||||
|
;; In mu, we have store a plist sexp for each message in the database,
|
||||||
|
;; for use with mu4e. But, that very plist is useful here as well.
|
||||||
|
(define-class <message> ()
|
||||||
|
(plist #:init-keyword #:plist #:getter plist))
|
||||||
|
|
||||||
|
;; using the plist as-is makes for O(n) access to the various fields
|
||||||
|
|
||||||
|
(define-method (find-field (message <message>) field)
|
||||||
|
(plist-find (plist message) field))
|
||||||
|
|
||||||
|
(define-method (sexp (message <message>))
|
||||||
|
"Get the s-expression (plist) for this MESSAGE.
|
||||||
|
|
||||||
|
This is an internal data-structure, originally for use with mu4e, but useful
|
||||||
|
here as well. However, the precise details are not part of mu-scm API."
|
||||||
|
(plist message))
|
||||||
|
|
||||||
|
(define (emacs-time->epoch-secs lst)
|
||||||
|
"Convert emacs-style timestamp LST to a number of seconds since epoch.
|
||||||
|
If LST is #f, return #f."
|
||||||
|
(if lst
|
||||||
|
(+ (ash (car lst) 16) (cadr lst))
|
||||||
|
#f))
|
||||||
|
|
||||||
|
;; Accessor for the fields
|
||||||
|
|
||||||
|
(define-method (subject (message <message>))
|
||||||
|
"Get the subject for MESSAGE or #f if not found."
|
||||||
|
(find-field message ':subject))
|
||||||
|
|
||||||
|
(define-method (maildir (message <message>))
|
||||||
|
"Get the maildir for MESSAGE or #f if not found."
|
||||||
|
(find-field message ':maildir))
|
||||||
|
|
||||||
|
(define-method (message-id (message <message>))
|
||||||
|
"Get the message-id for MESSAGE or #f if not found."
|
||||||
|
(find-field message ':message-id))
|
||||||
|
|
||||||
|
(define-method (date (message <message>))
|
||||||
|
"Get the date for MESSAGE was sent.
|
||||||
|
This is the number of seconds since epoch; #f if not found."
|
||||||
|
(emacs-time->epoch-secs (find-field message ':date)))
|
||||||
|
|
||||||
|
(define-method (last-change (message <message>))
|
||||||
|
"Get the date for the last change to MESSAGE.
|
||||||
|
This is the number of seconds since epoch; #f if not found."
|
||||||
|
(emacs-time->epoch-secs (find-field message ':changed)))
|
||||||
|
|
||||||
|
(define-method (path (message <message>))
|
||||||
|
"Get the file-system path for MESSAGE.
|
||||||
|
A symbol, either 'high, 'low or 'normal, or #f if not found."
|
||||||
|
(find-field message ':path))
|
||||||
|
|
||||||
|
(define-method (priority (message <message>))
|
||||||
|
"Get the priority for MESSAGE.
|
||||||
|
A symbol, either 'high, 'low or 'normal, or #f if not found."
|
||||||
|
(find-field message ':priority))
|
||||||
|
|
||||||
|
(define-method (language (message <message>))
|
||||||
|
"Get the ISO-639-1 language code for the message as a symbol, if detected.
|
||||||
|
Return #f otherwise."
|
||||||
|
(let ((lang (find-field message ':language)))
|
||||||
|
(if lang
|
||||||
|
(string->symbol lang)
|
||||||
|
#f)))
|
||||||
|
;; if-let would be nice!
|
||||||
|
|
||||||
|
(define-method (size (message <message>))
|
||||||
|
"Get the size of the message in bytes or #f if not available."
|
||||||
|
(find-field message ':size))
|
||||||
|
|
||||||
|
;; Flags.
|
||||||
|
|
||||||
|
(define-method (flags (message <message>))
|
||||||
|
"Get the size of the message in bytes or #f if not available."
|
||||||
|
(find-field message ':flags))
|
||||||
|
|
||||||
|
(define-method (flag? (message <message>) flag)
|
||||||
|
"Does MESSAGE have FLAG?."
|
||||||
|
(let ((flags
|
||||||
|
(find-field message ':flags)))
|
||||||
|
(if flags
|
||||||
|
(if (member flag flags) #t #f)
|
||||||
|
#f)))
|
||||||
|
|
||||||
|
(define-method (draft? (message <message>))
|
||||||
|
"Is MESSAGE a draft message?"
|
||||||
|
(flag? message 'draft))
|
||||||
|
|
||||||
|
(define-method (flagged? (message <message>))
|
||||||
|
"Is MESSAGE flagged?"
|
||||||
|
(flag? message 'flagged))
|
||||||
|
|
||||||
|
(define-method (passed? (message <message>))
|
||||||
|
"Has MESSAGE message been 'passed' (forwarded)?"
|
||||||
|
(flag? message 'passed))
|
||||||
|
|
||||||
|
(define-method (replied? (message <message>))
|
||||||
|
"Has MESSAGE been replied to?"
|
||||||
|
(flag? message 'replied))
|
||||||
|
|
||||||
|
(define-method (seen? (message <message>))
|
||||||
|
"Does MESSAGE been 'seen' (read)?"
|
||||||
|
(flag? message 'seen))
|
||||||
|
|
||||||
|
(define-method (trashed? (message <message>))
|
||||||
|
"Has MESSAGE been trashed?"
|
||||||
|
(flag? message 'trashed))
|
||||||
|
|
||||||
|
(define-method (new? (message <message>))
|
||||||
|
"Is MESSAGE new?"
|
||||||
|
(flag? message 'new))
|
||||||
|
|
||||||
|
(define-method (signed? (message <message>))
|
||||||
|
"Has MESSAGE been cryptographically signed?"
|
||||||
|
(flag? message 'signed))
|
||||||
|
|
||||||
|
(define-method (encrypted? (message <message>))
|
||||||
|
"Has MESSAGE been encrypted?"
|
||||||
|
(flag? message 'encrypted))
|
||||||
|
|
||||||
|
(define-method (attach? (message <message>))
|
||||||
|
"Does MESSAGE have an attachment?"
|
||||||
|
(flag? message 'attach))
|
||||||
|
|
||||||
|
(define-method (unread? (message <message>))
|
||||||
|
"Is MESSAGE unread?"
|
||||||
|
(flag? message 'unread))
|
||||||
|
|
||||||
|
(define-method (list? (message <message>))
|
||||||
|
"Is MESSAGE from some mailing-list?"
|
||||||
|
(flag? message 'list))
|
||||||
|
|
||||||
|
(define-method (personal? (message <message>))
|
||||||
|
"Is MESSAGE personal?"
|
||||||
|
(flag? message 'personal))
|
||||||
|
|
||||||
|
(define-method (calendar? (message <message>))
|
||||||
|
"Does MESSAGE have a calender invitation?"
|
||||||
|
(flag? message 'calendar))
|
||||||
|
|
||||||
|
(define-method (find-contact-field (message <message>) field)
|
||||||
|
"Get contact FIELD from MESSAGE as an alist.
|
||||||
|
Helper method "
|
||||||
|
(let ((cs (find-field message field)))
|
||||||
|
(if cs
|
||||||
|
(map plist->alist cs)
|
||||||
|
#f)))
|
||||||
|
|
||||||
|
(define-method (from (message <message>))
|
||||||
|
"Get the sender (the From: field) for MESSAGE or #f if not found."
|
||||||
|
(find-contact-field message ':from))
|
||||||
|
|
||||||
|
(define-method (to (message <message>))
|
||||||
|
"Get the (intended) recipient for MESSAGE (the To: field) or #f if not found."
|
||||||
|
(find-contact-field message ':to))
|
||||||
|
|
||||||
|
(define-method (cc (message <message>))
|
||||||
|
"Get the (intended) carbon-copy recipient for MESSAGE (the Cc: field) or #f if
|
||||||
|
not found."
|
||||||
|
(find-contact-field message ':cc))
|
||||||
|
|
||||||
|
(define-method (bcc (message <message>))
|
||||||
|
"Get the (intended) blind carbon-copy recipient for MESSAGE (the Bcc: field) or
|
||||||
|
#f if not found."
|
||||||
|
(find-contact-field message ':bcc))
|
||||||
|
|
||||||
|
;; Store
|
||||||
|
;;
|
||||||
|
;; Note: we have a *default-store*, which is the store we opened during
|
||||||
|
;; startup; for now that's the only store supported, but we keep things
|
||||||
|
;; open.
|
||||||
|
;;
|
||||||
|
;; Since it's the default store, we'd like to call the methods without
|
||||||
|
;; explicitly using *default-store*; with GOOPS, we cannot pass a default for
|
||||||
|
;; that, nor can we use keyword arguments (I think?). So use define* for that.
|
||||||
|
|
||||||
|
;; the 'store-object' is a foreign object wrapping a const Store*.
|
||||||
|
(define-class <store> ()
|
||||||
|
(store-object #:init-keyword #:store-object #:getter store-object))
|
||||||
|
|
||||||
|
;; not exported
|
||||||
|
(define-method (make-store store-object)
|
||||||
|
"Make a store from some STORE-OBJECT."
|
||||||
|
(make <store> #:store-object store-object))
|
||||||
|
|
||||||
|
(define *default-store*
|
||||||
|
;; default-store-object is defined in mu-scm-store.cc
|
||||||
|
(make-store default-store-object))
|
||||||
|
|
||||||
|
(define* (mfind query
|
||||||
|
#:key
|
||||||
|
(store *default-store*)
|
||||||
|
(related? #f)
|
||||||
|
(skip-dups? #f)
|
||||||
|
(sort-field 'date)
|
||||||
|
(reverse? #f)
|
||||||
|
(max-results #f))
|
||||||
|
"Find messages matching some query. The query is mandatory,
|
||||||
|
the other (keyword) arguments are optional.
|
||||||
|
|
||||||
|
(mfind QUERY
|
||||||
|
#:store *default-store*. Leave at default.
|
||||||
|
#:related? include related messages? Default: false
|
||||||
|
#:skip-dups? skip duplicates? Default: false
|
||||||
|
#: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 (plist)
|
||||||
|
(make <message> #:plist plist))
|
||||||
|
(store-mfind (store-object store) query
|
||||||
|
related? skip-dups? sort-field reverse? max-results)))
|
||||||
|
|
||||||
|
(define* (mcount
|
||||||
|
#:key
|
||||||
|
(store *default-store*))
|
||||||
|
"Get the number of messages."
|
||||||
|
(store-mcount (store-object store)))
|
||||||
|
|
||||||
|
(define* (cfind pattern
|
||||||
|
#:key
|
||||||
|
(store *default-store*)
|
||||||
|
(personal? #f)
|
||||||
|
(after #f)
|
||||||
|
(max-results #f))
|
||||||
|
"Find contacts matching some regex pattern, similar to 'mu-cfind(1).
|
||||||
|
The pattern is mandatory; the other (keyword) arguments are optional.
|
||||||
|
(cfind PATTERN
|
||||||
|
#:store *default-store*. Leave at default.
|
||||||
|
#:personal? only include 'personal' contacts. Default: all
|
||||||
|
#:after only include contacts last seen time_t: Default all
|
||||||
|
#:max-results max. number of matches. Default: false (unlimited))."
|
||||||
|
(store-cfind (store-object store) pattern personal? after max-results))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Helpers
|
||||||
|
|
||||||
|
(define* (iso-date->time-t isodate)
|
||||||
|
"Convert an ISO-8601 ISODATE to a number of seconds since epoch.
|
||||||
|
|
||||||
|
ISODATE is a string with the strftime format \"%FT%T\", i.e.,
|
||||||
|
yyyy-mm-ddThh:mm:ss or any prefix there of. The 'T', ':', '-' or any non-numeric
|
||||||
|
characters re optional.
|
||||||
|
|
||||||
|
ISODATE is assumed to represent some UTC date."
|
||||||
|
(let* ((tmpl "00000101000000")
|
||||||
|
(isodate (string-filter char-numeric? isodate)) ;; filter out 'T' ':' '-' etc
|
||||||
|
(isodate ;; fill out isodate
|
||||||
|
(if (> (string-length tmpl) (string-length isodate))
|
||||||
|
(string-append isodate (substring tmpl (string-length isodate)))
|
||||||
|
isodate)))
|
||||||
|
;;(format #t "~a\n" isodate)
|
||||||
|
(car (mktime (car (strptime "%Y%m%d%H%M%S" isodate)) "Z"))))
|
||||||
|
|
||||||
|
(define-method (time-t->iso-date time-t)
|
||||||
|
"Convert a time_t (second-since-epoch) value TIME-T to an ISO-8601
|
||||||
|
string for the corresponding UTC time.
|
||||||
|
|
||||||
|
If TIME-T is #f, return an empty string of the same length."
|
||||||
|
(if time-t
|
||||||
|
(strftime "%FT%T" (gmtime time-t))
|
||||||
|
" "))
|
||||||
Reference in New Issue
Block a user