BASENAME = sweep
-UNAME_S := $(shell uname -s)
-ifeq ($(UNAME_S),Linux)
- SOEXT = so
-endif
-ifeq ($(UNAME_S),Darwin)
- SOEXT = dylib
-endif
+EMACS ?= emacs
-SWIPL ?= swipl
-SWIPLBASE = $(shell $(SWIPL) --dump-runtime-variables | grep PLBASE | cut -f 2 -d = | cut -f 1 -d ';')
-SWIPLLIBDIR = $(shell $(SWIPL) --dump-runtime-variables | grep PLLIBDIR | cut -f 2 -d = | cut -f 1 -d ';')
+.PHONY: clean check info
-EMACS ?= emacs
-
-TARGET = $(BASENAME)-module.$(SOEXT)
-OBJECT = $(BASENAME).o
-SOURCE = $(BASENAME).c
-
-LDFLAGS += -shared
-LDFLAGS += -L$(SWIPLLIBDIR)
-LDFLAGS += -lswipl
-
-CFLAGS += -fPIC
-CFLAGS += -Wall
-CFLAGS += -Wextra
-CFLAGS += -O2
-CFLAGS += -I$(SWIPLBASE)/include
-
-.PHONY: clean all check info
-
-all: $(TARGET)
-
-$(OBJECT): $(SOURCE)
- $(CC) $(CFLAGS) -o $@ -c $(SOURCE)
-
-$(TARGET): $(OBJECT)
- $(CC) -o $@ $(OBJECT) $(LDFLAGS)
+check: $(TARGET)
+ $(EMACS) --batch --eval '(add-to-list (quote load-path) (expand-file-name "."))' \
+ -l ert -l sweep -l sweep-tests.el -f ert-run-tests-batch-and-exit
clean:
- rm -f $(TARGET) $(OBJECT) $(BASENAME).info $(BASENAME).texi $(BASENAME).html
+ rm -f $(BASENAME).info $(BASENAME).texi $(BASENAME).html
info: $(BASENAME).info
+
$(BASENAME).info:: README.org
$(EMACS) -Q --batch --eval "(require 'ox-texinfo)" \
--eval "(with-current-buffer (find-file \"README.org\") (org-export-to-file (quote texinfo) \"$@\" nil nil nil nil nil (quote org-texinfo-compile)))"
-
-check: $(TARGET)
- $(EMACS) --batch --eval '(add-to-list (quote load-path) (expand-file-name "."))' \
- -l ert -l sweep -l sweep-tests.el -f ert-run-tests-batch-and-exit
+++ /dev/null
-/* emacs-module.h - GNU Emacs module API.
-
-Copyright (C) 2015-2022 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 29
-
-#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_29 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);
-
- 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);
-};
-
-struct emacs_env_29
-{
- /* 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);
-
- 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);
-
- /* Add module environment functions newly added in Emacs 29 here.
- Before Emacs 29 is released, remove this comment and start
- module-env-30.h on the master branch. */
-};
-
-/* 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 */
+++ /dev/null
-/*
- Author: Eshel Yaron
- E-mail: eshel@swi-prolog.org
- Copyright (c) 2022, SWI-Prolog Solutions b.v.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions
- are met:
-
- 1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
- 2. Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in
- the documentation and/or other materials provided with the
- distribution.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
- COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- POSSIBILITY OF SUCH DAMAGE.
-*/
-
-#include "emacs-module.h"
-#include <SWI-Prolog.h>
-#include <SWI-Stream.h>
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
-int plugin_is_GPL_compatible;
-
-term_t output_term = 0;
-emacs_env * current_env = NULL;
-
-static int value_to_term(emacs_env*, emacs_value, term_t);
-static emacs_value term_to_value(emacs_env*, term_t);
-
-void
-ethrow(emacs_env *env, const char * message) {
- ptrdiff_t len = strlen(message);
-
- emacs_value str = env->make_string(env, message, len);
- emacs_value arg = env->funcall (env, env->intern (env, "list"), 1, &str);
- env->non_local_exit_signal(env, env->intern(env, "error"), arg);
-}
-
-char*
-estring_to_cstring(emacs_env *eenv, emacs_value estring, ptrdiff_t *len_p) {
- char * buf = NULL;
- ptrdiff_t len = 0;
-
- if (len_p == NULL) len_p = &len;
-
- if (!eenv->copy_string_contents(eenv, estring, NULL, len_p)) {
- ethrow(eenv, "Failed to get string length");
- return NULL;
- }
- if ((buf = (char*)malloc((*len_p))) == NULL) {
- ethrow(eenv, "malloc failed");
- return NULL;
- }
- memset(buf, 0, (*len_p));
- if (!eenv->copy_string_contents(eenv, estring, buf, len_p)) {
- ethrow(eenv, "Failed to copy string contents");
- free(buf);
- buf = NULL;
- }
-
- return buf;
-}
-
-int
-estring_to_pstring(emacs_env *eenv, emacs_value estring, term_t t) {
- ptrdiff_t len = 0;
- char *buf = NULL;
- int i = 0;
-
- if ((buf = estring_to_cstring(eenv, estring, &len)) == NULL) return -1;
- i = PL_put_chars(t, PL_STRING|REP_UTF8, len - 1, buf);
- free(buf);
- return i;
-}
-
-static emacs_value
-econs(emacs_env *env, emacs_value car, emacs_value cdr) {
- emacs_value args[2] = {car, cdr};
- return env->funcall (env, env->intern (env, "cons"), 2, args);
-}
-
-static emacs_value
-ecar(emacs_env *env, emacs_value cons) {
- return env->funcall (env, env->intern (env, "car"), 1, &cons);
-}
-
-static emacs_value
-ecdr(emacs_env *env, emacs_value cons) {
- return env->funcall (env, env->intern (env, "cdr"), 1, &cons);
-}
-
-
-emacs_value
-enil(emacs_env *env) { return env->intern(env, "nil"); }
-
-emacs_value
-et(emacs_env *env) { return env->intern(env, "t"); }
-
-static emacs_value
-term_to_value_list(emacs_env *eenv, term_t l) {
- term_t ph = PL_new_term_ref();
- term_t pt = PL_new_term_ref();
-
- if (PL_get_list(l, ph, pt)) {
- return econs(eenv, term_to_value(eenv, ph), term_to_value(eenv, pt));
- } else return NULL;
-}
-
-static emacs_value
-term_to_value_integer(emacs_env *eenv, term_t t) {
- emacs_value v = NULL;
- int64_t l = -1;
- if (PL_get_int64(t, &l)) {
- v = eenv->make_integer(eenv, l);
- }
- return v;
-}
-
-static emacs_value
-term_to_value_float(emacs_env *eenv, term_t t) {
- emacs_value v = NULL;
- double l = -1;
- if (PL_get_float(t, &l)) {
- v = eenv->make_float(eenv, l);
- }
- return v;
-}
-
-emacs_value
-term_to_value_string(emacs_env *eenv, term_t t) {
- char * string = NULL;
- emacs_value v = NULL;
- size_t l = -1;
- if (PL_get_nchars(t, &l, &string, CVT_STRING|REP_UTF8)) {
- v = eenv->make_string(eenv, string, l);
- }
- return v;
-}
-
-emacs_value
-term_to_value_atom(emacs_env *eenv, term_t t) {
- char * string = NULL;
- emacs_value v = NULL;
- emacs_value s = NULL;
- size_t l = -1;
-
- if (PL_get_nchars(t, &l, &string, CVT_ATOM|REP_UTF8)) {
- s = eenv->make_string(eenv, string, l);
- v = econs(eenv, eenv->intern(eenv, "atom"), s);
- }
- return v;
-}
-
-emacs_value
-term_to_value_variable(emacs_env *env, term_t t) {
- (void)t;
- return env->intern(env, "variable");
-}
-
-emacs_value
-term_to_value_dict(emacs_env *env, term_t t) {
- (void)t;
- return env->intern(env, "dict");
-}
-
-emacs_value
-term_to_value_blob(emacs_env *env, term_t t) {
- (void)t;
- return env->intern(env, "blob");
-}
-
-emacs_value
-term_to_value_compound(emacs_env *env, term_t t) {
- atom_t name = 0;
- size_t arity = 0;
- term_t arg = PL_new_term_ref();
- const char * chars = NULL;
- size_t len = 0;
- emacs_value * vals = NULL;
- emacs_value res = NULL;
- size_t n = 0;
-
- if (!PL_get_compound_name_arity(t, &name, &arity)) {
- ethrow(env, "Not a compound");
- goto cleanup;
- }
-
- chars = PL_atom_nchars(name, &len);
-
- vals = (emacs_value*)malloc(sizeof(emacs_value)*arity + 1);
- if (vals == NULL) {
- ethrow(env, "malloc failed");
- return NULL;
- }
- memset(vals, 0, sizeof(emacs_value)*arity + 1);
-
- vals[0] = env->make_string(env, chars, len);
-
- for(n=1; n<=arity; n++) {
- if (!PL_get_arg(n, t, arg)) {
- ethrow(env, "get_arg falied");
- goto cleanup;
- }
- vals[n] = term_to_value(env, arg);
- }
-
- res = econs(env, env->intern(env, "compound"), env->funcall(env, env->intern(env, "list"), arity + 1, vals));
-
- cleanup:
- if (vals != NULL) free(vals);
-
- return res;
-}
-
-emacs_value
-term_to_value(emacs_env *env, term_t t) {
- switch (PL_term_type(t)) {
- case PL_VARIABLE:
- return term_to_value_variable(env, t);
- case PL_ATOM:
- return term_to_value_atom(env, t);
- case PL_STRING:
- return term_to_value_string(env, t);
- case PL_NIL:
- return enil(env);
- case PL_LIST_PAIR:
- return term_to_value_list(env, t);
- case PL_INTEGER:
- return term_to_value_integer(env, t);
- case PL_TERM:
- return term_to_value_compound(env, t);
- case PL_DICT:
- return term_to_value_dict(env, t);
- case PL_BLOB:
- return term_to_value_blob(env, t);
- case PL_FLOAT:
- return term_to_value_float(env, t);
- default:
- /* ethrow(env, "Prolog to Elisp conversion failed"); */
- /* return NULL; */
- return env->intern(env, "unconvertable");
- }
-}
-
-int
-value_to_term_string(emacs_env *env, emacs_value v, term_t t) {
- return estring_to_pstring(env, v, t);
-}
-
-int
-value_to_term_integer(emacs_env *env, emacs_value v, term_t t) {
- intmax_t l = env->extract_integer(env, v);
- return PL_put_int64(t, l);
-}
-
-int
-value_to_term_float(emacs_env *env, emacs_value v, term_t t) {
- double l = env->extract_float(env, v);
- return PL_put_float(t, l);
-}
-
-int
-value_to_term_list(emacs_env *env, emacs_value v, term_t t) {
- int r = -1;
- term_t head = PL_new_term_ref();
- term_t tail = PL_new_term_ref();
- emacs_value car = ecar(env, v);
- emacs_value cdr = ecdr(env, v);
- if ((r = value_to_term(env, car, head)) < 0) {
- return r;
- }
- if ((r = value_to_term(env, cdr, tail)) < 0) {
- return r;
- }
- return PL_cons_list(t, head, tail);
-}
-
-int
-value_to_term(emacs_env *env, emacs_value v, term_t t) {
- int r = -1;
- emacs_value vt = env->type_of(env, v);
-
- if (env->is_not_nil(env, v)) {
- if (env->eq(env, vt, env->intern(env, "string"))) {
- r = value_to_term_string(env, v, t);
- } else if (env->eq(env, vt, env->intern(env, "integer"))) {
- r = value_to_term_integer(env, v, t);
- } else if (env->eq(env, vt, env->intern(env, "cons"))) {
- r = value_to_term_list(env, v, t);
- } else if (env->eq(env, vt, env->intern(env, "float"))) {
- r = value_to_term_float(env, v, t);
- } else r = -1;
- } else r = PL_put_nil(t);
-
- return r;
-}
-
-emacs_value
-sweep_close_query(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
-{
- qid_t d = PL_current_query();
-
- (void)data;
- (void)nargs;
- (void)args;
-
- if (d == 0) {
- ethrow(env, "No current query");
- return NULL;
- }
-
- switch (PL_close_query(d)) {
- case FALSE:
- return term_to_value(env, PL_exception(d));
- default:
- return et(env);
- }
-}
-
-emacs_value
-sweep_cut_query(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
-{
- qid_t d = PL_current_query();
-
- (void)data;
- (void)nargs;
- (void)args;
-
- if (d == 0) {
- ethrow(env, "No current query");
- return NULL;
- }
-
- switch (PL_cut_query(d)) {
- case FALSE:
- return term_to_value(env, PL_exception(d));
- default:
- return et(env);
- }
-}
-
-emacs_value
-sweep_next_solution(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
-{
- qid_t d = PL_current_query();
-
- (void)data;
- (void)nargs;
- (void)args;
-
- if (d == 0) {
- ethrow(env, "No current query");
- return NULL;
- }
-
- current_env = env;
-
- switch (PL_next_solution(d)) {
- case PL_S_EXCEPTION:
- return econs(env, env->intern(env, "exception"), term_to_value(env, PL_exception(d)));
- case PL_S_FALSE:
- return enil(env);
- case PL_S_TRUE:
- return econs(env, et(env), term_to_value(env, output_term));
- case PL_S_LAST:
- return econs(env, env->intern(env, "!"), term_to_value(env, output_term));
- default:
- return NULL;
- }
-}
-
-emacs_value
-sweep_open_query(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
-{
- predicate_t p = NULL;
- char * m = NULL;
- module_t n = NULL;
- char * c = NULL;
- char * f = NULL;
- term_t a = PL_new_term_refs(2);
- emacs_value r = enil(env);
- emacs_value s = NULL;
-
- (void)data;
- if (nargs == 4) {
- s = enil(env);
- } else {
- s = args[4];
- }
-
- if (PL_current_query() != 0) {
- ethrow(env, "Prolog is already executing a query");
- goto cleanup;
- }
-
- if ((c = estring_to_cstring(env, args[0], NULL)) == NULL) {
- goto cleanup;
- }
-
- n = PL_new_module(PL_new_atom(c));
-
- if ((m = estring_to_cstring(env, args[1], NULL)) == NULL) {
- goto cleanup;
- }
-
- if ((f = estring_to_cstring(env, args[2], NULL)) == NULL) {
- goto cleanup;
- }
-
- p = PL_predicate(f, 2, m);
-
- if (value_to_term(env, args[3], a+(env->is_not_nil(env, s) ? 1 : 0)) < 0) {
- goto cleanup;
- }
-
- current_env = env;
-
- PL_open_query(n, PL_Q_NODEBUG | PL_Q_EXT_STATUS | PL_Q_CATCH_EXCEPTION, p, a);
-
- output_term = a+(env->is_not_nil(env, s) ? 0 : 1);
-
- r = et(env);
-
- cleanup:
- if (c != NULL) free(c);
- if (m != NULL) free(m);
- if (f != NULL) free(f);
-
- return r;
-}
-
-static emacs_value
-sweep_initialize(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
-{
- (void)data;
- int i = 0, r = 0;
- char **argv = (char**)malloc(sizeof(char*)*nargs);
- if (argv == NULL) {
- ethrow(env, "malloc failed");
- return NULL;
- }
- for (i = 0; i < nargs; i++) {
- if ((argv[i] = estring_to_cstring(env, args[i], NULL)) == NULL) {
- free(argv);
- return NULL;
- }
- }
-
- if (PL_version_info(PL_VERSION_SYSTEM < 80516))
- PL_action(PL_GMP_SET_ALLOC_FUNCTIONS, FALSE);
-
- r = PL_initialise(nargs, argv);
-
- for (i = 0; i < nargs; i++) {
- free(argv[i]);
- }
- free(argv);
- return env->intern(env, r ? "t" : "nil");
-}
-
-
-static emacs_value
-sweep_is_initialized(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
-{
- (void)nargs;
- (void)args;
- (void)data;
- if (PL_is_initialised(NULL, NULL) == FALSE) {
- return enil(env);
- } else return et(env);
-}
-
-static emacs_value
-sweep_cleanup(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data)
-{
- (void)nargs;
- (void)data;
- (void)args;
- return env->intern(env, (PL_cleanup(PL_CLEANUP_SUCCESS) ? "t" : "nil"));
-}
-
-
-static void provide(emacs_env *env, const char *feature) {
- emacs_value Qfeat = env->intern(env, feature);
- emacs_value Qprovide = env->intern(env, "provide");
-
- env->funcall(env, Qprovide, 1, (emacs_value[]){Qfeat});
-}
-
-static foreign_t
-sweep_funcall0(term_t f, term_t v) {
- char * string = NULL;
- emacs_value r = NULL;
- size_t l = -1;
- term_t n = PL_new_term_ref();
-
- if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) {
- r = current_env->funcall(current_env, current_env->intern(current_env, string), 0, NULL);
- if (value_to_term(current_env, r, n) >= 0) {
- if (PL_unify(n, v)) {
- return TRUE;
- }
- }
- }
- return FALSE;
-}
-
-static foreign_t
-sweep_funcall1(term_t f, term_t a, term_t v) {
- char * string = NULL;
- emacs_value e = NULL;
- emacs_value r = NULL;
- size_t l = -1;
- term_t n = PL_new_term_ref();
-
- if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) {
- e = term_to_value(current_env, a);
- if (e != NULL) {
- r = current_env->funcall(current_env, current_env->intern(current_env, string), 1, &e);
- if (value_to_term(current_env, r, n) >= 0) {
- if (PL_unify(n, v)) {
- return TRUE;
- }
- }
- }
- }
- return FALSE;
-}
-
-int
-emacs_module_init (struct emacs_runtime *runtime)
-{
- emacs_env *env = runtime->get_environment (runtime);
-
- emacs_value symbol_initialize = env->intern (env, "sweep-initialize");
- emacs_value func_initialize =
- env->make_function(env,
- 1, emacs_variadic_function,
- sweep_initialize,
- "Initialize Prolog.\n\
-ARG1 is passed as argv[0] to `PL_initialise()', which see.\n\
-REST is passed as the rest of the command line arguments to Prolog.",
- NULL);
- emacs_value args_initialize[] = {symbol_initialize, func_initialize};
- env->funcall (env, env->intern (env, "defalias"), 2, args_initialize);
-
- emacs_value symbol_is_initialized = env->intern (env, "sweep-initialized-p");
- emacs_value func_is_initialized =
- env->make_function(env,
- 0, 0,
- sweep_is_initialized,
- "Return t if Prolog is initialized, else return nil.",
- NULL);
- emacs_value args_is_initialized[] = {symbol_is_initialized, func_is_initialized};
- env->funcall (env, env->intern (env, "defalias"), 2, args_is_initialized);
-
- emacs_value symbol_open_query = env->intern (env, "sweep-open-query");
- emacs_value func_open_query =
- env->make_function(env,
- 4, 5,
- sweep_open_query,
- "Query Prolog.\n\
-ARG1 is a string denoting the context module for the query.\n\
-ARG2 and ARG3 are strings designating the module and predicate name of the Prolog predicate to invoke, which must be of arity 2.\n\
-ARG4 is any object that can be converted to a Prolog term, and will be passed as the first argument of the invoked predicate.\n\
-The second argument of the predicate is left unbound and is assumed to treated by the invoked predicate as an output variable.\n\
-If ARG5 is non-nil, reverse the order of the predicate arguments such that the first argument is the output variable and the second argument is the input term derived from ARG4.\n\
-Further instantiations of the output variable can be examined via `sweep-next-solution'.",
- NULL);
- emacs_value args_open_query[] = {symbol_open_query, func_open_query};
- env->funcall (env, env->intern (env, "defalias"), 2, args_open_query);
-
- emacs_value symbol_next_solution = env->intern (env, "sweep-next-solution");
- emacs_value func_next_solution =
- env->make_function(env,
- 0, 0,
- sweep_next_solution,
- "Return the next solution from Prolog, or nil if there are none.\n\
-See also `sweep-open-query'.",
- NULL);
- emacs_value args_next_solution[] = {symbol_next_solution, func_next_solution};
- env->funcall (env, env->intern (env, "defalias"), 2, args_next_solution);
-
- emacs_value symbol_cut_query = env->intern (env, "sweep-cut-query");
- emacs_value func_cut_query =
- env->make_function(env,
- 0, 0,
- sweep_cut_query,
- "Finalize the current Prolog query.\n\
-This function retains the current instantiation of the query variables.",
- NULL);
- emacs_value args_cut_query[] = {symbol_cut_query, func_cut_query};
- env->funcall (env, env->intern (env, "defalias"), 2, args_cut_query);
-
- emacs_value symbol_close_query = env->intern (env, "sweep-close-query");
- emacs_value func_close_query =
- env->make_function(env,
- 0, 0,
- sweep_close_query,
- "Finalize the current Prolog query.\n\
-This function drops the current instantiation of the query variables.",
- NULL);
- emacs_value args_close_query[] = {symbol_close_query, func_close_query};
- env->funcall (env, env->intern (env, "defalias"), 2, args_close_query);
-
-
- emacs_value symbol_cleanup = env->intern (env, "sweep-cleanup");
- emacs_value func_cleanup = env->make_function (env, 0, 0, sweep_cleanup, "Cleanup Prolog.", NULL);
- emacs_value args_cleanup[] = {symbol_cleanup, func_cleanup};
- env->funcall (env, env->intern (env, "defalias"), 2, args_cleanup);
-
- PL_register_foreign("sweep_funcall", 3, sweep_funcall1, 0);
- PL_register_foreign("sweep_funcall", 2, sweep_funcall0, 0);
-
- provide(env, "sweep-module");
-
- return 0;
-}
:type 'boolean
:group 'sweep)
-(defcustom sweep-init-args (list (expand-file-name
- "sweep.pl"
- (file-name-directory load-file-name)))
+(defcustom sweep-init-args (list "-q"
+ "--no-signals"
+ "-g [library(sweep)]")
"List of strings used as initialization arguments for Prolog."
:package-version '((sweep "0.1.0"))
:type '(list string)
(defun sweep-init ()
(apply #'sweep-initialize
(cons (or sweep-swipl-path (executable-find "swipl"))
- (cons "-q" (cons "--no-signals" sweep-init-args))))
+ sweep-init-args))
(sweep-setup-message-hook)
(sweep-start-prolog-server))
+++ /dev/null
-/*
- Author: Eshel Yaron
- E-mail: eshel@swi-prolog.org
- Copyright (c) 2022, SWI-Prolog Solutions b.v.
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions
- are met:
-
- 1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
- 2. Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in
- the documentation and/or other materials provided with the
- distribution.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
- COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- POSSIBILITY OF SUCH DAMAGE.
-*/
-
-:- module(sweep,
- [ sweep_colourise_buffer/2,
- sweep_colourise_some_terms/2,
- sweep_setup_message_hook/2,
- sweep_current_prolog_flags/2,
- sweep_set_prolog_flag/2,
- sweep_documentation/2,
- sweep_file_at_point/2,
- sweep_identifier_at_point/2,
- sweep_expand_file_name/2,
- sweep_path_module/2,
- sweep_load_buffer/2,
- sweep_colourise_query/2,
- sweep_predicate_references/2,
- sweep_predicate_location/2,
- sweep_predicate_apropos/2,
- sweep_predicates_collection/2,
- sweep_local_predicate_completion/2,
- sweep_modules_collection/2,
- sweep_packs_collection/2,
- sweep_pack_install/2,
- sweep_prefix_ops/2,
- sweep_op_info/2,
- sweep_module_path/2
- ]).
-
-:- use_module(library(pldoc)).
-:- use_module(library(listing)).
-:- use_module(library(prolog_source)).
-:- use_module(library(prolog_colour)).
-:- use_module(library(pldoc/doc_process)).
-:- use_module(library(pldoc/doc_wiki)).
-:- use_module(library(pldoc/doc_modes)).
-:- use_module(library(pldoc/doc_man)).
-:- use_module(library(pldoc/man_index)).
-:- use_module(library(lynx/html_text)).
-:- use_module(library(prolog_pack)).
-:- use_module(library(help)).
-:- use_module(library(prolog_server)).
-
-:- meta_predicate with_buffer_stream(-, +, 0).
-
-:- dynamic sweep_current_color/3,
- sweep_open/2,
- sweep_source_time/2,
- sweep_current_comment/3.
-
-:- multifile prolog:xref_source_time/2,
- prolog:xref_open_source/2,
- prolog:xref_open_source/2,
- prolog:quasi_quotation_syntax/2.
-
-prolog:quasi_quotation_syntax(graphql, library(http/graphql)).
-
-prolog:xref_source_time(Source, Time) :-
- sweep_source_time(Source, Time).
-
-prolog:xref_open_source(Source, Stream) :-
- sweep_open(Source, Stream).
-
-prolog:xref_close_source(Source, Stream) :-
- sweep_open(Source, Stream).
-
-
-sweep_current_prolog_flags(Sub, Flags) :-
- findall([Flag|Value],
- (current_prolog_flag(Flag0, Value0),
- atom_string(Flag0, Flag),
- once(sub_string(Flag, _, _, _, Sub)),
- term_string(Value0, Value)),
- Flags).
-
-sweep_set_prolog_flag([Flag0|Value0], []) :-
- atom_string(Flag, Flag0),
- term_string(Value, Value0),
- set_prolog_flag(Flag, Value).
-
-sweep_colourise_buffer([String|Path], Colors) :-
- setup_call_cleanup(( new_memory_file(H),
- insert_memory_file(H, 0, String),
- open_memory_file(H, read, Contents, [encoding(utf8)])
- ),
- sweep_colourise_buffer_(Path, Contents, Colors),
- ( close(Contents),
- free_memory_file(H)
- )).
-
-sweep_colourise_buffer_(Path0, Contents, []) :-
- atom_string(Path, Path0),
- set_stream(Contents, encoding(utf8)),
- set_stream(Contents, file_name(Path)),
- get_time(Time),
- asserta(sweep_open(Path, Contents), Ref0),
- asserta(sweep_source_time(Path, Time), Ref1),
- xref_source(Path, []),
- seek(Contents, 0, bof, _),
- prolog_colourise_stream(Contents,
- Path,
- sweep_handle_query_color(1)),
- erase(Ref0),
- erase(Ref1).
-
-
-sweep_file_at_point([Contents,Path0,Point], Result) :-
- atom_string(Path, Path0),
- with_buffer_stream(Stream,
- Contents,
- sweep_file_at_point_(Stream, Path, Point, Result)).
-
-:- dynamic sweep_current_file_at_point/1.
-
-sweep_file_at_point_(Stream, Path, Point, File) :-
- set_stream(Stream, file_name(Path)),
- retractall(sweep_current_file_at_point(_)),
- prolog_colourise_term(Stream, Path,
- sweep_handle_file_at_point(Point),
- []),
- sweep_current_file_at_point(File0),
- atom_string(File0, File).
-
-sweep_handle_file_at_point(Point, file_no_depend(File), Beg, Len) :-
- Beg =< Point,
- Point =< Beg + Len,
- !,
- asserta(sweep_current_file_at_point(File)).
-sweep_handle_file_at_point(Point, file(File), Beg, Len) :-
- Beg =< Point,
- Point =< Beg + Len,
- !,
- asserta(sweep_current_file_at_point(File)).
-sweep_handle_file_at_point(_, _, _, _).
-
-
-sweep_identifier_at_point([Contents0, Path, Point], Identifier) :-
- setup_call_cleanup(( new_memory_file(H),
- insert_memory_file(H, 0, Contents0),
- open_memory_file(H, read, Contents, [encoding(utf8)])
- ),
- sweep_identifier_at_point_(Path, Point, Contents, Identifier),
- ( close(Contents),
- free_memory_file(H)
- )).
-
-:- dynamic sweep_current_identifier_at_point/1.
-
-sweep_identifier_at_point_(Path0, Point, Contents, Identifier) :-
- atom_string(Path, Path0),
- ( xref_module(Path, M)
- -> true
- ; M = user
- ),
- set_stream(Contents, encoding(utf8)),
- set_stream(Contents, file_name(Path)),
- seek(Contents, 0, bof, _),
- retractall(sweep_current_identifier_at_point(_)),
- prolog_colourise_term(Contents, Path,
- sweep_handle_identifier_at_point(Path, M, Point),
- []),
- sweep_current_identifier_at_point(Identifier0),
- term_string(Identifier0, Identifier).
-
-
-sweep_handle_identifier_at_point(Path, M, Point, Col, Beg, Len) :-
- Beg =< Point,
- Point =< Beg + Len,
- !,
- sweep_handle_identifier_at_point_(Path, M, Col).
-sweep_handle_identifier_at_point(_, _, _, _, _, _).
-
-sweep_handle_identifier_at_point_(Path, M0, goal_term(Kind, Goal)) :-
- !,
- sweep_handle_identifier_at_point_goal(Path, M0, Kind, Goal).
-sweep_handle_identifier_at_point_(Path, M0, goal(Kind, Goal)) :-
- !,
- sweep_handle_identifier_at_point_goal(Path, M0, Kind, Goal).
-sweep_handle_identifier_at_point_(_Path, M0, head_term(_Kind, Goal)) :-
- !,
- sweep_handle_identifier_at_point_head(M0, Goal).
-sweep_handle_identifier_at_point_(_, _, _).
-
-
-sweep_handle_identifier_at_point_head(_, M:Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(M:PI)).
-sweep_handle_identifier_at_point_head(M, Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(M:PI)).
-
-sweep_handle_identifier_at_point_goal(_Path, M, local(_), Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(M:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M, recursion, M:Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(M:PI)).
-sweep_handle_identifier_at_point_goal(_Path, M, recursion, Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(M:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, built_in, Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, imported(Path), Goal) :-
- !,
- pi_head(PI, Goal),
- xref_module(Path, M),
- asserta(sweep_current_identifier_at_point(M:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, Extern, Goal) :-
- sweep_is_extern(Extern, M),
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(M:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, autoload(Path), Goal) :-
- !,
- pi_head(PI, Goal),
- ( '$autoload':library_index(Goal, M, Path)
- -> true
- ; file_name_extension(Base, _, Path), '$autoload':library_index(Goal, M, Base)
- ),
- asserta(sweep_current_identifier_at_point(M:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, Global, Goal) :-
- sweep_is_global(Global),
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(user:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, undefined, M:Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(M:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, undefined, Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(undefined:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, meta, _:Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(meta:PI)).
-sweep_handle_identifier_at_point_goal(_Path, _M0, meta, Goal) :-
- !,
- pi_head(PI, Goal),
- asserta(sweep_current_identifier_at_point(meta:PI)).
-sweep_handle_identifier_at_point_goal(Path, M0, _Kind, Goal) :-
- pi_head(PI0, Goal),
- ( PI0 = M:PI
- -> true
- ; xref_defined(Path, Goal, imported(Other)), xref_module(Other, M)
- -> PI = PI0
- ; predicate_property(M0:Goal, imported_from(M))
- -> PI = PI0
- ; '$autoload':library_index(Goal, M, _)
- -> PI = PI0
- ; M = M0, PI = PI0
- ),
- asserta(sweep_current_identifier_at_point(M:PI)).
-
-sweep_is_global(global).
-sweep_is_global(global(_,_)).
-
-sweep_is_extern(extern(M), M).
-sweep_is_extern(extern(M,_), M).
-
-sweep_colourise_some_terms([String,Path,Offset], Colors) :-
- setup_call_cleanup(( new_memory_file(H),
- insert_memory_file(H, 0, String),
- open_memory_file(H, read, Contents, [encoding(utf8)])
- ),
- sweep_colourise_some_terms_(Path, Offset, Contents, Colors),
- ( close(Contents),
- free_memory_file(H)
- )).
-
-sweep_colourise_some_terms_(Path0, Offset, Contents, []) :-
- atom_string(Path, Path0),
- set_stream(Contents, encoding(utf8)),
- set_stream(Contents, file_name(Path)),
- seek(Contents, 0, bof, _),
- findall(Op, xref_op(Path, Op), Ops),
- prolog_colourise_stream(Contents,
- Path,
- sweep_handle_query_color(Offset),
- [operators(Ops)]).
-
-sweep_documentation([Path, Functor, Arity], Docs) :-
- atom_string(P, Path),
- atom_string(F, Functor),
- PI = F/Arity,
- pi_head(PI, Head),
- ( module_property(M, file(P)),
- \+ predicate_property(M:Head, imported_from(_))
- -> true
- ; module_property(M0, file(P)),
- predicate_property(M0:Head, imported_from(M))
- -> true
- ; M=user
- ),
- findall(Doc, sweep_documentation_(M, PI, Doc), Docs).
-
-sweep_documentation_(M, PI, Docs) :-
- doc_comment(M:PI, Pos, OneLiner, Comment),
- is_structured_comment(Comment, Prefixes),
- string_codes(Comment, Codes),
- indented_lines(Codes, Prefixes, Lines),
- pldoc_modes:mode_lines(Lines, ModeText, [], _),
- pldoc_modes:modes(ModeText, M, Pos, Modes),
- sweep_documentation_modes(Modes, OneLiner, Docs).
-sweep_documentation_(_, PI, Docs) :-
- pldoc_man:load_man_object(PI, _, _, Dom),
- with_output_to(string(DomS), html_text(Dom, [])),
- sub_string(DomS, EOL, _, _, '\n'),
- sub_string(DomS, 0, EOL, _, FLine),
- sub_string(DomS, EOL, _, 0, Rest),
- ( sub_string(Rest, EOS, _, _, '. ')
- -> sub_string(Rest, 0, EOS, _, OneLiner2)
- ; OneLiner2=Rest
- ),
- format(string(Docs), '~w. ~w.~n', [FLine, OneLiner2]),
- !.
-
-sweep_documentation_modes([mode(Mode0, Args)|_], OneLiner, Docs) :-
- maplist([Name=Var]>>(Var='$VAR'(Name)), Args),
- ( Mode0=(Mode1 is Det)
- -> true
- ; Mode1=Mode0,
- Det=unspec
- ),
- format(string(Docs),
- '~W is ~w.~n ~w~n',
- [ Mode1,
- [module(pldoc_modes), numbervars(true)],
- Det,
- OneLiner
- ]).
-sweep_documentation_modes([_|T], OneLiner, Docs) :-
- sweep_documentation_modes(T, OneLiner, Docs).
-
-
-sweep_module_path(ModuleName, Path) :-
- atom_string(Module, ModuleName),
- sweep_module_path_(Module, Path0),
- atom_string(Path0, Path).
-
-
-sweep_module_path_(Module, Path) :-
- module_property(Module, file(Path)), !.
-sweep_module_path_(Module, Path) :-
- '$autoload':library_index(_, Module, Path0), !, string_concat(Path0, ".pl", Path).
-
-
-sweep_modules_collection([], Modules) :-
- findall([M|P], ( module_property(M, file(P0)), atom_string(P0, P) ), Modules0, Tail),
- setof([M|P], P0^N^('$autoload':library_index(N, M, P0), string_concat(P0, ".pl", P) ), Tail),
- list_to_set(Modules0, Modules1),
- maplist(sweep_module_description, Modules1, Modules).
-
-sweep_module_description([M0|P], [M|[P|D]]) :-
- doc_comment(M0:module(D0), _, _, _),
- atom_string(M0, M),
- atom_string(D0, D).
-sweep_module_description([M0|P], [M|[P]]) :- atom_string(M0, M).
-
-sweep_predicate_references(MFN, Refs) :-
- term_string(M:F/N, MFN),
- pi_head(F/N, H),
- findall([B,Path|Line],
- (xref_called(Path0, H, B0, _, Line),
- pi_head(B1, B0),
- term_string(B1, B),
- atom_string(Path0, Path)),
- Refs,
- Tail),
- findall([B,Path|Line],
- (xref_called(Path0, M:H, B0, _, Line),
- pi_head(B1, B0),
- term_string(B1, B),
- atom_string(Path0, Path)),
- Tail).
-
-
-sweep_predicate_location(MFN, [Path|Line]) :-
- term_string(M:F/N, MFN),
- !,
- pi_head(F/N, H),
- ( sweep_predicate_location_(M, H, Path, Line)
- -> true
- ; sweep_predicate_location_(H, Path, Line)
- ).
-sweep_predicate_location(FN, [Path|Line]) :-
- term_string(F/N, FN),
- !,
- pi_head(F/N, H),
- sweep_predicate_location_(H, Path, Line).
-
-sweep_predicate_apropos(Query0, Matches) :-
- atom_string(Query, Query0),
- findall([S,Path|Line],
- (prolog_help:apropos(Query, M:F/N, _, _),
- format(string(S), '~w:~W/~w', [M, F, [quoted(true), character_escapes(true)], N]),
- pi_head(F/N, Head),
- sweep_predicate_location_(M, Head, Path, Line)),
- Matches, Tail),
- findall([S,Path],
- (prolog_help:apropos(Query, F/N, _, _),
- format(string(S), '~W/~w', [F, [quoted(true), character_escapes(true)], N]),
- pi_head(F/N, Head),
- sweep_predicate_location_(Head, Path, Line)),
- Tail).
-
-sweep_predicate_location_(H, Path, Line) :-
- predicate_property(H, file(Path0)),
- predicate_property(H, line_count(Line)),
- !,
- atom_string(Path0, Path).
-sweep_predicate_location_(H, Path, Line) :-
- xref_defined(Path0, H, How),
- atom_string(Path0, Path),
- ( xref_definition_line(How, Line)
- -> true
- ; Line = []
- ).
-
-sweep_predicate_location_(M, H, Path, Line) :-
- predicate_property(M:H, file(Path0)),
- predicate_property(M:H, line_count(Line)),
- !,
- atom_string(Path0, Path).
-sweep_predicate_location_(M, H, Path, Line) :-
- xref_defined(Path0, M:H, How),
- atom_string(Path0, Path),
- ( xref_definition_line(How, Line)
- -> true
- ; Line = []
- ).
-
-sweep_local_predicate_completion([Mod|Sub], Preds) :-
- atom_string(M, Mod),
- findall(F/N,
- @(current_predicate(F/N), M),
- Preds0,
- Tail),
- findall(XF/XN,
- ( xref_module(SourceId, M),
- xref_defined(SourceId, H, _),
- H \= _:_,
- pi_head(XF/XN, H)
- ),
- Tail),
- list_to_set(Preds0, Preds1),
- convlist(sweep_predicate_completion_annotated(Sub, M), Preds1, Preds).
-
-sweep_predicate_completion_annotated(Sub, M, F/N, [S|A]) :-
- format(string(S), '~W/~w', [F, [quoted(true), character_escapes(true)], N]),
- sub_string(S, _, _, _, Sub),
- \+ sub_string(S, _, _, _, "$"),
- pi_head(F/N, Head),
- findall(P, @(predicate_property(Head, P), M), Ps0),
- sweep_predicate_completion_op_annotation(F, Ps0, Ps),
- phrase(sweep_head_annotation(Ps), A).
-
-sweep_predicate_completion_op_annotation(F, Ps, [op(Pri,Fix)|Ps]) :-
- current_op(Pri, Fix, F),
- !.
-sweep_predicate_completion_op_annotation(_, Ps, Ps).
-
-sweep_head_annotation([H|T]) -->
- sweep_head_annotation_(H),
- sweep_head_annotation(T).
-sweep_head_annotation([]) --> [].
-
-sweep_head_annotation_(built_in) --> !, ["built-in"].
-sweep_head_annotation_(det) --> !, ["!"].
-sweep_head_annotation_(dynamic) --> !, ["dynamic"].
-sweep_head_annotation_(foreign) --> !, ["C"].
-sweep_head_annotation_(iso) --> !, ["iso"].
-sweep_head_annotation_(multifile) --> !, ["multifile"].
-sweep_head_annotation_(meta_predicate(_)) --> !, [":"].
-sweep_head_annotation_(non_terminal) --> !, ["//"].
-sweep_head_annotation_(ssu) --> !, ["=>"].
-sweep_head_annotation_(tabled) --> !, ["table"].
-sweep_head_annotation_(tabled(_)) --> !, ["table"].
-sweep_head_annotation_(thread_local) --> !, ["thread-local"].
-sweep_head_annotation_(op(_,_)) --> !, ["op"].
-sweep_head_annotation_(_) --> [].
-
-sweep_predicates_collection(Sub, Preds) :-
- findall(M:F/N,
- ( current_predicate(M:F/N),
- pi_head(F/N, H),
- \+ (predicate_property(M:H, imported_from(M1)), M \= M1)
- ),
- Preds0,
- Tail0),
- findall(M:F/N,
- ( '$autoload':library_index(H, M, _),
- pi_head(F/N, H)
- ),
- Tail0,
- Tail1),
- findall(M:F/N,
- ( xref_defined(SourceId, H, local(_)),
- ( xref_module(SourceId, M)
- -> true
- ; M = user
- ),
- pi_head(F/N, H)
- ),
- Tail1,
- Tail),
- findall(M:F/N,
- ( xref_defined(_, H, imported(SourceId)),
- ( xref_module(SourceId, M)
- -> true
- ; M = user
- ),
- pi_head(F/N, H)
- ),
- Tail),
- list_to_set(Preds0, Preds1),
- maplist(sweep_predicate_description, Preds1, Preds2),
- include(sweep_predicate_non_hidden, Preds2, Preds3),
- ( Sub == []
- -> Preds = Preds3
- ; include(sweep_predicate_matches(Sub), Preds3, Preds)
- ).
-
-sweep_predicate_matches(Sub, [String|_]) :-
- sub_string(String, _, _, _, Sub).
-
-sweep_predicate_non_hidden([String|_]) :-
- \+ sub_string(String, _, _, _, ":'$").
-
-sweep_predicate_description(M:F/N, [S|T]) :-
- sweep_predicate_description_(M, F, N, T),
- format(string(S),
- '~w:~W/~w',
- [M, F, [quoted(true), character_escapes(true)], N]).
-
-sweep_predicate_description_(M, F, N, [D]) :-
- doc_comment(M:F/N, _, D0, _), !, atom_string(D0, D).
-sweep_predicate_description_(_M, F, N, [D]) :-
- man_object_property(F/N, summary(D0)), !, atom_string(D0, D).
-sweep_predicate_description_(_, _, _, []).
-
-sweep_packs_collection(SearchString, Packs) :-
- prolog_pack:query_pack_server(search(SearchString), true(Packs0), []),
- maplist(sweep_pack_info, Packs0, Packs).
-
-sweep_pack_info(pack(Name0, _, Desc0, Version0, URLS0), [Name, Desc, Version, URLS]) :-
- atom_string(Name0, Name),
- atom_string(Desc0, Desc),
- atom_string(Version0, Version),
- maplist(atom_string, URLS0, URLS).
-
-sweep_pack_install(PackName, []) :-
- atom_string(Pack, PackName), pack_install(Pack, [silent(true), upgrade(true), interactive(false)]).
-
-
-sweep_colourise_query([String|Offset], _) :-
- prolog_colourise_query(String, module(sweep), sweep_handle_query_color(Offset)).
-
-sweep_handle_query_color(Offset, Col, Beg, Len) :-
- sweep_color_normalized(Offset, Col, Nom),
- Start is Beg + Offset,
- sweep_funcall("sweep--colourise", [Start,Len|Nom], _).
-
-sweep_color_normalized(Offset, Col, Nom) :-
- Col =.. [Nom0|Rest],
- sweep_color_normalized_(Offset, Nom0, Rest, Nom).
-
-sweep_color_normalized_(_, Goal0, [Kind0,Head|_], [Goal,Kind,F,N]) :-
- sweep_color_goal(Goal0),
- !,
- atom_string(Goal0, Goal),
- term_string(Kind0, Kind),
- pi_head(F0/N, Head),
- atom_string(F0, F).
-sweep_color_normalized_(Offset, syntax_error, [Message0,Start0-End0|_], ["syntax_error", Message, Start, End]) :-
- !,
- Start is Start0 + Offset,
- End is End0 + Offset,
- atom_string(Message0, Message).
-sweep_color_normalized_(_, comment, [Kind0|_], ["comment"|Kind]) :-
- !,
- atom_string(Kind0, Kind).
-sweep_color_normalized_(_, Nom0, _, Nom) :-
- atom_string(Nom0, Nom).
-
-sweep_color_goal(goal).
-sweep_color_goal(goal_term).
-sweep_color_goal(head).
-sweep_color_goal(head_term).
-
-sweep_expand_file_name([String|Dir], Exp) :-
- term_string(Spec, String, [syntax_errors(quiet)]),
- sweep_expand_file_name_(Dir, Spec, Atom),
- ( exists_file(Atom)
- -> true
- ; exists_directory(Atom)
- ),
- atom_string(Atom, Exp).
-
-sweep_expand_file_name_([], Spec, Atom) :-
- absolute_file_name(Spec, Atom, [file_errors(fail),
- solutions(all),
- extensions(['', '.pl'])]).
-sweep_expand_file_name_(Dir, Spec, Exp) :-
- !,
- absolute_file_name(Spec, Exp, [file_errors(fail),
- relative_to(Dir),
- solutions(all),
- extensions(['', '.pl'])]).
-
-sweep_path_module([], "user") :- !.
-sweep_path_module(Path0, Module) :-
- atom_string(Path, Path0),
- xref_module(Path, Module0),
- atom_string(Module0, Module).
-
-
-sweep_setup_message_hook(_, _) :-
- retractall(user:thread_message_hook(_, _, _)),
- asserta((
- user:thread_message_hook(Term, Kind, Lines) :-
- sweep_message_hook(Term, Kind, Lines)
- )).
-
-sweep_message_hook(Term, Kind0, _Lines) :-
- should_handle_message_kind(Kind0, Kind),
- !,
- message_to_string(Term, String),
- sweep_funcall("sweep-message", [Kind|String], _).
-
-should_handle_message_kind(error, "error").
-should_handle_message_kind(warning, "warning").
-should_handle_message_kind(informational, "informational").
-should_handle_message_kind(debug(Topic0), ["debug"|Topic]) :- atom_string(Topic0, Topic).
-
-sweep_prefix_ops(Path0, Ops) :-
- atom_string(Path, Path0),
- findall(Op, current_op(_, fx, Op), Ops0, Tail0),
- findall(Op, current_op(_, fy, Op), Tail0, Tail1),
- findall(Op, xref_op(Path, op(_, fx, Op)), Tail1, Tail),
- findall(Op, xref_op(Path, op(_, fy, Op)), Tail),
- maplist(atom_string, Ops0, Ops1),
- list_to_set(Ops1, Ops).
-
-sweep_op_info([Op0|Path0], Info) :-
- atom_string(Path, Path0),
- atom_string(Op, Op0),
- sweep_op_info_(Op, Path, Info).
-
-sweep_op_info_(Op, Path, [Type|Pred]) :-
- xref_op(Path, op(Pred, Type0, Op)),
- atom_string(Type0, Type).
-sweep_op_info_(Op, _Path, [Type|Pred]) :-
- current_op(Pred, Type0, Op),
- atom_string(Type0, Type).
-
-sweep_load_buffer([String|Path0], Result) :-
- atom_string(Path, Path0),
- with_buffer_stream(Stream,
- String,
- sweep_load_buffer_(Stream, Path, Result)).
-
-sweep_load_buffer_(Stream, Path, []) :-
- set_stream(Stream, file_name(Path)),
- @(load_files(Path, [stream(Stream)]), user).
-
-with_buffer_stream(Stream, String, Goal) :-
- setup_call_cleanup(( new_memory_file(H),
- insert_memory_file(H, 0, String),
- open_memory_file(H, read, Stream, [encoding(utf8)]),
- set_stream(Stream, encoding(utf8))
- ),
- Goal,
- ( close(Stream),
- free_memory_file(H)
- )).
projects / sweep.git / commitdiff