kemonine/emacs
Archived
1
0
Fork 0
Code Activity

add xeft ; unused config -- kept for posterity and safety while evaluating search options

Browse source
This commit is contained in:
KemoNine 2022-08-25 08:41:17 -04:00
parent 12264c9d71
commit 0024c2a897
11 changed files with 2293 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -1,5 +1,6 @@
*.elc *.elc
orig/ orig/
org/deft
**ido.last** **ido.last**
**projectile-bookmarks** **projectile-bookmarks**
**/auto-save-list **/auto-save-list
@ -9,3 +10,4 @@ orig/
**/beancount-mode **/beancount-mode
**/transient **/transient
**/.org-id-locations **/.org-id-locations
**/xapian-lite.so

9
org/init.el
View file

@ -80,6 +80,15 @@
(setq org-support-shift-select t) (setq org-support-shift-select t)
(setq org-src-fontify-natively 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 ; tags
(load "~/.emacs.d.profiles/org/config-org-tags") (load "~/.emacs.d.profiles/org/config-org-tags")

23
org/xeft/Makefile Normal file
View file

@ -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

84
org/xeft/README.md Normal file
View file

@ -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 <https://github.com/casouri/xapian-lite>.

2
org/xeft/gitignore Normal file
View file

@ -0,0 +1,2 @@
*.so
*.o

164
org/xeft/module/emacs-module-prelude.h Normal file
View file

@ -0,0 +1,164 @@
#include "emacs-module.h"
#include <stdbool.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#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 */

763
org/xeft/module/emacs-module.h Normal file
View file

@ -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 <https://www.gnu.org/licenses/>. */
/*
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 <stddef.h>
#include <stdint.h>
#include <time.h>
#ifndef __cplusplus
#include <stdbool.h>
#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 */

40
org/xeft/module/xapian-lite-internal.h Normal file
View file

@ -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 */

446
org/xeft/module/xapian-lite.cc Normal file
View file

@ -0,0 +1,446 @@
#include <string>
#include <cstring>
#include <iostream>
#include <fstream>
#include <vector>
#include <exception>
#include <iterator>
#include <cstdarg>
#include <stdlib.h>
#include <assert.h>
#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <xapian.h>
#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<char>(infile)),
(istreambuf_iterator<char>()));
// 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<string>
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<string> 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<string> 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<string>::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;
}

BIN
org/xeft/xapian-lite.dll Normal file
View file

Binary file not shown.

760
org/xeft/xeft.el Normal file
View file

@ -0,0 +1,760 @@
;;; xeft.el --- Deft feat. Xapian -*- lexical-binding: t; -*-
;; Author: Yuan Fu <casouri@gmail.com>
;;; 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