diff --git a/.gitignore b/.gitignore index ff3f263..c10f907 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,6 @@ *.elc orig/ +org/deft **ido.last** **projectile-bookmarks** **/auto-save-list @@ -9,3 +10,4 @@ orig/ **/beancount-mode **/transient **/.org-id-locations +**/xapian-lite.so \ No newline at end of file diff --git a/org/init.el b/org/init.el index 0e834b1..6b8a391 100644 --- a/org/init.el +++ b/org/init.el @@ -80,6 +80,15 @@ (setq org-support-shift-select t) (setq org-src-fontify-natively t) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; xeft search tool +; (add-to-list 'load-path "~/.emacs.d.profiles/org/xeft") +; (require 'xeft) +; (setq xeft-database "~/.emacs.d.profiles/org/deft") +; (setq xeft-directory "~/org/") +; (setq xeft-default-extension "org") +; (setq xeft-recursive t) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; tags (load "~/.emacs.d.profiles/org/config-org-tags") diff --git a/org/xeft/Makefile b/org/xeft/Makefile new file mode 100644 index 0000000..a57a749 --- /dev/null +++ b/org/xeft/Makefile @@ -0,0 +1,23 @@ +.POSIX: +# Even if this is unnecessary, it doesn’t hurt. +PREFIX=/usr/local +CXX=g++ +CXXFLAGS=-fPIC -I$(PREFIX)/include +LDFLAGS=-L$(PREFIX)/lib +LDLIBS=-lxapian + +# Dylib extensions. +ifeq ($(OS),Windows_NT) + SOEXT = dll +endif +ifeq ($(shell uname),Darwin) + SOEXT = dylib +else + SOEXT = so +endif + +xapian-lite.dll: module/xapian-lite.cc + $(CXX) $< -o $@ -static -municode -lWs2_32 $(CXXFLAGS) $(LDFLAGS) $(LDLIBS) + +clean: + rm -f *.so *.o diff --git a/org/xeft/README.md b/org/xeft/README.md new file mode 100644 index 0000000..357a355 --- /dev/null +++ b/org/xeft/README.md @@ -0,0 +1,84 @@ +![Demo gif](./demo.gif) + +# Usage + +To use Xeft the note searching interface, install it and type `M-x +xeft RET` to bring up the panel. If the dynamic module doesn’t already +exists, you are prompted to download or compile it automatically. If +you choose to download the module, no more action is required. If you +want to compile the module locally, refer to the next section for +prerequisites for compiling the module. + +Once the xeft buffer is up, type the search phrase in the first line. +Press `C-n` and `C-p` to go through each file. You can preview a file +in another window by pressing `SPC` on a file, or click the file with +the mouse. Press `RET` to open the file in the current window. + +Directory `xeft-directory` stores note files, directory +`xeft-database` stores the database. Xeft uses +`xeft-default-extension` to create new files, and it ignores files +with `xeft-ignore-extension`. + +By default, Xeft only searches for first level files in +`xeft-directory`, to make it search recursively, set `xeft-recursive` +to t. + +See the “xeft” customize group for more custom options and faces. + +# Queries + +On search queries: + +Since Xeft uses Xapian, it supports the query syntax Xapian supports: + +``` +AND, NOT, OR, XOR and parenthesizes ++word1 -word2 which matches documents that contains WORD1 but not + WORD2. +word1 NEAR word2 which matches documents in where word1 is near word2. +word1 ADJ word2 which matches documents in where word1 is near word2 + and word1 comes before word2 +"word1 word2" which matches exactly “word1 word2” +``` + +Xeft deviates from Xapian in one aspect: consecutive phrases have +implied `AND` between them. So `word1 word2 word3` is actually seen as +`word1 AND word2 AND word3`. + +See https://xapian.org/docs/queryparser.html for Xapian’s official +documentation on query syntax. + +# building the dynamic module + +To build the module, you need to have Xapian installed. On Mac, it can +be installed with macports by + +```shell +sudo port install xapian-core +``` + +Then, build the module by + +```shell +make PREFIX=/opt/local +``` + +Here `/opt/local` is the default prefix of macports, which is what I +used to install Xapian. Homebrew and Linux users probably can leave it +empty. + +I can’t test it but on windows you can get msys2 and +`mingw-w64-x86_64-xapian-core` and `make` should just work. Thanks to +pRot0ta1p for reporting this. + +# notdeft + +I owe many thanks to the author of notdeft. I don’t really know C++ or +Xapian, without reading his code I wouldn’t be able to write Xeft. + +Also, if you want a more powerful searching experience, you will be +happier using notdeft instead. + +# Xapian dynamic module + +I wrote a xapian dynamic module that you can use too. Check it out at . diff --git a/org/xeft/gitignore b/org/xeft/gitignore new file mode 100644 index 0000000..e2d2375 --- /dev/null +++ b/org/xeft/gitignore @@ -0,0 +1,2 @@ +*.so +*.o \ No newline at end of file diff --git a/org/xeft/module/emacs-module-prelude.h b/org/xeft/module/emacs-module-prelude.h new file mode 100644 index 0000000..4edb9d1 --- /dev/null +++ b/org/xeft/module/emacs-module-prelude.h @@ -0,0 +1,164 @@ +#include "emacs-module.h" +#include +#include +#include +#include + +#ifndef EMACS_MODULE_PRELUDE_H +#define EMACS_MODULE_PRELUDE_H + +#define EMP_MAJOR_VERSION 1 +#define EMP_MINOR_VERSION 0 +#define EMP_PATCH_VERSION 0 + + +/* + Copy a Lisp string VALUE into BUFFER, and store the string size in + SIZE. A user doesn’t need to allocate BUFFER, but it is the user’s + responsibility to free it. If failed, return false, and the buffer + doesn’t need to be freed. + */ +bool +emp_copy_string_contents +(emacs_env *env, emacs_value value, char **buffer, size_t *size) +/* Copied from Pillipp’s document. I commented out assertions. */ +{ + ptrdiff_t buffer_size; + if (!env->copy_string_contents (env, value, NULL, &buffer_size)) + return false; + /* assert (env->non_local_exit_check (env) == emacs_funcall_exit_return); */ + /* assert (buffer_size > 0); */ + *buffer = (char*) malloc ((size_t) buffer_size); + if (*buffer == NULL) + { + env->non_local_exit_signal (env, env->intern (env, "memory-full"), + env->intern (env, "nil")); + return false; + } + ptrdiff_t old_buffer_size = buffer_size; + if (!env->copy_string_contents (env, value, *buffer, &buffer_size)) + { + free (*buffer); + *buffer = NULL; + return false; + } + /* assert (env->non_local_exit_check (env) == emacs_funcall_exit_return); */ + /* assert (buffer_size == old_buffer_size); */ + *size = (size_t) (buffer_size - 1); + return true; +} + +/* + Return a Lisp string. This is basically env->make_string except that + it calls strlen for you. + */ +emacs_value +emp_build_string (emacs_env *env, const char *string) +{ + return env->make_string (env, string, strlen (string)); +} + +/* + Intern NAME to a symbol. NAME has to be all-ASCII. + */ +emacs_value +emp_intern (emacs_env *env, const char *name) +{ + return env->intern (env, name); +} + +/* + Call a function named FN which takes NARGS number of arguments. + Example: funcall (env, "cons", 2, car, cdr); + */ +emacs_value +emp_funcall (emacs_env *env, const char* fn, ptrdiff_t nargs, ...) +{ + va_list argv; + va_start (argv, nargs); + emacs_value *args = (emacs_value *) malloc(nargs * sizeof(emacs_value)); + for (int idx = 0; idx < nargs; idx++) + { + args[idx] = va_arg (argv, emacs_value); + } + va_end (argv); + emacs_value val = env->funcall (env, emp_intern (env, fn), nargs, args); + free (args); + return val; +} + +/* + Provide FEATURE like ‘provide’ in Lisp. +*/ +void +emp_provide (emacs_env *env, const char *feature) +{ + emp_funcall (env, "provide", 1, emp_intern (env, feature)); +} + +/* + Raise a signal where NAME is the signal name and MESSAGE is the + error message. + */ +void +emp_signal_message1 +(emacs_env *env, const char *name, const char *message) +{ + env->non_local_exit_signal + (env, env->intern (env, name), + emp_funcall (env, "cons", 2, + env->make_string (env, message, strlen (message)), + emp_intern (env, "nil"))); +} + +/* + Define an error like ‘define-error’. + */ +void +emp_define_error +(emacs_env *env, const char *name, + const char *description, const char *parent) +{ + emp_funcall (env, "define-error", 3, + emp_intern (env, name), + env->make_string (env, description, strlen (description)), + emp_intern (env, parent)); +} + +/* + Return true if VAL is symbol nil. + */ +bool +emp_nilp (emacs_env *env, emacs_value val) +{ + return !env->is_not_nil (env, val); +} + +/* + Define a function NAME. The number of arguments that the function + takes is between MIN_ARITY and MAX_ARITY. FUNCTION is a function + with signature + + static emacs_value + function + (emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) + EMACS_NOEXCEPT + + DOCUMENTATION is the docstring for FUNCTION. + */ +void +emp_define_function +(emacs_env *env, const char *name, ptrdiff_t min_arity, + ptrdiff_t max_arity, + emacs_value (*function) (emacs_env *env, + ptrdiff_t nargs, + emacs_value* args, + void *data) EMACS_NOEXCEPT, + const char *documentation) +{ + emacs_value fn = env->make_function + (env, min_arity, max_arity, function, documentation, NULL); + emp_funcall (env, "fset", 2, emp_intern (env, name), fn); +} + +#endif /* EMACS_MODULE_PRELUDE_H */ diff --git a/org/xeft/module/emacs-module.h b/org/xeft/module/emacs-module.h new file mode 100644 index 0000000..1185c06 --- /dev/null +++ b/org/xeft/module/emacs-module.h @@ -0,0 +1,763 @@ +/* emacs-module.h - GNU Emacs module API. + +Copyright (C) 2015-2021 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs 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. + +GNU Emacs 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 GNU Emacs. If not, see . */ + +/* +This file defines the Emacs module API. Please see the chapter +`Dynamic Modules' in the GNU Emacs Lisp Reference Manual for +information how to write modules and use this header file. +*/ + +#ifndef EMACS_MODULE_H +#define EMACS_MODULE_H + +#include +#include +#include + +#ifndef __cplusplus +#include +#endif + +#define EMACS_MAJOR_VERSION 28 + +#if defined __cplusplus && __cplusplus >= 201103L +# define EMACS_NOEXCEPT noexcept +#else +# define EMACS_NOEXCEPT +#endif + +#if defined __cplusplus && __cplusplus >= 201703L +# define EMACS_NOEXCEPT_TYPEDEF noexcept +#else +# define EMACS_NOEXCEPT_TYPEDEF +#endif + +#if 3 < __GNUC__ + (3 <= __GNUC_MINOR__) +# define EMACS_ATTRIBUTE_NONNULL(...) \ + __attribute__ ((__nonnull__ (__VA_ARGS__))) +#elif (defined __has_attribute \ + && (!defined __clang_minor__ \ + || 3 < __clang_major__ + (5 <= __clang_minor__))) +# if __has_attribute (__nonnull__) +# define EMACS_ATTRIBUTE_NONNULL(...) \ + __attribute__ ((__nonnull__ (__VA_ARGS__))) +# endif +#endif +#ifndef EMACS_ATTRIBUTE_NONNULL +# define EMACS_ATTRIBUTE_NONNULL(...) +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +/* Current environment. */ +typedef struct emacs_env_28 emacs_env; + +/* Opaque pointer representing an Emacs Lisp value. + BEWARE: Do not assume NULL is a valid value! */ +typedef struct emacs_value_tag *emacs_value; + +enum { emacs_variadic_function = -2 }; + +/* Struct passed to a module init function (emacs_module_init). */ +struct emacs_runtime +{ + /* Structure size (for version checking). */ + ptrdiff_t size; + + /* Private data; users should not touch this. */ + struct emacs_runtime_private *private_members; + + /* Return an environment pointer. */ + emacs_env *(*get_environment) (struct emacs_runtime *runtime) + EMACS_ATTRIBUTE_NONNULL (1); +}; + +/* Type aliases for function pointer types used in the module API. + Note that we don't use these aliases directly in the API to be able + to mark the function arguments as 'noexcept' before C++20. + However, users can use them if they want. */ + +/* Function prototype for the module Lisp functions. These must not + throw C++ exceptions. */ +typedef emacs_value (*emacs_function) (emacs_env *env, ptrdiff_t nargs, + emacs_value *args, + void *data) + EMACS_NOEXCEPT_TYPEDEF EMACS_ATTRIBUTE_NONNULL (1); + +/* Function prototype for module user-pointer and function finalizers. + These must not throw C++ exceptions. */ +typedef void (*emacs_finalizer) (void *data) EMACS_NOEXCEPT_TYPEDEF; + +/* Possible Emacs function call outcomes. */ +enum emacs_funcall_exit +{ + /* Function has returned normally. */ + emacs_funcall_exit_return = 0, + + /* Function has signaled an error using `signal'. */ + emacs_funcall_exit_signal = 1, + + /* Function has exit using `throw'. */ + emacs_funcall_exit_throw = 2 +}; + +/* Possible return values for emacs_env.process_input. */ +enum emacs_process_input_result +{ + /* Module code may continue */ + emacs_process_input_continue = 0, + + /* Module code should return control to Emacs as soon as possible. */ + emacs_process_input_quit = 1 +}; + +/* Define emacs_limb_t so that it is likely to match GMP's mp_limb_t. + This micro-optimization can help modules that use mpz_export and + mpz_import, which operate more efficiently on mp_limb_t. It's OK + (if perhaps a bit slower) if the two types do not match, and + modules shouldn't rely on the two types matching. */ +typedef size_t emacs_limb_t; +#define EMACS_LIMB_MAX SIZE_MAX + +struct emacs_env_25 +{ + /* Structure size (for version checking). */ + ptrdiff_t size; + + /* Private data; users should not touch this. */ + struct emacs_env_private *private_members; + + /* Memory management. */ + + emacs_value (*make_global_ref) (emacs_env *env, emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*free_global_ref) (emacs_env *env, emacs_value global_value) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Non-local exit handling. */ + + enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*non_local_exit_clear) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + enum emacs_funcall_exit (*non_local_exit_get) + (emacs_env *env, emacs_value *symbol, emacs_value *data) + EMACS_ATTRIBUTE_NONNULL(1, 2, 3); + + void (*non_local_exit_signal) (emacs_env *env, + emacs_value symbol, emacs_value data) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*non_local_exit_throw) (emacs_env *env, + emacs_value tag, emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Function registration. */ + + emacs_value (*make_function) (emacs_env *env, + ptrdiff_t min_arity, + ptrdiff_t max_arity, + emacs_value (*func) (emacs_env *env, + ptrdiff_t nargs, + emacs_value* args, + void *data) + EMACS_NOEXCEPT + EMACS_ATTRIBUTE_NONNULL(1), + const char *docstring, + void *data) + EMACS_ATTRIBUTE_NONNULL(1, 4); + + emacs_value (*funcall) (emacs_env *env, + emacs_value func, + ptrdiff_t nargs, + emacs_value* args) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*intern) (emacs_env *env, const char *name) + EMACS_ATTRIBUTE_NONNULL(1, 2); + + /* Type conversion. */ + + emacs_value (*type_of) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + bool (*is_not_nil) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + bool (*eq) (emacs_env *env, emacs_value a, emacs_value b) + EMACS_ATTRIBUTE_NONNULL(1); + + intmax_t (*extract_integer) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*make_integer) (emacs_env *env, intmax_t n) + EMACS_ATTRIBUTE_NONNULL(1); + + double (*extract_float) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*make_float) (emacs_env *env, double d) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 + null-terminated string. + + SIZE must point to the total size of the buffer. If BUFFER is + NULL or if SIZE is not big enough, write the required buffer size + to SIZE and return true. + + Note that SIZE must include the last null byte (e.g. "abc" needs + a buffer of size 4). + + Return true if the string was successfully copied. */ + + bool (*copy_string_contents) (emacs_env *env, + emacs_value value, + char *buf, + ptrdiff_t *len) + EMACS_ATTRIBUTE_NONNULL(1, 4); + + /* Create a Lisp string from a utf8 encoded string. */ + emacs_value (*make_string) (emacs_env *env, + const char *str, ptrdiff_t len) + EMACS_ATTRIBUTE_NONNULL(1, 2); + + /* Embedded pointer type. */ + emacs_value (*make_user_ptr) (emacs_env *env, + void (*fin) (void *) EMACS_NOEXCEPT, + void *ptr) + EMACS_ATTRIBUTE_NONNULL(1); + + void *(*get_user_ptr) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + void (*set_user_ptr) (emacs_env *env, emacs_value arg, void *ptr) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) + (void *) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1); + void (*set_user_finalizer) (emacs_env *env, emacs_value arg, + void (*fin) (void *) EMACS_NOEXCEPT) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Vector functions. */ + emacs_value (*vec_get) (emacs_env *env, emacs_value vector, ptrdiff_t index) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*vec_set) (emacs_env *env, emacs_value vector, ptrdiff_t index, + emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vector) + EMACS_ATTRIBUTE_NONNULL(1); +}; + +struct emacs_env_26 +{ + /* Structure size (for version checking). */ + ptrdiff_t size; + + /* Private data; users should not touch this. */ + struct emacs_env_private *private_members; + + /* Memory management. */ + + emacs_value (*make_global_ref) (emacs_env *env, emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*free_global_ref) (emacs_env *env, emacs_value global_value) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Non-local exit handling. */ + + enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*non_local_exit_clear) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + enum emacs_funcall_exit (*non_local_exit_get) + (emacs_env *env, emacs_value *symbol, emacs_value *data) + EMACS_ATTRIBUTE_NONNULL(1, 2, 3); + + void (*non_local_exit_signal) (emacs_env *env, + emacs_value symbol, emacs_value data) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*non_local_exit_throw) (emacs_env *env, + emacs_value tag, emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Function registration. */ + + emacs_value (*make_function) (emacs_env *env, + ptrdiff_t min_arity, + ptrdiff_t max_arity, + emacs_value (*func) (emacs_env *env, + ptrdiff_t nargs, + emacs_value* args, + void *data) + EMACS_NOEXCEPT + EMACS_ATTRIBUTE_NONNULL(1), + const char *docstring, + void *data) + EMACS_ATTRIBUTE_NONNULL(1, 4); + + emacs_value (*funcall) (emacs_env *env, + emacs_value func, + ptrdiff_t nargs, + emacs_value* args) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*intern) (emacs_env *env, const char *name) + EMACS_ATTRIBUTE_NONNULL(1, 2); + + /* Type conversion. */ + + emacs_value (*type_of) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + bool (*is_not_nil) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + bool (*eq) (emacs_env *env, emacs_value a, emacs_value b) + EMACS_ATTRIBUTE_NONNULL(1); + + intmax_t (*extract_integer) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*make_integer) (emacs_env *env, intmax_t n) + EMACS_ATTRIBUTE_NONNULL(1); + + double (*extract_float) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*make_float) (emacs_env *env, double d) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 + null-terminated string. + + SIZE must point to the total size of the buffer. If BUFFER is + NULL or if SIZE is not big enough, write the required buffer size + to SIZE and return true. + + Note that SIZE must include the last null byte (e.g. "abc" needs + a buffer of size 4). + + Return true if the string was successfully copied. */ + + bool (*copy_string_contents) (emacs_env *env, + emacs_value value, + char *buf, + ptrdiff_t *len) + EMACS_ATTRIBUTE_NONNULL(1, 4); + + /* Create a Lisp string from a utf8 encoded string. */ + emacs_value (*make_string) (emacs_env *env, + const char *str, ptrdiff_t len) + EMACS_ATTRIBUTE_NONNULL(1, 2); + + /* Embedded pointer type. */ + emacs_value (*make_user_ptr) (emacs_env *env, + void (*fin) (void *) EMACS_NOEXCEPT, + void *ptr) + EMACS_ATTRIBUTE_NONNULL(1); + + void *(*get_user_ptr) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + void (*set_user_ptr) (emacs_env *env, emacs_value arg, void *ptr) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) + (void *) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1); + void (*set_user_finalizer) (emacs_env *env, emacs_value arg, + void (*fin) (void *) EMACS_NOEXCEPT) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Vector functions. */ + emacs_value (*vec_get) (emacs_env *env, emacs_value vector, ptrdiff_t index) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*vec_set) (emacs_env *env, emacs_value vector, ptrdiff_t index, + emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vector) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Returns whether a quit is pending. */ + bool (*should_quit) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); +}; + +struct emacs_env_27 +{ + /* Structure size (for version checking). */ + ptrdiff_t size; + + /* Private data; users should not touch this. */ + struct emacs_env_private *private_members; + + /* Memory management. */ + + emacs_value (*make_global_ref) (emacs_env *env, emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*free_global_ref) (emacs_env *env, emacs_value global_value) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Non-local exit handling. */ + + enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*non_local_exit_clear) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + enum emacs_funcall_exit (*non_local_exit_get) + (emacs_env *env, emacs_value *symbol, emacs_value *data) + EMACS_ATTRIBUTE_NONNULL(1, 2, 3); + + void (*non_local_exit_signal) (emacs_env *env, + emacs_value symbol, emacs_value data) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*non_local_exit_throw) (emacs_env *env, + emacs_value tag, emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Function registration. */ + + emacs_value (*make_function) (emacs_env *env, + ptrdiff_t min_arity, + ptrdiff_t max_arity, + emacs_value (*func) (emacs_env *env, + ptrdiff_t nargs, + emacs_value* args, + void *data) + EMACS_NOEXCEPT + EMACS_ATTRIBUTE_NONNULL(1), + const char *docstring, + void *data) + EMACS_ATTRIBUTE_NONNULL(1, 4); + + emacs_value (*funcall) (emacs_env *env, + emacs_value func, + ptrdiff_t nargs, + emacs_value* args) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*intern) (emacs_env *env, const char *name) + EMACS_ATTRIBUTE_NONNULL(1, 2); + + /* Type conversion. */ + + emacs_value (*type_of) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + bool (*is_not_nil) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + bool (*eq) (emacs_env *env, emacs_value a, emacs_value b) + EMACS_ATTRIBUTE_NONNULL(1); + + intmax_t (*extract_integer) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*make_integer) (emacs_env *env, intmax_t n) + EMACS_ATTRIBUTE_NONNULL(1); + + double (*extract_float) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*make_float) (emacs_env *env, double d) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 + null-terminated string. + + SIZE must point to the total size of the buffer. If BUFFER is + NULL or if SIZE is not big enough, write the required buffer size + to SIZE and return true. + + Note that SIZE must include the last null byte (e.g. "abc" needs + a buffer of size 4). + + Return true if the string was successfully copied. */ + + bool (*copy_string_contents) (emacs_env *env, + emacs_value value, + char *buf, + ptrdiff_t *len) + EMACS_ATTRIBUTE_NONNULL(1, 4); + + /* Create a Lisp string from a utf8 encoded string. */ + emacs_value (*make_string) (emacs_env *env, + const char *str, ptrdiff_t len) + EMACS_ATTRIBUTE_NONNULL(1, 2); + + /* Embedded pointer type. */ + emacs_value (*make_user_ptr) (emacs_env *env, + void (*fin) (void *) EMACS_NOEXCEPT, + void *ptr) + EMACS_ATTRIBUTE_NONNULL(1); + + void *(*get_user_ptr) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + void (*set_user_ptr) (emacs_env *env, emacs_value arg, void *ptr) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) + (void *) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1); + void (*set_user_finalizer) (emacs_env *env, emacs_value arg, + void (*fin) (void *) EMACS_NOEXCEPT) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Vector functions. */ + emacs_value (*vec_get) (emacs_env *env, emacs_value vector, ptrdiff_t index) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*vec_set) (emacs_env *env, emacs_value vector, ptrdiff_t index, + emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vector) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Returns whether a quit is pending. */ + bool (*should_quit) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Processes pending input events and returns whether the module + function should quit. */ + enum emacs_process_input_result (*process_input) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL (1); + + struct timespec (*extract_time) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL (1); + + emacs_value (*make_time) (emacs_env *env, struct timespec time) + EMACS_ATTRIBUTE_NONNULL (1); + + bool (*extract_big_integer) (emacs_env *env, emacs_value arg, int *sign, + ptrdiff_t *count, emacs_limb_t *magnitude) + EMACS_ATTRIBUTE_NONNULL (1); + + emacs_value (*make_big_integer) (emacs_env *env, int sign, ptrdiff_t count, + const emacs_limb_t *magnitude) + EMACS_ATTRIBUTE_NONNULL (1); +}; + +struct emacs_env_28 +{ + /* Structure size (for version checking). */ + ptrdiff_t size; + + /* Private data; users should not touch this. */ + struct emacs_env_private *private_members; + + /* Memory management. */ + + emacs_value (*make_global_ref) (emacs_env *env, emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*free_global_ref) (emacs_env *env, emacs_value global_value) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Non-local exit handling. */ + + enum emacs_funcall_exit (*non_local_exit_check) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*non_local_exit_clear) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + enum emacs_funcall_exit (*non_local_exit_get) + (emacs_env *env, emacs_value *symbol, emacs_value *data) + EMACS_ATTRIBUTE_NONNULL(1, 2, 3); + + void (*non_local_exit_signal) (emacs_env *env, + emacs_value symbol, emacs_value data) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*non_local_exit_throw) (emacs_env *env, + emacs_value tag, emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Function registration. */ + + emacs_value (*make_function) (emacs_env *env, + ptrdiff_t min_arity, + ptrdiff_t max_arity, + emacs_value (*func) (emacs_env *env, + ptrdiff_t nargs, + emacs_value* args, + void *data) + EMACS_NOEXCEPT + EMACS_ATTRIBUTE_NONNULL(1), + const char *docstring, + void *data) + EMACS_ATTRIBUTE_NONNULL(1, 4); + + emacs_value (*funcall) (emacs_env *env, + emacs_value func, + ptrdiff_t nargs, + emacs_value* args) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*intern) (emacs_env *env, const char *name) + EMACS_ATTRIBUTE_NONNULL(1, 2); + + /* Type conversion. */ + + emacs_value (*type_of) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + bool (*is_not_nil) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + bool (*eq) (emacs_env *env, emacs_value a, emacs_value b) + EMACS_ATTRIBUTE_NONNULL(1); + + intmax_t (*extract_integer) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*make_integer) (emacs_env *env, intmax_t n) + EMACS_ATTRIBUTE_NONNULL(1); + + double (*extract_float) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + + emacs_value (*make_float) (emacs_env *env, double d) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 + null-terminated string. + + SIZE must point to the total size of the buffer. If BUFFER is + NULL or if SIZE is not big enough, write the required buffer size + to SIZE and return true. + + Note that SIZE must include the last null byte (e.g. "abc" needs + a buffer of size 4). + + Return true if the string was successfully copied. */ + + bool (*copy_string_contents) (emacs_env *env, + emacs_value value, + char *buf, + ptrdiff_t *len) + EMACS_ATTRIBUTE_NONNULL(1, 4); + + /* Create a Lisp string from a utf8 encoded string. */ + emacs_value (*make_string) (emacs_env *env, + const char *str, ptrdiff_t len) + EMACS_ATTRIBUTE_NONNULL(1, 2); + + /* Embedded pointer type. */ + emacs_value (*make_user_ptr) (emacs_env *env, + void (*fin) (void *) EMACS_NOEXCEPT, + void *ptr) + EMACS_ATTRIBUTE_NONNULL(1); + + void *(*get_user_ptr) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL(1); + void (*set_user_ptr) (emacs_env *env, emacs_value arg, void *ptr) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*(*get_user_finalizer) (emacs_env *env, emacs_value uptr)) + (void *) EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1); + void (*set_user_finalizer) (emacs_env *env, emacs_value arg, + void (*fin) (void *) EMACS_NOEXCEPT) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Vector functions. */ + emacs_value (*vec_get) (emacs_env *env, emacs_value vector, ptrdiff_t index) + EMACS_ATTRIBUTE_NONNULL(1); + + void (*vec_set) (emacs_env *env, emacs_value vector, ptrdiff_t index, + emacs_value value) + EMACS_ATTRIBUTE_NONNULL(1); + + ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vector) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Returns whether a quit is pending. */ + bool (*should_quit) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL(1); + + /* Processes pending input events and returns whether the module + function should quit. */ + enum emacs_process_input_result (*process_input) (emacs_env *env) + EMACS_ATTRIBUTE_NONNULL (1); + + struct timespec (*extract_time) (emacs_env *env, emacs_value arg) + EMACS_ATTRIBUTE_NONNULL (1); + + emacs_value (*make_time) (emacs_env *env, struct timespec time) + EMACS_ATTRIBUTE_NONNULL (1); + + bool (*extract_big_integer) (emacs_env *env, emacs_value arg, int *sign, + ptrdiff_t *count, emacs_limb_t *magnitude) + EMACS_ATTRIBUTE_NONNULL (1); + + emacs_value (*make_big_integer) (emacs_env *env, int sign, ptrdiff_t count, + const emacs_limb_t *magnitude) + EMACS_ATTRIBUTE_NONNULL (1); + + /* Add module environment functions newly added in Emacs 28 here. + Before Emacs 28 is released, remove this comment and start + module-env-29.h on the master branch. */ + + void (*(*EMACS_ATTRIBUTE_NONNULL (1) + get_function_finalizer) (emacs_env *env, + emacs_value arg)) (void *) EMACS_NOEXCEPT; + + void (*set_function_finalizer) (emacs_env *env, emacs_value arg, + void (*fin) (void *) EMACS_NOEXCEPT) + EMACS_ATTRIBUTE_NONNULL (1); + + int (*open_channel) (emacs_env *env, emacs_value pipe_process) + EMACS_ATTRIBUTE_NONNULL (1); + + void (*make_interactive) (emacs_env *env, emacs_value function, + emacs_value spec) + EMACS_ATTRIBUTE_NONNULL (1); + + /* Create a unibyte Lisp string from a string. */ + emacs_value (*make_unibyte_string) (emacs_env *env, + const char *str, ptrdiff_t len) + EMACS_ATTRIBUTE_NONNULL(1, 2); +}; + +/* Every module should define a function as follows. */ +extern int emacs_module_init (struct emacs_runtime *runtime) + EMACS_NOEXCEPT + EMACS_ATTRIBUTE_NONNULL (1); + +#ifdef __cplusplus +} +#endif + +#endif /* EMACS_MODULE_H */ diff --git a/org/xeft/module/xapian-lite-internal.h b/org/xeft/module/xapian-lite-internal.h new file mode 100644 index 0000000..d739004 --- /dev/null +++ b/org/xeft/module/xapian-lite-internal.h @@ -0,0 +1,40 @@ +#ifndef XAPIAN_LITE_INTERNAL_H +#define XAPIAN_LITE_INTERNAL_H + +#include "emacs-module.h" + +typedef emacs_value (*emacs_subr) (emacs_env *env, + ptrdiff_t nargs, emacs_value *args, + void *data); +#ifdef __cplusplus +extern "C" { +#endif + +void +define_error +(emacs_env *env, const char *name, + const char *description, const char *parent); + +emacs_value +Fxapian_lite_reindex_file +(emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) + EMACS_NOEXCEPT; + +emacs_value +Fxapian_lite_query_term +(emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) + EMACS_NOEXCEPT; + +void +define_function +(emacs_env *env, const char *name, ptrdiff_t min_arity, + ptrdiff_t max_arity, emacs_subr function, const char *documentation); + +void +provide (emacs_env *env, const char *feature); + +#ifdef __cplusplus +} +#endif + +#endif /* XAPIAN_LITE_INTERNAL_H */ diff --git a/org/xeft/module/xapian-lite.cc b/org/xeft/module/xapian-lite.cc new file mode 100644 index 0000000..0ff505f --- /dev/null +++ b/org/xeft/module/xapian-lite.cc @@ -0,0 +1,446 @@ +#include +#include +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include + +#include +#include + +#include + +#include "emacs-module.h" +#include "emacs-module-prelude.h" + +using namespace std; + +__declspec(dllexport) int plugin_is_GPL_compatible; + +#if defined __cplusplus && __cplusplus >= 201103L +# define EMACS_NOEXCEPT noexcept +#else +# define EMACS_NOEXCEPT +#endif + +#define CHECK_EXIT(env) \ + if (env->non_local_exit_check (env) \ + != emacs_funcall_exit_return) \ + { return NULL; } + +/* A few notes: The database we use, WritableDatabase, will not throw + DatabaseModifiedError, so we don’t need to handle that. For query, + we first try to parse it with special syntax enabled, i.e., with + AND, OR, +/-, etc. If that doesn’t parse, we’ll just parse it as + plain text. + + REF: https://lists.xapian.org/pipermail/xapian-discuss/2021-August/009906.html + */ + +/*** Xapian stuff */ + +static const Xapian::valueno DOC_MTIME = 0; +static const Xapian::valueno DOC_FILEPATH = 1; + +static Xapian::WritableDatabase database; +static string cached_dbpath = ""; + +class xapian_lite_cannot_open_file: public exception {}; + +// Reindex the file at PATH, using database at DBPATH. Throws +// cannot_open_file. Both path must be absolute. Normally only reindex +// if file has change since last index, if FORCE is true, always +// reindex. Return true if re-indexed, return false if didn’t. +// LANG is the language used by the stemmer. +// Possible langauges: +// https://xapian.org/docs/apidoc/html/classXapian_1_1Stem.html +static bool +reindex_file +(string path, string dbpath, string lang = "en", bool force = false) +{ + // Check for mtime. + struct stat st; + time_t file_mtime; + off_t file_size; + if (stat (path.c_str(), &st) == 0) + { + file_mtime = st.st_mtime; + file_size = st.st_size; + } + else + { + throw xapian_lite_cannot_open_file(); + } + + // Even though the document says that database object only carries a + // pointer to the actual object, it is still not cheap enough. By + // using this cache, we get much better performance when reindexing + // hundreds of files, which most are no-op because they hasn’t been + // modified. + if (dbpath != cached_dbpath) + { + database = Xapian::WritableDatabase + (dbpath, Xapian::DB_CREATE_OR_OPEN); + cached_dbpath = dbpath; + } + // Track doc with file path as "id". See + // https://getting-started-with-xapian.readthedocs.io/en/latest/practical_example/indexing/updating_the_database.html + string termID = 'Q' + path; + Xapian::PostingIterator it_begin = database.postlist_begin (termID); + Xapian::PostingIterator it_end = database.postlist_end (termID); + bool has_doc = it_begin != it_end; + time_t db_mtime; + if (has_doc) + { + // sortable_serialise is for double and we can’t really use it. + Xapian::Document db_doc = database.get_document(*it_begin); + db_mtime = (time_t) stoi (db_doc.get_value (DOC_MTIME)); + } + + // Need re-index. + if (!has_doc || (has_doc && db_mtime < file_mtime) || force) + { + // Get the file content. + // REF: https://stackoverflow.com/questions/2912520/read-file-contents-into-a-string-in-c + ifstream infile (path); + string content ((istreambuf_iterator(infile)), + (istreambuf_iterator())); + // Create the indexer. + Xapian::TermGenerator indexer; + Xapian::Stem stemmer (lang); + indexer.set_stemmer (stemmer); + indexer.set_stemming_strategy + (Xapian::TermGenerator::STEM_SOME); + // Support CJK. + indexer.set_flags (Xapian::TermGenerator::FLAG_CJK_NGRAM); + // Index file content. + Xapian::Document new_doc; + indexer.set_document (new_doc); + indexer.index_text (content); + // Set doc info. + new_doc.add_boolean_term (termID); + // We store the path in value, no need to use set_data. + new_doc.add_value (DOC_FILEPATH, path); + new_doc.add_value (DOC_MTIME, (string) to_string (file_mtime)); + database.replace_document (termID, new_doc); + return true; + } + else + { + return false; + } +} + +// Query TERM in the databse at DBPATH. OFFSET and PAGE_SIZE is for +// paging, see the docstring for the lisp function. If a file in the +// result doesn’t exist anymore, it is removed from the database. +// LANG is the language used by the stemmer. +// Possible langauges: +// https://xapian.org/docs/apidoc/html/classXapian_1_1Stem.html +static vector +query_term +(string term, string dbpath, int offset, int page_size, + string lang = "en") +{ + // See reindex_file for the reason for caching the database object. + if (dbpath != cached_dbpath) + { + database = Xapian::WritableDatabase + (dbpath, Xapian::DB_CREATE_OR_OPEN); + cached_dbpath = dbpath; + } + + Xapian::QueryParser parser; + Xapian::Stem stemmer (lang); + parser.set_stemmer (stemmer); + parser.set_stemming_strategy (Xapian::QueryParser::STEM_SOME); + // Partial match (FLAG_PARTIAL) needs the database to expand + // wildcards. + parser.set_database(database); + + Xapian::Query query; + try + { + query = parser.parse_query + // CJK_NGRAM is the flag for CJK support. PARTIAL makes + // interactive search more stable. DEFAULT enables AND OR and + // +/-. + (term, Xapian::QueryParser::FLAG_CJK_NGRAM + | Xapian::QueryParser::FLAG_PARTIAL + | Xapian::QueryParser::FLAG_DEFAULT); + } + // If the syntax is syntactically wrong, Xapian throws this error. + // Try again without enabling any special syntax. + catch (Xapian::QueryParserError &e) + { + query = parser.parse_query + (term, Xapian::QueryParser::FLAG_CJK_NGRAM + | Xapian::QueryParser::FLAG_PARTIAL); + } + + Xapian::Enquire enquire (database); + enquire.set_query (query); + + Xapian::MSet mset = enquire.get_mset (offset, page_size); + vector result (0); + for (Xapian::MSetIterator it = mset.begin(); it != mset.end(); it++) + { + Xapian::Document doc = it.get_document(); + string path = doc.get_value(DOC_FILEPATH); + // If the file doesn’t exists anymore, remove it. + struct stat st; + if (stat (path.c_str(), &st) == 0) + { + result.push_back (doc.get_value (DOC_FILEPATH)); + } + else + { + database.delete_document (doc.get_docid()); + } + } + return result; +} + +/*** Module definition */ + +static string +copy_string (emacs_env *env, emacs_value value) +{ + char* char_buffer; + size_t size; + if (emp_copy_string_contents (env, value, &char_buffer, &size)) + { + string str = (string) char_buffer; + free (char_buffer); + return str; + } + else + { + emp_signal_message1 (env, "xapian-lite-error", + "Error turning lisp string to C++ string"); + return ""; + } +} + +static bool +NILP (emacs_env *env, emacs_value val) +{ + return !env->is_not_nil (env, val); +} + +static const char* xapian_lite_reindex_file_doc = + "Refindex file at PATH with database at DBPATH\n" + "Both paths has to be absolute. Normally, this function only\n" + "reindex a file if it has been modified since last indexed,\n" + "but if FORCE is non-nil, this function will always reindex.\n" + "Return non-nil if actually reindexed the file, return nil if not.\n" + "\n" + "LANG is the language used by the indexer, it tells Xapian how to\n" + "reduce words to word stems, e.g., apples <-> apple.\n" + "A full list of possible languages can be found at\n" + "https://xapian.org/docs/apidoc/html/classXapian_1_1Stem.html.\n" + "By default, LANG is \"en\".\n" + "\n" + "(fn PATH DBPATH &optional LANG FORCE)"; + +static emacs_value +Fxapian_lite_reindex_file +(emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) + EMACS_NOEXCEPT +{ + + // Decode arguments. + emacs_value lisp_path = args[0]; + emacs_value lisp_dbpath = args[1]; + + if (NILP (env, emp_funcall (env, "file-name-absolute-p", 1, lisp_path))) + { + emp_signal_message1 (env, "xapian-lite-file-error", + "PATH is not a absolute path"); + return NULL; + } + if (NILP (env, + emp_funcall (env, "file-name-absolute-p", 1, lisp_dbpath))) + { + emp_signal_message1 (env, "xapian-lite-file-error", + "DBPATH is not a absolute path"); + return NULL; + } + + // Expand "~" in the filename. + emacs_value lisp_args[] = {lisp_path}; + lisp_path = emp_funcall (env, "expand-file-name", 1, lisp_path); + lisp_dbpath = emp_funcall (env, "expand-file-name", 1, lisp_dbpath); + + emacs_value lisp_lang = nargs < 3 ? emp_intern (env, "nil") : args[2]; + emacs_value lisp_force = nargs < 4 ? emp_intern (env, "nil") : args[3]; + + string path = copy_string (env, lisp_path); + string dbpath = copy_string (env, lisp_dbpath); + bool force = !NILP (env, lisp_force); + CHECK_EXIT (env); + string lang = NILP (env, lisp_lang) ? + "en" : copy_string (env, lisp_lang); + CHECK_EXIT (env); + + // Do the work. + bool indexed; + try + { + indexed = reindex_file (path, dbpath, lang, force); + return indexed ? emp_intern (env, "t") : emp_intern (env, "nil"); + } + catch (xapian_lite_cannot_open_file &e) + { + emp_signal_message1 (env, "xapian-lite-file-error", + "Cannot open the file"); + return NULL; + } + catch (Xapian::DatabaseCorruptError &e) + { + emp_signal_message1 (env, "xapian-lite-database-corrupt-error", + e.get_description().c_str()); + return NULL; + } + catch (Xapian::DatabaseLockError &e) + { + emp_signal_message1 (env, "xapian-lite-database-lock-error", + e.get_description().c_str()); + return NULL; + } + catch (Xapian::Error &e) + { + emp_signal_message1 (env, "xapian-lite-lib-error", + e.get_description().c_str()); + return NULL; + } + catch (exception &e) + { + emp_signal_message1 (env, "xapian-lite-error", + "Something went wrong"); + return NULL; + } +} + +static const char *xapian_lite_query_term_doc = + "Query for TERM in database at DBPATH.\n" + "Paging is supported by OFFSET and PAGE-SIZE. OFFSET specifies page\n" + "start, and PAGE-SIZE the size. For example, if a page is 10 entries,\n" + "OFFSET and PAGE-SIZE would be first 0 and 10, then 10 and 10, and\n" + "so on.\n" + "\n" + "If a file in the result doesn't exist anymore, it is removed from\n" + "the database, and is not included in the return value.\n" + "\n" + "LANG is the language used by the indexer, it tells Xapian how to\n" + "reduce words to word stems, e.g., apples <-> apple.\n" + "A full list of possible languages can be found at\n" + "https://xapian.org/docs/apidoc/html/classXapian_1_1Stem.html.\n" + "By default, LANG is \"en\".\n" + "\n" + "TERM can use common Xapian syntax like AND, OR, and +/-.\n" + "Specifically, this function supports:\n" + "\n" + " Boolean operators: AND, OR, XOR, NOT\n" + " Parenthesized expression: ()\n" + " Love/hate terms: +/-\n" + " Exact match: \"\"\n" + "\n" + "If TERM contains syntactic errors, like \"a AND AND b\",\n" + "it is treated as a plain term.\n" + "\n" + "(fn TERM DBPATH OFFSET PAGE-SIZE &optional LANG)"; + +static emacs_value +Fxapian_lite_query_term +(emacs_env *env, ptrdiff_t nargs, emacs_value args[], void *data) + EMACS_NOEXCEPT +{ + // Decode arguments. + emacs_value lisp_term = args[0]; + emacs_value lisp_dbpath = args[1]; + emacs_value lisp_offset = args[2]; + emacs_value lisp_page_size = args[3]; + + if (NILP (env, + emp_funcall (env, "file-name-absolute-p", 1, lisp_dbpath))) + { + emp_signal_message1 (env, "xapian-lite-file-error", + "DBPATH is not a absolute path"); + return NULL; + } + + lisp_dbpath = emp_funcall (env, "expand-file-name", 1, lisp_dbpath); + + string term = copy_string (env, lisp_term); + string dbpath = copy_string (env, lisp_dbpath); + int offset = env->extract_integer (env, lisp_offset); + int page_size = env->extract_integer (env, lisp_page_size); + CHECK_EXIT (env); + + vector result; + try + { + result = query_term (term, dbpath, offset, page_size); + } + catch (Xapian::Error &e) + { + emp_signal_message1 (env, "xapian-lite-lib-error", + e.get_description().c_str()); + return NULL; + } + catch (exception &e) + { + emp_signal_message1 (env, "xapian-lite-error", + "Something went wrong"); + return NULL; + } + + vector::iterator it; + emacs_value ret = emp_intern (env, "nil"); + for (it = result.begin(); it != result.end(); it++) { + ret = emp_funcall (env, "cons", 2, + env->make_string + (env, it->c_str(), strlen(it->c_str())), + ret); + CHECK_EXIT (env); + } + return emp_funcall (env, "reverse", 1, ret); +} + +int __declspec(dllexport) +emacs_module_init (struct emacs_runtime *ert) EMACS_NOEXCEPT +{ + emacs_env *env = ert->get_environment (ert); + + emp_define_error (env, "xapian-lite-error", + "Generic xapian-lite error", "error"); + emp_define_error (env, "xapian-lite-lib-error", + "Xapian library error", "xapian-lite-error"); + emp_define_error (env, "xapian-lite-database-corrupt-error", + "Xapian library error", "xapian-lite-lib-error"); + emp_define_error (env, "xapian-lite-database-lock-error", + "Xapian library error", "xapian-lite-lib-error"); + emp_define_error (env, "xapian-lite-file-error", + "Cannot open file", "xapian-lite-error"); + + emp_define_function(env, "xapian-lite-reindex-file", 2, 3, + &Fxapian_lite_reindex_file, + xapian_lite_reindex_file_doc); + emp_define_function(env, "xapian-lite-query-term", 4, 4, + &Fxapian_lite_query_term, + xapian_lite_query_term_doc); + + emp_provide (env, "xapian-lite"); + + /* Return 0 to indicate module loaded successfully. */ + return 0; +} diff --git a/org/xeft/xapian-lite.dll b/org/xeft/xapian-lite.dll new file mode 100644 index 0000000..a3a5a4e Binary files /dev/null and b/org/xeft/xapian-lite.dll differ diff --git a/org/xeft/xeft.el b/org/xeft/xeft.el new file mode 100644 index 0000000..cf346f8 --- /dev/null +++ b/org/xeft/xeft.el @@ -0,0 +1,760 @@ +;;; xeft.el --- Deft feat. Xapian -*- lexical-binding: t; -*- + +;; Author: Yuan Fu + +;;; This file is NOT part of GNU Emacs + +;;; Commentary: +;; +;; Usage: +;; +;; Type M-x xeft RET, and you should see the Xeft buffer. Type in your +;; search phrase in the first line and the results will show up as you +;; type. Press C-n and C-p to go through each file. You can preview a +;; file by pressing SPC when the point is on a file, or click the file +;; with the mouse. Press RET to open the file in the same window. +;; +;; Type C-c C-g to force a refresh. When point is on the search +;; phrase, press RET to create a file with the search phrase as +;; the filename and title. +;; +;; Note that: +;; +;; 1. Xeft only looks for first-level files in ‘xeft-directory’. Files +;; in sub-directories are not searched unless ‘xeft-recursive’ is +;; non-nil. +;; +;; 2. Xeft creates a new file by using the search phrase as the +;; filename and title. If you want otherwise, redefine +;; ‘xeft-create-note’ or ‘xeft-filename-fn’. +;; +;; 3. Xeft saves the current window configuration before switching to +;; Xeft buffer. When Xeft buffer is killed, Xeft restores the saved +;; window configuration. +;; +;; On search queries: +;; +;; Since Xeft uses Xapian, it supports the query syntax Xapian +;; supports: +;; +;; AND, NOT, OR, XOR and parenthesizes +;; +word1 -word2 which matches documents that contains WORD1 but not +;; WORD2. +;; word1 NEAR word2 which matches documents in where word1 is near word2. +;; word1 ADJ word2 which matches documents in where word1 is near word2 +;; and word1 comes before word2 +;; "word1 word2" which matches exactly “word1 word2” +;; +;; Xeft deviates from Xapian in one aspect: consecutive phrases have +;; implied “AND” between them. So "word1 word2 word3" is actually seen +;; as "word1 AND word2 AND word3". See ‘xeft--tighten-search-phrase’ +;; for how exactly is it done. +;; +;; See https://xapian.org/docs/queryparser.html for Xapian’s official +;; documentation on query syntax. + +;;; Code: + +(require 'cl-lib) +(declare-function xapian-lite-reindex-file nil + (path dbpath &optional lang force)) +(declare-function xapian-lite-query-term nil + (term dbpath offset page-size &optional lang)) + +;;; Customize + +(defgroup xeft nil + "Xeft note interface." + :group 'applications) + +(defcustom xeft-directory "~/.deft" + "Directory in where notes are stored. Must be a full path." + :type 'directory) + +(defcustom xeft-database "~/.deft/db" + "The path to the database." + :type 'directory) + +(defcustom xeft-find-file-hook nil + "Hook run when Xeft opens a file." + :type 'hook) + +(defface xeft-selection + '((t . (:inherit region :extend t))) + "Face for the current selected search result.") + +(defface xeft-inline-highlight + '((t . (:inherit underline :extend t))) + "Face for inline highlighting in Xeft buffer.") + +(defface xeft-preview-highlight + '((t . (:inherit highlight :extend t))) + "Face for highlighting in the preview buffer.") + +(defface xeft-excerpt-title + '((t . (:inherit (bold underline)))) + "Face for the excerpt title.") + +(defface xeft-excerpt-body + '((t . (:inherit default))) + "Face for the excerpt body.") + +(defcustom xeft-default-extension "txt" + "The default extension for new files created by xeft." + :type 'string) + +(defcustom xeft-filename-fn + (lambda (search-phrase) + (concat search-phrase "." xeft-default-extension)) + "A function that takes the search phrase and returns a filename." + :type 'function) + +(defcustom xeft-ignore-extension '("iimg") + "Files with extensions in this list are ignored. + +To remove the files that you want to ignore but are already +indexed in the database, simply delete the database and start +xeft again." + :type '(list string)) + +(defcustom xeft-recursive nil + "If non-nil, xeft searches for file recursively. +Xeft doesn’t follow symlinks and ignores inaccessible directories." + :type 'boolean) + +(defcustom xeft-file-list-function #'xeft--file-list + "A function that returns files that xeft should search from. +This function takes no arguments and return a list of absolute paths." + :type 'function) + +;;; Compile + +(defun xeft--compile-module () + "Compile the dynamic module. Return non-nil if success." + ;; Just following vterm.el here. + (when (not (executable-find "make")) + (user-error "Couldn’t compile xeft: cannot find make")) + (let* ((source-dir + (shell-quote-argument + (file-name-directory + (locate-library "xeft.el" t)))) + (command (format "cd %s; make PREFIX=%s" + source-dir + (read-string "PREFIX (empty by default): "))) + (buffer (get-buffer-create "*xeft compile*"))) + (if (zerop (let ((inhibit-read-only t)) + (call-process "sh" nil buffer t "-c" command))) + (progn (message "Successfully compiled the module :-D") t) + (pop-to-buffer buffer) + (compilation-mode) + (message "Failed to compile the module") + nil))) + +(defvar xeft--linux-module-url "https://github.com/casouri/xapian-lite/releases/download/v1.0/xapian-lite-amd64-linux.so" + "URL for pre-built dynamic module for Linux.") + +(defvar xeft--mac-module-url "https://github.com/casouri/xapian-lite/releases/download/v1.0/xapian-lite-amd64-mac.dylib" + "URL for pre-built dynamic module for Mac.") + +(defun xeft--download-module () + "Download pre-built module from GitHub. Return non-nil if success." + (require 'url) + (let ((module-path (expand-file-name + "xapian-lite.so" + (file-name-directory + (locate-library "xeft.el" t))))) + (cond + ((eq system-type 'gnu/linux) + (url-copy-file xeft--linux-module-url module-path) + t) + ((eq system-type 'darwin) + (url-copy-file xeft--mac-module-url module-path) + t) + (t (message "No pre-built module for this operating system. We only have them for GNU/Linux and macOS") + nil)))) + +;;; Helpers + +(defvar xeft--last-window-config nil + "Window configuration before Xeft starts.") + +(defun xeft--buffer () + "Return the xeft buffer." + (get-buffer-create "*xeft*")) + +(defun xeft--work-buffer () + "Return the work buffer for Xeft. Used for holding file contents." + (get-buffer-create " *xeft work*")) + +(defun xeft--after-save () + "Reindex the file." + (condition-case _ + (xapian-lite-reindex-file (buffer-file-name) xeft-database) + (xapian-lite-database-lock-error + (message "The Xeft database is locked (maybe there is another Xeft instance running) so we will skip indexing this file for now")) + (xapian-lite-database-corrupt-error + (message "The Xeft database is corrupted! You should delete the database and Xeft will recreate it. Make sure other programs are not messing with Xeft database")))) + +(defvar xeft-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") #'xeft-create-note) + (define-key map (kbd "C-c C-g") #'xeft-refresh-full) + (define-key map (kbd "C-c C-r") #'xeft-full-reindex) + (define-key map (kbd "C-n") #'xeft-next) + (define-key map (kbd "C-p") #'xeft-previous) + map) + "Mode map for `xeft-mode'.") + +(defvar xeft--need-refresh) +(define-derived-mode xeft-mode fundamental-mode + "Xeft" "Search for notes and display summaries." + (let ((inhibit-read-only t)) + (visual-line-mode) + (setq default-directory xeft-directory + xeft--last-window-config (current-window-configuration)) + ;; Hook ‘after-change-functions’ is too primitive, binding to that + ;; will cause problems with electric-pairs. + (add-hook 'post-command-hook + (lambda (&rest _) + (when xeft--need-refresh + (let ((inhibit-modification-hooks t)) + ;; We don’t want ‘after-change-functions’ to run + ;; when we refresh the buffer, because we set + ;; ‘xeft--need-refresh’ in that hook. + (xeft-refresh)))) + 0 t) + (add-hook 'after-change-functions + (lambda (&rest _) (setq xeft--need-refresh t)) 0 t) + (add-hook 'window-size-change-functions + (lambda (&rest _) (xeft-refresh)) 0 t) + (add-hook 'kill-buffer-hook + (lambda () + (when xeft--last-window-config + (set-window-configuration xeft--last-window-config))) + 0 t) + (erase-buffer) + (insert "\n\nInsert search phrase and press RET to search.") + (goto-char (point-min)))) + + +;;; Userland + +;;;###autoload +(defun xeft () + "Start Xeft." + (interactive) + (when (not (file-name-absolute-p xeft-directory)) + (user-error "XEFT-DIRECTORY must be an absolute path")) + (when (not (file-exists-p xeft-directory)) + (mkdir xeft-directory t)) + (when (not (file-name-absolute-p xeft-database)) + (user-error "XEFT-DATABASE must be an absolute path")) + (when (not (file-exists-p xeft-database)) + (mkdir xeft-database t)) + (unless (require 'xapian-lite nil t) + ;; I can hide download option for non-Linux/mac users, but I’m + ;; lazy. + (let* ((choice (read-char (concat + "Xeft needs the dynamic module to work, " + "download pre-built module " + (propertize "[b]" 'face 'bold) + ", compile locally " + (propertize "[c]" 'face 'bold) + ", or give up " + (propertize "[q]" 'face 'bold) + "?"))) + (success (cond ((eq choice ?b) + (xeft--download-module)) + ((eq choice ?c) + (xeft--compile-module)) + (t nil)))) + (when success + (require 'xapian-lite)))) + (if (not (featurep 'xapian-lite)) + (message "Since there is no require dynamic module, we can’t start Xeft") + (setq xeft--last-window-config (current-window-configuration)) + (switch-to-buffer (xeft--buffer)) + (when (not (derived-mode-p 'xeft-mode)) + (xeft-mode)) + ;; Reindex all files. We reindex every time M-x xeft is called. + ;; Because sometimes I use other functions to move between files, + ;; edit them, and come back to Xeft buffer to search. By that time + ;; some file are changed without Xeft noticing. + (xeft-full-reindex) + ;; Also regenerate newest file cache, for the same reason as above. + (xeft--front-page-cache-refresh))) + +(defun xeft-create-note () + "Create a new note with the current search phrase as the title." + (interactive) + (let* ((search-phrase (xeft--get-search-phrase)) + (file-name (funcall xeft-filename-fn search-phrase)) + (file-path (expand-file-name file-name xeft-directory)) + (exists-p (file-exists-p file-path))) + ;; If there is no match, create the file without confirmation, + ;; otherwise prompt for confirmation. NOTE: this is not DRY, but + ;; should be ok. + (when (or (search-forward "Press RET to create a new note" nil t) + (y-or-n-p (format "Create file `%s'? " file-name))) + (find-file file-path) + (unless exists-p + (insert search-phrase "\n\n") + (save-buffer) + ;; This should cover most cases. + (xeft--front-page-cache-refresh)) + (run-hooks 'xeft-find-file-hook)))) + +(defvar-local xeft--select-overlay nil + "Overlay used for highlighting selected search result.") + +(defun xeft--highlight-file-at-point () + "Activate (highlight) the file excerpt button at point." + (when-let ((button (button-at (point)))) + ;; Create the overlay if it doesn't exist yet. + (when (null xeft--select-overlay) + (setq xeft--select-overlay (make-overlay (button-start button) + (button-end button))) + (overlay-put xeft--select-overlay 'evaporate t) + (overlay-put xeft--select-overlay 'face 'xeft-selection)) + ;; Move the overlay over the file. + (move-overlay xeft--select-overlay + (button-start button) (button-end button)))) + +(defun xeft-next () + "Move to next file excerpt." + (interactive) + (when (forward-button 1 nil nil t) + (xeft--highlight-file-at-point))) + +(defun xeft-previous () + "Move to previous file excerpt." + (interactive) + (if (backward-button 1 nil nil t) + (xeft--highlight-file-at-point) + ;; Go to the end of the search phrase. + (goto-char (point-min)) + (end-of-line))) + +(defun xeft-full-reindex () + "Do a full reindex of all files." + (interactive) + (condition-case _ + (dolist (file (funcall xeft-file-list-function)) + (xapian-lite-reindex-file file xeft-database)) + (xapian-lite-database-lock-error + (message "The Xeft database is locked (maybe there is another Xeft instance running) so we will skip indexing for now")) + (xapian-lite-database-corrupt-error + (message "The Xeft database is corrupted! You should delete the database and Xeft will recreate it. Make sure other programs are not messing with Xeft database")))) + +;;; Draw + +(defvar xeft--preview-window nil + "Xeft shows file previews in this window.") + +(defun xeft--get-search-phrase () + "Return the search phrase. Assumes current buffer is a xeft buffer." + (save-excursion + (goto-char (point-min)) + (string-trim + (buffer-substring-no-properties (point) (line-end-position))))) + +(defun xeft--find-file-at-point () + "View file at point." + (interactive) + (find-file (button-get (button-at (point)) 'path)) + (run-hooks 'xeft-find-file-hook) + (add-hook 'after-save-hook #'xeft--after-save 0 t)) + +(defun xeft--preview-file (file &optional select) + "View FILE in another window. +If SELECT is non-nil, select the buffer after displaying it." + (interactive) + (let* ((buffer (find-file-noselect file)) + (search-phrase (xeft--get-search-phrase)) + (keyword-list (split-string search-phrase))) + (if (and (window-live-p xeft--preview-window) + (not (eq xeft--preview-window (selected-window)))) + (with-selected-window xeft--preview-window + (switch-to-buffer buffer)) + (setq xeft--preview-window + (display-buffer + buffer '((display-buffer-use-some-window + display-buffer-in-direction + display-buffer-pop-up-window) + . ((inhibit-same-window . t) + (direction . right) + (window-width + . (lambda (win) + (let ((width (window-width))) + (when (< width 50) + (window-resize + win (- 50 width) t)))))))))) + (if select (select-window xeft--preview-window)) + (with-current-buffer buffer + (xeft--highlight-matched keyword-list) + (run-hooks 'xeft-find-file-hook)))) + +(define-button-type 'xeft-excerpt + 'action (lambda (button) + ;; If the file is no already highlighted, highlight it + ;; first. + (when (not (and xeft--select-overlay + (overlay-buffer xeft--select-overlay) + (<= (overlay-start xeft--select-overlay) + (button-start button) + (overlay-end xeft--select-overlay)))) + (goto-char (button-start button)) + (xeft--highlight-file-at-point)) + (xeft--preview-file (button-get button 'path))) + 'keymap (let ((map (make-sparse-keymap))) + (set-keymap-parent map button-map) + (define-key map (kbd "RET") #'xeft--find-file-at-point) + (define-key map (kbd "SPC") #'push-button) + map) + 'help-echo "Open this file" + 'follow-link t + 'face 'default + 'mouse-face 'xeft-selection) + +(defun xeft--highlight-search-phrase () + "Highlight search phrases in buffer." + (let ((keyword-list (cl-remove-if + (lambda (word) + (or (member word '("OR" "AND" "XOR" "NOT" "NEAR")) + (string-prefix-p "ADJ" word))) + (split-string (xeft--get-search-phrase)))) + (inhibit-read-only t)) + (dolist (keyword keyword-list) + (when (> (length keyword) 1) + (goto-char (point-min)) + (forward-line 2) + ;; We use overlay because overlay allows face composition. + ;; So we can have bold + underline. + (while (search-forward keyword nil t) + (let ((ov (make-overlay (match-beginning 0) + (match-end 0)))) + (overlay-put ov 'face 'xeft-inline-highlight) + (overlay-put ov 'xeft-highlight t) + (overlay-put ov 'evaporate t))))))) + +(defvar xeft--ecache nil + "Cache for finding excerpt for a file.") + +(defun xeft--ecache-buffer (file) + "Return a buffer that has the content of FILE. +Doesn’t check for modification time, and not used." + (or (alist-get (sxhash file) xeft--ecache) + (progn + (let ((buf (get-buffer-create + (format " *xeft-ecache %s*" file)))) + (with-current-buffer buf + (setq buffer-undo-list t) + (insert-file-contents file nil nil nil t)) + (push (cons (sxhash file) buf) xeft--ecache) + (when (> (length xeft--ecache) 30) + (kill-buffer (cdr (nth 30 xeft--ecache))) + (setcdr (nthcdr 29 xeft--ecache) nil)) + buf)))) + +(defun xeft--insert-file-excerpt (file search-phrase) + "Insert an excerpt for FILE at point. +This excerpt contains note title and content excerpt and is +clickable. FILE should be an absolute path. SEARCH-PHRASE is the +search phrase the user typed." + (let ((excerpt-len (floor (* 2.7 (1- (window-width))))) + (last-search-term + (car (last (split-string search-phrase)))) + title excerpt) + (with-current-buffer (xeft--work-buffer) + (setq buffer-undo-list t) + ;; The times saved by caching is not significant enough. So I + ;; choose to not cache, but kept the code just in case. See + ;; ‘xeft--ecache-buffer’. + (insert-file-contents file nil nil nil t) + (goto-char (point-min)) + (search-forward "#+TITLE: " (line-end-position) t) + (let ((bol (point))) + (end-of-line) + (setq title (buffer-substring-no-properties bol (point)))) + (when (eq title "") (setq title "no title")) + (narrow-to-region (point) (point-max)) + ;; Grab excerpt. + (setq excerpt (string-trim + (replace-regexp-in-string + "[[:space:]]+" + " " + (if (and last-search-term + (search-forward last-search-term nil t)) + (buffer-substring-no-properties + (max (- (point) (/ excerpt-len 2)) + (point-min)) + (min (+ (point) (/ excerpt-len 2)) + (point-max))) + (buffer-substring-no-properties + (point) + (min (+ (point) excerpt-len) + (point-max)))))))) + ;; Now we insert the excerpt + (let ((start (point))) + (insert (propertize title 'face 'xeft-excerpt-title) + "\n" + (propertize excerpt 'face 'xeft-excerpt-body) + "\n\n") + ;; If we use overlay (with `make-button'), the button's face + ;; will override the bold and light face we specified above. + (make-text-button start (- (point) 2) + :type 'xeft-excerpt + 'path file)))) + +;;; Refresh and search + +(defun xeft-refresh-full () + "Refresh and display _all_ results." + (interactive) + (xeft-refresh t)) + +(defun xeft--file-list () + "Default function for ‘xeft-file-list-function’. +Return a list of all files in ‘xeft-directory’, ignoring dot +files and directories and check for ‘xeft-ignore-extension’." + (cl-remove-if-not + (lambda (file) + (and (file-regular-p file) + (not (string-prefix-p + "." (file-name-base file))) + (not (member (file-name-extension file) + xeft-ignore-extension)))) + (if xeft-recursive + (directory-files-recursively + xeft-directory "" nil (lambda (dir) + (not (string-prefix-p + "." (file-name-base dir))))) + (directory-files + xeft-directory t nil t)))) + +(defvar-local xeft--need-refresh t + "If change is made to the buffer, set this to t. +Once refreshed the buffer, set this to nil.") + +(defun xeft--tighten-search-phrase (phrase) + "Basically insert AND between each term in PHRASE." + (let ((lst (split-string phrase)) + (in-quote nil)) + ;; Basically we only insert AND between two normal phrases, and + ;; don’t insert if any of the two is an operator (AND, OR, +/-, + ;; etc), we also don’t insert AND in quoted phrases. + (string-join + (append (cl-loop for idx from 0 to (- (length lst) 2) + for this = (nth idx lst) + for next = (nth (1+ idx) lst) + collect this + if (and (not in-quote) (eq (aref this 0) ?\")) + do (setq in-quote t) + if (and in-quote + (eq (aref this (1- (length this))) ?\")) + do (setq in-quote nil) + if (not + (or in-quote + (member this '("AND" "NOT" "OR" "XOR" "NEAR")) + (string-prefix-p "ADJ" this) + (memq (aref this 0) '(?+ ?-)) + (member next '("AND" "NOT" "OR" "XOR" "NEAR")) + (string-prefix-p "ADJ" next) + (memq (aref next 0) '(?+ ?-)))) + collect "AND") + (last lst)) + " "))) + +;; This makes the integrative search results much more stable and +;; experience more fluid. And because we are not showing radically +;; different results from one key-press to another, the latency goes +;; down, I’m guessing because caching in CPU or RAM or OS or whatever. +(defun xeft--ignore-short-phrase (phrase) + "If the last term in PHRASE is too short, remove it." + (let* ((lst (or (split-string phrase) '(""))) + (last (car (last lst)))) + (if (and (not (string-match-p (rx (or (category chinese) + (category japanese) + (category korean))) + last)) + (< (length last) 3)) + (string-join (cl-subseq lst 0 (1- (length lst))) " ") + (string-join lst " ")))) + +;; See comment in ‘xeft-refresh’. +(defvar xeft--front-page-cache nil + "Stores the newest 15 or so files.") + +(defun xeft--front-page-cache-refresh () + "Refresh ‘xeft--front-page-cache’ and return it." + (setq xeft--front-page-cache + (cl-sort (funcall xeft-file-list-function) + #'file-newer-than-file-p))) + +(defun xeft-refresh (&optional full) + "Search for notes and display their summaries. +By default, only display the first 15 results. If FULL is +non-nil, display all results." + (interactive) + (when (derived-mode-p 'xeft-mode) + (let ((search-phrase (xeft--ignore-short-phrase + (xeft--get-search-phrase)))) + (let* ((phrase-empty (equal search-phrase "")) + (file-list nil) + (list-clipped nil)) + ;; 1. Get a list of files to show. + (setq file-list + ;; If the search phrase is empty (or too short and thus + ;; ignored), we show the newest files. + (if phrase-empty + (or xeft--front-page-cache + ;; Why cache? Turns out sorting this list by + ;; modification date is slow enough to be + ;; perceivable. + (setq xeft--front-page-cache + (xeft--front-page-cache-refresh))) + (xapian-lite-query-term + (xeft--tighten-search-phrase search-phrase) + xeft-database + ;; 16 is just larger than 15, so we will know it when + ;; there are more results. + 0 (if full 2147483647 16)))) + (when (and (null full) (> (length file-list) 15)) + (setq file-list (cl-subseq file-list 0 15) + list-clipped t)) + ;; 2. Display these files with excerpt. We do a + ;; double-buffering: first insert in a temp buffer, then + ;; insert the whole thing into this buffer. + (let ((inhibit-read-only t) + (orig-point (point)) + (new-content + (while-no-input + (with-temp-buffer + ;; Insert excerpts. + (if file-list + (dolist (file file-list) + (xeft--insert-file-excerpt + file search-phrase)) + ;; NOTE: this string is referred in + ;; ‘xeft-create-note’. + (unless phrase-empty + (insert "Press RET to create a new note"))) + ;; Insert clipped notice. + (when list-clipped + (insert + (format + "[Only showing the first 15 results, type %s to show all of them]\n" + (key-description + (where-is-internal #'xeft-refresh-full + xeft-mode-map t))))) + (buffer-string))))) + ;; 2.2 Actually insert the content. + (when (stringp new-content) + (while-no-input + (setq buffer-undo-list t) + (goto-char (point-min)) + (forward-line 2) + (let ((start (point))) + (delete-region (point) (point-max)) + (insert new-content) + (put-text-property (- start 2) (point) 'read-only t) + (xeft--highlight-search-phrase) + (set-buffer-modified-p nil) + ;; If finished, update this variable. + (setq xeft--need-refresh nil) + (buffer-enable-undo)))) + ;; Save excursion wouldn’t work since we erased the + ;; buffer and re-inserted contents. + (goto-char orig-point) + ;; Re-apply highlight. + (xeft--highlight-file-at-point)))))) + +;;; Highlight matched phrases + +(defun xeft--highlight-matched (keyword-list) + "Highlight keywords in KEYWORD-LIST in the current buffer." + (save-excursion + ;; Add highlight overlays. + (dolist (keyword keyword-list) + (when (> (length keyword) 1) + (goto-char (point-min)) + (while (search-forward keyword nil t) + (let ((ov (make-overlay (match-beginning 0) + (match-end 0)))) + (overlay-put ov 'face 'xeft-preview-highlight) + (overlay-put ov 'xeft-highlight t))))) + ;; Add cleanup hook. + (add-hook 'window-selection-change-functions + #'xeft--cleanup-highlight + 0 t))) + +(defun xeft--cleanup-highlight (window) + "Cleanup highlights in WINDOW." + (when (eq window (selected-window)) + (let ((ov-list (overlays-in (point-min) + (point-max)))) + (dolist (ov ov-list) + (when (overlay-get ov 'xeft-highlight) + (delete-overlay ov)))) + (remove-hook 'window-selection-change-functions + #'xeft--cleanup-highlight + t))) + +;;; Inferred links + +(defun xeft--extract-buffer-words (buffer) + "Extract words in BUFFER and return in a list. +Each element looks like (BEG . WORD) where BEG is the buffer +position of WORD." + (with-current-buffer buffer + (goto-char (point-min)) + (let (beg end word-list) + (while (progn (and (re-search-forward (rx word) nil t) + (setq beg (match-beginning 0)) + (re-search-forward (rx (not word)) nil t) + (setq end (match-beginning 0)))) + (push (cons beg (buffer-substring-no-properties beg end)) + word-list)) + (nreverse word-list)))) + +(defun xeft--generate-phrase-list (word-list max-len) + "Given WORD-LIST, generate all possible phrases up to MAX-LEN long. +Eg, given WORD-LIST = (a b c), len = 3, return + + ((a) (b) (c) (a b) (b c) (a b c))" + (cl-loop for len from 1 to max-len + append (cl-loop + for idx from 0 to (- (length word-list) len) + collect (cl-subseq word-list idx (+ idx len))))) + +(defun xeft--collect-inferred-links + (buffer max-len lower-bound upper-bound) + "Collect inferred links in BUFFER. +MAX-LEN is the same as in ‘xeft--generate-phrase-list’. Only +phrases with number of results between LOWER-BOUND and +UPPER-BOUND (inclusive) are collected." + (let* ((word-list (xeft--extract-buffer-words buffer)) + (phrase-list (xeft--generate-phrase-list + word-list max-len)) + (query-list (mapcar (lambda (phrase-list) + (let ((pos (caar phrase-list)) + (words (mapcar #'cdr phrase-list))) + (cons pos (concat "\"" + (string-join + words) + "\"")))) + phrase-list)) + (link-list + ;; QUERY-CONS = (POS . QUERY-TERM) + (cl-loop for query-cons in query-list + for file-list = (xapian-lite-query-term + (cdr query-cons) xeft-database + 0 (1+ upper-bound)) + if (<= lower-bound (length file-list) upper-bound) + collect (cons (cdr query-cons) + (length file-list))))) + link-list)) + +(provide 'xeft) + +;;; xeft.el ends here