From 5094c081affde5ca441602842f7302a6582e976d Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 23 Sep 2022 15:50:31 +0300 Subject: [PATCH] prepare sweep-module as a SWI-Prolog package --- .build.yml | 52 -- CMakeLists.txt | 23 + LICENSE | 30 - Makefile | 51 -- NEWS.org | 64 -- README.org | 706 ---------------------- emacs-module.h | 941 ----------------------------- sweep-tests.el | 276 --------- sweep.c | 2 +- sweep.el | 1561 ------------------------------------------------ 10 files changed, 24 insertions(+), 3682 deletions(-) delete mode 100644 .build.yml create mode 100644 CMakeLists.txt delete mode 100644 LICENSE delete mode 100644 Makefile delete mode 100644 NEWS.org delete mode 100644 README.org delete mode 100644 emacs-module.h delete mode 100644 sweep-tests.el delete mode 100644 sweep.el diff --git a/.build.yml b/.build.yml deleted file mode 100644 index 255b3c0..0000000 --- a/.build.yml +++ /dev/null @@ -1,52 +0,0 @@ -image: debian/stable -packages: - - build-essential - - cmake - - ninja-build - - pkg-config - - ncurses-dev - - libreadline-dev - - libedit-dev - - libgoogle-perftools-dev - - libgmp-dev - - libssl-dev - - unixodbc-dev - - zlib1g-dev - - libarchive-dev - - libossp-uuid-dev - - libxext-dev - - libice-dev - - libjpeg-dev - - libxinerama-dev - - libxft-dev - - libxpm-dev - - libxt-dev - - libdb-dev - - libpcre2-dev - - libyaml-dev - - zip - - git - - emacs -secrets: - - 750079bb-9735-473b-bebf-db897c9f0c6b - - 72d5c3dc-f83f-4cc2-96e3-b2b08f6ee8a0 -sources: - - git@git.sr.ht:~eshel/sweep -tasks: - - getswipl: | - git clone --recursive https://github.com/SWI-Prolog/swipl-devel.git - cd swipl-devel - mkdir build - cd build - export LANG="en_US.UTF-8" - sudo localectl set-locale LANG=en_US.UTF-8 - localectl set-locale LANG=en_US.UTF-8 - cmake -DCMAKE_INSTALL_PREFIX=/usr/local -DSWIPL_INSTALL_IN_LIB=ON -DSWIPL_PACKAGES_ODBC=OFF -DSWIPL_PACKAGES_JAVA=OFF -DSWIPL_PACKAGES_X=OFF -DINSTALL_DOCUMENTATION=OFF -G Ninja .. - ninja - sudo ninja install - - build: | - cd sweep - export LD_LIBRARY_PATH=/usr/local/lib - make - make sweep.info - LD_PRELOAD=/usr/local/lib/libswipl.so make check diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000..25eb17c --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,23 @@ +cmake_minimum_required(VERSION 3.5) +project(swipl-sweep) + +include("../cmake/PrologPackage.cmake") + +find_program(EMACS Emacs) +message(${EMACS}) + +find_path( + EMACS_INCLUDE_DIR + NAMES "emacs-module.h" + PATHS /Applications/Emacs.app/Contents/Resources/include +) + +if(EMACS_INCLUDE_DIR) + +swipl_plugin( + sweep-module + C_SOURCES sweep.c + C_INCLUDE_DIR ${EMACS_INCLUDE_DIR} + PL_LIBS sweep.pl) + +endif(EMACS_INCLUDE_DIR) diff --git a/LICENSE b/LICENSE deleted file mode 100644 index 246af86..0000000 --- a/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright 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. - -3. Neither the name of the copyright holder nor the names of its -contributors may be used to endorse or promote products derived from -this software without specific prior written permission. - -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 -HOLDER 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. \ No newline at end of file diff --git a/Makefile b/Makefile deleted file mode 100644 index ca0f96d..0000000 --- a/Makefile +++ /dev/null @@ -1,51 +0,0 @@ -BASENAME = sweep - -UNAME_S := $(shell uname -s) -ifeq ($(UNAME_S),Linux) - SOEXT = so -endif -ifeq ($(UNAME_S),Darwin) - SOEXT = dylib -endif - -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 ';') - -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) - -clean: - rm -f $(TARGET) $(OBJECT) $(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 diff --git a/NEWS.org b/NEWS.org deleted file mode 100644 index cfc5222..0000000 --- a/NEWS.org +++ /dev/null @@ -1,64 +0,0 @@ -#+title: sweep NEWS -- history of user-visible changes. -#+author: Eshel Yaron -#+email: me@eshelyaron.com -#+language: en -#+options: ':t toc:nil num:nil ^:{} -#+startup: content indent -#+MACRO: version (eval (mapconcat #'number-to-string (save-current-buffer (with-current-buffer (find-file (expand-file-name "sweep.el" (file-name-directory $1))) (package-desc-version (package-buffer-info)))) ".")) - -This file is about changes in =sweep= up to version -{{{version({{{input-file}}})}}}. - -* New commands available in =sweep= {{{version({{{input-file}}})}}} - -** New command =sweep-load-buffer=. - -Loads a =sweep-mode= buffer. If called from a =sweep-mode= buffer, loads -the current buffer by default. - -** New command =sweep-find-file-at-point=. - -Follows file specifications in =sweep-mode= buffers. - - -* New keybindings in =sweep-mode= buffers - -** =C-c C-l= is now bound to =sweep-load-buffer=. - -** =C-c C-o= is now bound to =sweep-find-file-at-point=. - - -* New user options available in =sweep= {{{version({{{input-file}}})}}} - -** New user option =sweep-indent-offset= - -This option, set by default to 4, is an integer denoting the number of -columns used as the indent increment in =sweep-mode= buffers. - -** New user option =sweep-colourise-buffer-on-idle= - -This option is a boolean flag that determines whether to enable -automatic updating of semantic highlighting in =sweep-mode= buffers. - -** New user option =sweep-colourise-buffer-min-interval= - -This option determines the minimum number of idle seconds that =sweep= -will wait before updating semantic highlighting in a =sweep-mode= -buffer. - -** New user option =sweep-colourise-buffer-max-size= - -This option determines the maximum size of a =sweep-mode= buffer for -which =sweep= will periodically update semantic highlighting on idle. - -** New user option =sweep-top-level-min-history-length= - -This option, set by default to 3, determines a minimum length for -inputs inserted into =sweep= top-level history ring. The default value, -3, avoids one character top-level responses from clobbering the -history ring. This kind of inputs includes, for example, the =;= -character typed to invoke backtracking. - -* New keybindings in =sweep-prefix-map= - -** The =l= key is now bound to =sweep-load-buffer=. diff --git a/README.org b/README.org deleted file mode 100644 index 2657d9c..0000000 --- a/README.org +++ /dev/null @@ -1,706 +0,0 @@ -#+title: sweep: SWI-Prolog Embedded in Emacs -#+author: Eshel Yaron -#+email: me@eshelyaron.com -#+language: en -#+options: ':t toc:nil author:t email:t num:nil ^:{} -#+startup: content indent -#+export_file_name: sweep.texi -#+texinfo_filename: sweep.info -#+texinfo_dir_category: Emacs -#+texinfo_dir_title: Sweep: (sweep) -#+texinfo_dir_desc: SWI-Prolog Embedded in Emacs -#+texinfo_header: @set MAINTAINERSITE @uref{https://eshelyaron.com,maintainer webpage} -#+texinfo_header: @set MAINTAINER Eshel Yaron -#+texinfo_header: @set MAINTAINEREMAIL @email{me@eshelyaron.com} -#+texinfo_header: @set MAINTAINERCONTACT @uref{mailto:me@eshelyaron.com,contact the maintainer} - -This manual describes the Emacs package =sweep=, which provides an -embedded SWI-Prolog runtime inside of Emacs. - -#+toc: headlines 8 insert TOC here, with eight headline levels - -* Overview -:PROPERTIES: -:CUSTOM_ID: overview -:END: - -=sweep= is an embedding of SWI-Prolog in Emacs. It provides an -interface for executing Prolog queries and consuming their results -from Emacs Lisp (see [[Querying Prolog]]). =sweep= further builds on top of -this interface and on top of the standard Emacs facilities to provide -advanced features for developing SWI-Prolog programs in Emacs. - -** High-level architecture -:PROPERTIES: -:CUSTOM_ID: high-level-architecture -:END: - -both SWI-Prolog and Emacs Lisp to create a dynamically loaded Emacs -module that contains the SWI-Prolog runtime. As such, =sweep= has parts -written in C, in Prolog and in Emacs Lisp. - - -The different parts of =sweep= are structured as follows: - -#+CINDEX: sweep-module -- =sweep.c= defines a dynamic Emacs module which is referred to from - Elisp as =sweep-module=. This module is linked against the SWI-Prolog - runtime library (=libswipl=) and exposes a subset of the SWI-Prolog C - interface to Emacs in the form of Elisp functions (see [[Querying - Prolog]]). Notably, =sweep-module= is responsible for translating Elisp - objects to Prolog terms and vice versa. - -#+CINDEX: sweep.el -- =sweep.el= defines an Elisp library (named simply =sweep=), which builds - on top of =sweep-module= to provide user-facing commands and - functionality. It is also responsible for loading and compiling the - dynamically loaded =sweep-module=. - -#+CINDEX: sweep.pl -- =sweep.pl= defines a Prolog module (named, unsurprisingly, =sweep=) - which is by default arranged by =sweep.el= to be loaded when the - embedded Prolog runtime is initialized. It contains predicates that - =sweep.el= invoke through =sweep-module= to facilitate its different - commands (see [[Finding Prolog code]]). - -* Installation -:PROPERTIES: -:CUSTOM_ID: installation -:END: - -1. Clone the =sweep= repository: - #+begin_src sh - git clone https://git.sr.ht/~eshel/sweep - #+end_src - -2. Optionally, build the C module =sweep-module=: - #+begin_src sh - cd sweep - make - #+end_src - -3. Add =sweep= to Emacs' =load-path=: - #+begin_src emacs-lisp - (add-to-list 'load-path "/path/to/sweep") - #+end_src - -4. Load =sweep= into Emacs: - #+begin_src emacs-lisp - (require 'sweep) - #+end_src - - If =sweep-module= is not already built, =sweep= will suggest to build - it when loaded. - -* Prolog initialization and cleanup -:PROPERTIES: -:CUSTOM_ID: prolog-init -:END: - -#+FINDEX: sweep-initialize -The embedded SWI-Prolog runtime must be initialized before it can -start executing queries. In =sweep=, Prolog initialization is done via -the C-implemented =sweep-initialize= Elisp function defined in -=sweep-module=. =sweep-initialize= takes one or more arguments, which -must all be strings, and initializes the embedded Prolog as if it were -invoked externally in a command line with the given strings as command -line arguments, where the first argument to =sweep-initialize= -corresponds to =argv[0]=. - -#+VINDEX: sweep-init-args -By default, =sweep.el= will initialize Prolog automatically when it is -loaded into Emacs. The arguments used to initialize Prolog in that -case are determined by the value of the user-option =sweep-init-args= -which the user is free to extend with e.g.: - -#+begin_src emacs-lisp - (add-to-list 'sweep-init-args "--stack-limit=512m") -#+end_src - -#+VINDEX: sweep-init-on-load -To inhibit =sweep= from initializing Prolog on load, set the user-option -=sweep-init-on-load= to nil. - -#+FINDEX: sweep-cleanup -The embedded Prolog runtime can be reset using the =sweep-cleanup= -function. This function cleans up the Prolog state and resources, -afterwards =sweep-initialize= can be called to start Prolog anew. - -* Querying Prolog -:PROPERTIES: -:CUSTOM_ID: querying-prolog -:END: - -#+FINDEX: sweep-open-query -=sweep= provides the Elisp function =sweep-open-query= for invoking Prolog -predicates. The invoked predicate must be of arity two and will be -called in mode =p(+In, -Out)= i.e. the predicate should treat the first -argument as input and expect a variable for the second argument which -should be unified with some output. This restriction is placed in -order to facilitate a natural calling convention between Elisp, a -functional language, and Prolog, a logical one. - -The =sweep-open-query= function takes five arguments, the first three -are strings which denote: -- The name of the Prolog context module from which to execute the - query, -- The name of the module in which the invoked predicate is defined, - and -- The name of the predicate to call. - -The fourth argument to =sweep-open-query= is converted into a Prolog -term and used as the first argument of the predicate (see [[Conversion -of Elisp objects to Prolog terms]]). The fifth argument is an -optional "reverse" flag, when this flag is set to non-nil, the order -of the arguments is reversed such that the predicate is called in mode -=p(-Out, +In)= rather than =p(+In, -Out)=. - -#+FINDEX: sweep-next-solution -The function =sweep-next-solution= can be used to examine the results of -a query. If the query succeeded, =sweep-next-solution= returns a cons -cell whose =car= is either the symbol =!= when the success was -deterministic or =t= otherwise, and the =cdr= is the current value of the -second (output) Prolog argument converted to an Elisp object (see -[[Conversion of Prolog terms to Elisp objects]]). If the query failed, -=sweep-next-solution= returns nil. - -#+FINDEX: sweep-cut-query -#+FINDEX: sweep-close-query -=sweep= only executes one Prolog query at a given time, thus queries -opened with =sweep-open-query= need to be closed before other queries -can be opened. When no more solutions are available for the current -query (i.e. after =sweep-next-solution= returned nil), or when otherwise -further solutions are not of interest, the query must be closed with -either =sweep-cut-query= or =sweep-close-query=. Both of these functions -close the current query, but =sweep-close-query= also destroys any -Prolog bindings created by the query. - -** Conversion of Elisp objects to Prolog terms -:PROPERTIES: -:CUSTOM_ID: elisp-to-prolog -:END: - -=sweep= converts Elisp objects into Prolog terms to allow the Elisp -programmers to specify arguments for Prolog predicates invocations (see -=sweep-open-query=). Seeing as some Elisp objects, like Elisp compiled -functions, wouldn't be as useful for a passing to Prolog as others, -=sweep= only converts Elisp objects of certain types to Prolog, namely -we convert /trees of strings and numbers/: - -- Elisp strings are converted to equivalent Prolog strings. -- Elisp integers are converted to equivalent Prolog integers. -- Elisp floats are converted to equivalent Prolog floats. -- The Elisp nil object is converted to the Prolog empty list =[]=. -- Elisp cons cells are converted to Prolog lists whose head and tail - are the Prolog representations of the =car= and the =cdr= of the cons. - -** Conversion of Prolog terms to Elisp objects -:PROPERTIES: -:CUSTOM_ID: prolog-to-elisp -:END: - -=sweep= converts Prolog terms into Elisp object to allow efficient -processing of Prolog query results in Elisp (see =sweep-next-solution=). - -- Prolog strings are converted to equivalent Elisp strings. -- Prolog integers are converted to equivalent Elisp integers. -- Prolog floats are converted to equivalent Elisp floats. -- A Prolog atom =foo= is converted to a cons cell =(atom . "foo")=. -- The Prolog empty list =[]= is converted to the Elisp nil object. -- Prolog lists are converted to Elisp cons cells whose =car= and =cdr= are - the representations of the head and the tail of the list. -- Prolog compounds are converted to list whose first element is the - symbol =compound=. The second element is a string denoting the functor - name of the compound, and the rest of the elements are the arguments - of the compound in their Elisp representation. -- All other Prolog terms (variables, blobs and dicts) are currently - represented in Elisp only by their type: - + Prolog variables are converted to the symbol =variable=, - + Prolog blobs are converted to the symbol =blob=, and - + Prolog dicts are converted to the symbol =dict=. - -** Example - counting solutions for a Prolog predicate in Elisp -:PROPERTIES: -:CUSTOM_ID: count-permutations -:END: - -As an example of using the =sweep= interface for executing Prolog -queries, we show an invocation of the non-deterministic predicate -=lists:permutation/2= from Elisp where we count the number of different -permutations of the list =(1 2 3 4 5)=: - -#+name: count-list-permutations -#+begin_src emacs-lisp - (sweep-open-query "user" "lists" "permutation" '(1 2 3 4 5)) - (let ((num 0) - (sol (sweep-next-solution))) - (while sol - (setq num (1+ num)) - (setq sol (sweep-next-solution))) - (sweep-close-query) - num) -#+end_src - -** Calling Elisp function inside Prolog queries -:PROPERTIES: -:CUSTOM_ID: funcall-from-prolog -:END: - -The =sweep-module= defines the foreign Prolog predicates =sweep_funcall/2= -and =sweep_funcall/3=, which allow for calling Elisp functions from -Prolog code. These predicates may only be called in the context of a -Prolog query initiated by =sweep-open-query=, i.e. only in the Prolog -thread controlled by Emacs. The first argument to these predicates is -a Prolog string holding the name of the Elisp function to call. The -last argument to these predicates is unified with the return value of -the Elisp function, represented as a Prolog term (see [[Conversion of -Elisp objects to Prolog terms]]). The second argument of -=sweep_funcall/3= is converted to an Elisp object (see [[Conversion of -Prolog terms to Elisp objects]]) and passed as a sole argument to the -invoked Elisp function. The =sweep_funcall/2= variant invokes the Elisp -function without any arguments. - -* Editing Prolog code -:PROPERTIES: -:CUSTOM_ID: editing-prolog-code -:END: - -#+CINDEX: sweep-mode -#+FINDEX: sweep-mode -#+VINDEX: sweep-mode -=sweep= includes a dedicated major mode for reading and editing Prolog -code, called =sweep-mode=. To activate this mode in a buffer, type =M-x -sweep-mode=. To instruct Emacs to always open Prolog files in -=sweep-mode=, modify the Emacs variable =auto-mode-alist= like so: - -#+begin_src emacs-lisp - (add-to-list 'auto-mode-alist '("\\.pl\\'" . sweep-mode)) - (add-to-list 'auto-mode-alist '("\\.plt\\'" . sweep-mode)) -#+end_src - -** Indentation -:PROPERTIES: -:CUSTOM_ID: indentation -:END: - -#+CINDEX: indentation - -In =sweep-mode= buffers, the appropriate indentation for each line is -determined by a bespoke /indentation engine/. The indentation engine -analyses the syntactic context of a given line and determines the -appropriate indentation to apply based on a set of rules. - -#+FINDEX: sweep-indent-line -The entry point of the indentation engine is the function -=sweep-indent-line= which takes no arguments and indents that line at -point. =sweep-mode= supports the standard Emacs interface for -indentation by arranging for =sweep-indent-line= to be called whenever a -line should be indented, notably after pressing =TAB=. For more a full -description of the available commands and options that pertain to -indentation, see [[info:emacs#Indentation][Indentation in the Emacs manual]]. - -*** Indentation rules -:PROPERTIES: -:CUSTOM_ID: indentation-rules -:END: - -Lines in =sweep-mode= buffers are indented according to the following -rules: - -1. If the current line starts inside a string or a multi-line comment, - do not indent. -2. If the current line starts with a top term, do not indent. -3. If the current line starts with a closing parenthesis and the - matching opening parenthesis is part of a functor, indent to the - column of the opening parenthesis if any arguments appear on the - same line as the functor, otherwise indent to the start of the - functor. - - This rule yields the following layouts: - - #+begin_src prolog - some_functor( - some_arg - ). - - some_functor( some_arg - ). - #+end_src - -#+VINDEX: sweep-indent-offset -4. If the current line is the first non-comment line of a clause body, - indent to the starting column of the head term plus the value of - the user option =sweep-indent-offset= (by default, four extra - columns). - - As an example, this rule yields the following layouts when - =sweep-indent-offset= is set to the default value of four columns: - - #+begin_src prolog - some_functor(arg1, arg2) :- - body_term. - - asserta( some_functor(arg1, arg2) :- - body_term - ). - #+end_src - -5. If the current line starts with the right hand side operand of an - infix operator, indent to the starting column of the first operand - in the chain of infix operators of the same precedence. - - This rule yields the following layouts: - - #+begin_src prolog - head :- body1, body2, body3, - body4, body5. - - A is 1 * 2 ^ 3 * 4 * - 5. - - A is 1 * 2 + 3 * 4 * - 5. - #+end_src - -6. If the last non-comment line ends with a functor and its opening - parenthesis, indent to the starting column of the functor plus - =sweep-indent-offset=. - - This rule yields the following layout: - - #+begin_src prolog - some_functor( - arg1, ... - #+end_src - -7. If the last non-comment line ends with a prefix operator, indent to - starting column of the operator plus =sweep-indent-offset=. - - This rule yields the following layout: - - #+begin_src prolog - :- multifile - predicate/3. - #+end_src - -** Semantic highlighting -:PROPERTIES: -:CUSTOM_ID: semantic-highlighting -:END: - -#+CINDEX: fontification -=sweep-mode= integrates with the standard Emacs =font-lock= system which -is used for highlighting text in buffers (see [[info:emacs#Font Lock][Font Lock in the Emacs -manual]]). =sweep-mode= highlights different tokens in Prolog code -according to their semantics, determined through static analysis which -is performed on demand. When a buffer is first opened in =sweep-mode=, -its entire contents are analyzed to collect and cache cross reference -data, and the buffer is highlighted accordingly. In contrast, when -editing and moving around the buffer, a faster, local analysis is -invoked to updated the semantic highlighting in response to changes in -the buffer. - -#+FINDEX: sweep-colourise-buffer -At any point in a =sweep-mode= buffer, the command =C-c C-c= (or =M-x -sweep-colourise-buffer=) can be used to update the cross reference -cache and highlight the buffer accordingly. This may be useful -e.g. after defining a new predicate. - -#+VINDEX: sweep-colourise-buffer-on-idle -#+VINDEX: sweep-colourise-buffer-max-size -#+VINDEX: sweep-colourise-buffer-min-interval -If the user option =sweep-colourise-buffer-on-idle= is set to non-nil -(as it is by default), =sweep-mode= also updates semantic highlighting -in the buffer whenever Emacs is idle for a reasonable amount of time, -unless the buffer is larger than the value of the -=sweep-colourise-buffer-max-size= user option ( 100,000 by default). -The minimum idle time to wait before automatically updating semantic -highlighting can be set via the user option -=sweep-colourise-buffer-min-interval=. - -#+CINDEX: sweep-faces -=sweep= defines more than 60 different faces (named sets of properties -that determine the appearance of a specific text in Emacs buffers, see -also [[info:emacs#Faces][Faces in the Emacs manual]]) to signify the specific semantics of -each token in a Prolog code buffer. For example, calls to built in -Prolog predicates are highlighted with the =sweep-built-in-face=, while -recursive calls to predicates in their own definitions are assigned -the =sweep-recursion-face=. The different appearance properties -associated which each face, like color, font, etc., can be customized -according to best suite the user's preferences. By default, =sweep= -defines its faces to inherit from standard Emacs faces such as -=font-lock-variable-face= commonly used for variables in different -programming languages, which =sweep= uses a basis for -=sweep-variable-face=. To view and customize all of the faces defined -and used in =sweep=, type =M-x customize-group RET sweep-faces RET=. - -** Definitions and references -:PROPERTIES: -:CUSTOM_ID: sweep-xref -:END: - -#+CINDEX: xref -=sweep-mode= integrates with the Emacs =xref= API to facilitate quick -access to predicate definitions and references in Prolog code buffers. -This enables the many commands that the =xref= interface provides, like -=M-.= for jumping to the definition of the predicate at point. Refer to -[[info:emacs#Find Identifiers][Find Identifiers in the Emacs manual]] for an overview of the available -commands. - -** Following file specifications -:PROPERTIES: -:CUSTOM_ID: following-file-specs -:END: - -#+FINDEX: sweep-find-file-at-point -File specifications that occur in =sweep-mode= buffers can be followed -with =C-c C-o= (or =M-x sweep-find-file-at-point=) whenever point is over -a valid file specification. For example, consider a Prolog file buffer with the common -directive =use_module/1=: - -#+begin_src prolog -:- use_module(library(lists)). -#+end_src - -With point in any position inside =library(lists)=, typing =C-c C-o= will -open the =lists.pl= file in the Prolog library. - -For more information about file specifications in SWI-Prolog, see -[[https://www.swi-prolog.org/pldoc/doc_for?object=absolute_file_name/3][absolute_file_name/3]] in the SWI-Prolog manual. - -** Loading buffers -:PROPERTIES: -:CUSTOM_ID: loading-buffers -:END: - -#+CINDEX: loading -#+FINDEX: sweep-load-buffer -The command =M-x sweep-load-buffer= can be used to load the contents of -a =sweep-mode= buffer into the embedded SWI-Prolog runtime. After a -buffer is loaded, the predicates it defines can be queried from Elisp -(see [[Querying Prolog]]) and from the =sweep= top-level (see [[The Prolog -top-level]]). In =sweep-mode= buffers, =sweep-load-buffer= is bound by -default to =C-c C-l=. By default this command loads the current buffer -if its major mode is =sweep-mode=, and prompts for an appropriate buffer -otherwise. To choose a different buffer to load while visiting a -=sweep-mode= buffer, invoke =sweep-load-buffer= with a prefix argument -(=C-u C-c C-l=). - -More relevant information about loading code in SWI-Prolog can be -found in [[https://www.swi-prolog.org/pldoc/man?section=consulting][Loading Prolog source files]] in the SWI-Prolog manual. - -* The Prolog top-level -:PROPERTIES: -:CUSTOM_ID: prolog-top-level -:END: - -#+CINDEX: top-level -#+FINDEX: sweep-top-level -=sweep= provides a classic Prolog top-level interface for interacting -with the embedded Prolog runtime. To start the top-level, use =M-x -sweep-top-level=. This command opens a buffer called =*sweep-top-level*= -which hosts the live Prolog top-level. - -#+FINDEX: sweep-top-level-mode -#+VINDEX: sweep-top-level-mode -The top-level buffer uses a major mode named -=sweep-top-level-mode=. This mode derives from =comint-mode=, which is the -common mode used in Emacs REPL interfaces. As a result, the top-level -buffer inherits the features present in other =comint-mode= derivatives, -most of which are described in [[info:emacs#Shell Mode][the Emacs manual]]. - -** Multiple top-levels -:PROPERTIES: -:CUSTOM_ID: multiple-top-levels -:END: - -Any number of top-levels can be created and used concurrently, each in -its own buffer. If a top-level buffer already exists, =sweep-top-level= -will simply open it by default. To create another one or more -top-level buffers, run =sweep-top-level= with a prefix argument -(i.e. =C-u M-x sweep-top-level-mode=) to choose a different buffer name. -Alternatively, run the command =C-x x u= (or =M-x rename-uniquely=) in the -buffer called =*sweep-top-level*= and then run =M-x sweep-top-level= -again. This will change the name of the original top-level buffer to -something like =*sweep-top-level*<2>= and allow the new top-level to -claim the buffer name =*sweep-top-level*=. - -** Top-level history -:PROPERTIES: -:CUSTOM_ID: top-level-history -:END: - -=sweep-top-level-mode= buffers provide a history of previously user -inputs, similarly to other =comint-mode= derivatives such as =shell-mode=. -To insert the last input from the history at the prompt, use =M-p= -(=comint-previous-input=). For a full description of history related -commands, see [[info:emacs#Shell History][Shell History in the Emacs manual]]. - -#+VINDEX: sweep-top-level-min-history-length -The =sweep= top-level history only records inputs whose length is at -least =sweep-top-level-min-history-length=. This user option is set to -3 by default, and should generally be set to at least 2 to keep the -history from being clobbered with single-character inputs, which are -common in the top-level interaction, e.g. =;= as used to invoke -backtracking. - -** Completion in the top-level -:PROPERTIES: -:CUSTOM_ID: completion-in-top-level -:END: - -The =sweep-top-level-mode=, enabled in the =sweep= top-level buffer, -integrates with the standard Emacs symbol completion mechanism to -provide completion for predicate names. To complete a partial -predicate name in the top-level prompt, use =C-M-i= (or =M-=). For -more information see [[info:emacs#Symbol Completion][Symbol Completion in the Emacs manual]]. - -* Finding Prolog code -:PROPERTIES: -:CUSTOM_ID: finding-prolog-code -:END: - -#+FINDEX: sweep-find-module -=sweep= provides the command =M-x sweep-find-module= for -selecting and jumping to the source code of a loaded or auto-loadable -Prolog module. =sweep= integrates with Emacs' standard completion API -to annotate candidate modules in the completion UI with their =PLDoc= -description when available. - -#+FINDEX: sweep-find-predicate -Along with =M-x sweep-find-module=, =sweep= provides the -command =M-x sweep-find-predicate= jumping to the definition a -loaded or auto-loadable Prolog predicate. - -** Prolog file specification expansion -:PROPERTIES: -:CUSTOM_ID: file-spec-expansion -:END: - -=sweep= defines a handler for the Emacs function =expand-file-file= that -recognizes Prolog file specifications, such as =library(lists)=, and -expands them to their corresponding absolute paths. This means that -one can use Prolog file specifications with Emacs' standard =find-file= -(=C-x C-f=) to locate Prolog resources directly. - -For example, typing =C-x C-f library(pldoc/doc_man)= will open the -source of the =pldoc_man= module from the Prolog library, and likewise -=C-x C-f pack(.)= will open the Prolog packages directory. - -* Quick access to =sweep= commands -:PROPERTIES: -:CUSTOM_ID: quick-command-access -:END: - -#+VINDEX: sweep-prefix-map -=sweep= defines a keymap called =sweep-prefix-map= which provides -keybinding for several useful =sweep= commands. By default, -=sweep-prefix-map= itself is not bound to any key. To bind it globally -to a prefix key, e.g. =C-c p=, use: - -#+begin_src emacs-lisp - (keymap-global-set "C-c p" sweep-prefix-map) -#+end_src - -As an example, with the above binding the =sweep= top-level can be -accessed from anywhere with =C-c p t=, which invokes the command -=sweep-top-level=. - -* Examining Prolog messages -:PROPERTIES: -:CUSTOM_ID: prolog-messages -:END: - -#+CINDEX: messages -#+VINDEX: sweep-messages-buffer-name -Messages emitted by the embedded Prolog are redirected by =sweep= to a -dedicated Emacs buffer. By default, the =sweep= messages buffer is -named =*sweep Messages*=. To instruct =sweep= to use another buffer name -instead, type =M-x customize-option RET sweep-messages-buffer-name RET= -and set the option to a suitable value. - -The =sweep= messages buffer uses the minor mode =compilation-minor-mode=, -which allows for jumping to source locations indicated in errors and -warning directly from the corresponding message in the =sweep= messages -buffer. For more information about the features enabled by -=compilation-minor-mode=, see [[info:emacs#Compilation Mode][Compilation Mode in the Emacs manual]]. - -#+FINDEX: sweep-view-messages -=sweep= includes the command =sweep-view-messages= for quickly switching -to the =sweep= messages buffer. This command is bound by default in -=sweep-prefix-map= to the =e= key (see [[Quick access to =sweep= commands]]). - -* Setting Prolog flags -:PROPERTIES: -:CUSTOM_ID: prolog-flags -:END: - -#+CINDEX: prolog flags -#+FINDEX: sweep-set-prolog-flag -The command =M-x sweep-set-prolog-flag= can be used to interactively -configure the embedded Prolog execution environment by changing the -values of Prolog flags. This command first prompts the user for a -Prolog flag to set, with completion candidates annotated with their -current values as Prolog flags, and then prompts for a string that -will be read as a Prolog term and set as the value of the chosen flag. -For more information on Prolog flags in SWI-Prolog see [[https://www.swi-prolog.org/pldoc/man?section=flags][Environment -Control in the SWI-Prolog manual]]. - -As an example, the Prolog flag =double_quotes= controls the -interpretation of double quotes in Prolog code. By default, -=double_quotes= is set to =string=, so e.g. ="foo"= is read as a SWI-Prolog -string as we can easily validate in the =sweep= top-level: - -#+begin_src prolog -?- A = "foo". -A = "foo". -#+end_src - -We can change the interpretation of double quotes to denote lists of -character codes, by setting the value the =double_quotes= flag to =codes= -with =M-x sweep-set-prolog-flag RET double_quotes RET codes RET=. -Evaluating =A = "foo"= again exhibits the different interpretation: - -#+begin_src prolog -?- A = "foo". -A = [102, 111, 111]. -#+end_src - -* Installing Prolog packages -:PROPERTIES: -:CUSTOM_ID: prolog-packages -:END: - -#+FINDEX: sweep-pack-install -The command =M-x sweep-pack-install= can be used to install -or upgrade a SWI-Prolog =pack=. When selecting a =pack= to install, the -completion candidates are annotated with description and the version -of each package. - - -#+html: diff --git a/emacs-module.h b/emacs-module.h deleted file mode 100644 index 268e5a4..0000000 --- a/emacs-module.h +++ /dev/null @@ -1,941 +0,0 @@ -/* 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 . */ - -/* -This file defines the Emacs module API. Please see the chapter -`Dynamic Modules' in the GNU Emacs Lisp Reference Manual for -information how to write modules and use this header file. -*/ - -#ifndef EMACS_MODULE_H -#define EMACS_MODULE_H - -#include -#include -#include - -#ifndef __cplusplus -#include -#endif - -#define EMACS_MAJOR_VERSION 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 */ diff --git a/sweep-tests.el b/sweep-tests.el deleted file mode 100644 index 6733838..0000000 --- a/sweep-tests.el +++ /dev/null @@ -1,276 +0,0 @@ -;;; sweep-tests.el --- ERT suite for sweep -*- lexical-binding:t -*- - -(ert-deftest lists:member/2 () - "Tests calling the Prolog predicate permutation/2 from Elisp." - (should (equal (sweep-open-query "user" "lists" "member" (list 1 2 3) t) t)) - (should (equal (sweep-next-solution) (cons t 1))) - (should (equal (sweep-next-solution) (cons t 2))) - (should (equal (sweep-next-solution) (cons '! 3))) - (should (equal (sweep-cut-query) t))) - -(ert-deftest lists:permutation/2 () - "Tests calling the Prolog predicate permutation/2 from Elisp." - (should (equal (sweep-open-query "user" "lists" "permutation" (list 1 2 3)) t)) - (should (equal (sweep-next-solution) (list t 1 2 3))) - (should (equal (sweep-next-solution) (list t 1 3 2))) - (should (equal (sweep-next-solution) (list t 2 1 3))) - (should (equal (sweep-next-solution) (list t 2 3 1))) - (should (equal (sweep-next-solution) (list t 3 1 2))) - (should (equal (sweep-next-solution) (list t 3 2 1))) - (should (equal (sweep-next-solution) nil)) - (should (equal (sweep-cut-query) t))) - -(ert-deftest system:=/2 () - "Tests unifying Prolog terms with =/2 from Elisp." - (should (equal (sweep-open-query "user" "system" "=" (list 1 nil (list "foo" "bar") 3.14)) t)) - (should (equal (sweep-next-solution) (list '! 1 nil (list "foo" "bar") 3.14))) - (should (equal (sweep-next-solution) nil)) - (should (equal (sweep-cut-query) t))) - - -(defun sweep-test-indentation (given expected) - (with-temp-buffer - (sweep-mode) - (insert given) - (indent-region-line-by-line (point-min) (point-max)) - (should (string= (buffer-substring-no-properties (point-min) (point-max)) - expected)))) - -(ert-deftest indentation () - "Tests indentation rules." - (sweep-test-indentation - " -some_functor( -arg1, -arg2, -)." - " -some_functor( - arg1, - arg2, -)." - ) - (sweep-test-indentation - " -asserta( some_functor(arg1, arg2) :- -body_term -). -" - " -asserta( some_functor(arg1, arg2) :- - body_term - ). -" - ) - (sweep-test-indentation - " -:- module(spam, [ foo, -bar, -baz -] -). -" - " -:- module(spam, [ foo, - bar, - baz - ] - ). -" - ) - (sweep-test-indentation - " -:- module(spam, [ -foo, -bar, -baz -] -). -" - " -:- module(spam, [ - foo, - bar, - baz - ] - ). -" - ) - (sweep-test-indentation - " -[ - ]. -" - " -[ -]. -" - ) - (sweep-test-indentation - " -:- -use_module(foo), -use_module(bar). -" - " -:- - use_module(foo), - use_module(bar). -" - ) - (sweep-test-indentation - " -colourise_declaration(Module:PI, _, TB, - term_position(_,_,QF,QT,[PM,PG])) :- - atom(Module), nonvar(PI), PI = Name/Arity, - !, % partial predicate indicators - colourise_module(Module, TB, PM), - colour_item(functor, TB, QF-QT), - ( (var(Name) ; atom(Name)), - (var(Arity) ; integer(Arity), - Arity >= 0) - -> colourise_term_arg(PI, TB, PG) - ; colour_item(type_error(predicate_indicator), TB, PG) - ). -" - " -colourise_declaration(Module:PI, _, TB, - term_position(_,_,QF,QT,[PM,PG])) :- - atom(Module), nonvar(PI), PI = Name/Arity, - !, % partial predicate indicators - colourise_module(Module, TB, PM), - colour_item(functor, TB, QF-QT), - ( (var(Name) ; atom(Name)), - (var(Arity) ; integer(Arity), - Arity >= 0) - -> colourise_term_arg(PI, TB, PG) - ; colour_item(type_error(predicate_indicator), TB, PG) - ). -") - (sweep-test-indentation - " -A is 1 * 2 + 3 * -4. -" - " -A is 1 * 2 + 3 * - 4. -") - (sweep-test-indentation - " -A is 1 * 2 ^ 3 * -4. -" - " -A is 1 * 2 ^ 3 * - 4. -") - (sweep-test-indentation - " -( if - -> ( iff1, iff2, iff3, -iff4 --> thenn -; elsee -) - ; else - ) -" - " -( if --> ( iff1, iff2, iff3, - iff4 - -> thenn - ; elsee - ) -; else -) -") - (sweep-test-indentation - " -( if - -> ( iff --> thenn -; elsee -) - ; else - ) -" - " -( if --> ( iff - -> thenn - ; elsee - ) -; else -) -") - (sweep-test-indentation - " -( if - ; then - -> else - ) -" - " -( if -; then --> else -) -") - (sweep-test-indentation - " -asserta( foo(bar, baz) :- -true). -" - " -asserta( foo(bar, baz) :- - true). -") - (sweep-test-indentation - " -foo(bar, baz) :- -true. -" - " -foo(bar, baz) :- - true. -") - - (sweep-test-indentation - " -:- multifile -foo/2. -" - " -:- multifile - foo/2. -") - - (sweep-test-indentation - " - %%%% - %%%% -" - " - %%%% - %%%% -") - - (sweep-test-indentation - " -( -foo" - " -( - foo") - (sweep-test-indentation - " -functor( -foo" - " -functor( - foo") - ) - -;;; sweep-tests.el ends here diff --git a/sweep.c b/sweep.c index 847d981..bf224b0 100644 --- a/sweep.c +++ b/sweep.c @@ -30,7 +30,7 @@ POSSIBILITY OF SUCH DAMAGE. */ -#include "emacs-module.h" +#include #include #include #include diff --git a/sweep.el b/sweep.el deleted file mode 100644 index a9c9c31..0000000 --- a/sweep.el +++ /dev/null @@ -1,1561 +0,0 @@ -;;; sweep.el --- Embedded SWI-Prolog -*- lexical-binding:t -*- - -;; Copyright (C) 2022 Eshel Yaron - -;; Author: Eshel Yaron -;; Maintainer: Eshel Yaron -;; Keywords: prolog languages extensions -;; URL: https://git.sr.ht/~eshel/sweep -;; Package-Version: 0.3.1 -;; Package-Requires: ((emacs "28")) - -;; This file is NOT part of GNU Emacs. - -;;; Commentary: - -;; sweep is an embedding of SWI-Prolog in Emacs. It uses the C -;; interfaces of both SWI-Prolog and Emacs Lisp to create a -;; dynamically loaded Emacs module that contains the SWI-Prolog -;; runtime. sweep provides an interface for interacting with the -;; embedded Prolog via a set of Elisp functions, as well as user -;; facing modes and commands for writing and running Prolog within -;; Emacs. -;; -;; For more information, see the sweep manual at -;; . The manual can also be read -;; locally by evaluating (info "(sweep) Top") - -;;; Code: - -(require 'comint) -(require 'xref) - -(defgroup sweep nil - "SWI-Prolog Embedded in Emacs." - :group 'prolog) - -(defcustom sweep-indent-offset 4 - "Number of columns to indent lines with in `sweep-mode' buffers." - :package-version '((sweep . "0.3.1")) - :type 'integer - :group 'sweep) - -(defcustom sweep-colourise-buffer-on-idle t - "If non-nil, update highlighting of `sweep-mode' buffers on idle." - :package-version '((sweep . "0.2.0")) - :type 'boolean - :group 'sweep) - -(defcustom sweep-colourise-buffer-max-size 100000 - "Maximum buffer size to recolourise on idle." - :package-version '((sweep . "0.2.0")) - :type 'integer - :group 'sweep) - -(defcustom sweep-colourise-buffer-min-interval 2 - "Minimum idle time to wait before recolourising the buffer." - :package-version '((sweep . "0.2.0")) - :type 'float - :group 'sweep) - -(defcustom sweep-swipl-path nil - "Path to the swipl executable. -When non-nil, this is used by the embedded SWI-Prolog runtime to -locate its \"home\" directory. Otherwise, the `executable-find' -is used to find a the swipl executable." - :package-version '((sweep . "0.1.1")) - :type 'string - :group 'sweep) - -(defcustom sweep-messages-buffer-name "*sweep Messages*" - "The name of the buffer to use for logging Prolog messages." - :package-version '((sweep . "0.1.1")) - :type 'string - :group 'sweep) - -(defcustom sweep-read-flag-prompt "Flag: " - "Prompt used for reading a Prolog flag name from the minibuffer." - :package-version '((sweep . "0.1.2")) - :type 'string - :group 'sweep) - -(defcustom sweep-read-module-prompt "Module: " - "Prompt used for reading a Prolog module name from the minibuffer." - :package-version '((sweep . "0.1.0")) - :type 'string - :group 'sweep) - -(defcustom sweep-read-predicate-prompt "Predicate: " - "Prompt used for reading a Prolog precicate name from the minibuffer." - :package-version '((sweep . "0.1.0")) - :type 'string - :group 'sweep) - -(defcustom sweep-read-pack-prompt "Pack: " - "Prompt used for reading a Prolog pack name from the minibuffer." - :package-version '((sweep . "0.1.0")) - :type 'string - :group 'sweep) - -(defcustom sweep-top-level-display-action nil - "Display action used for displaying the `sweep-top-level' buffer." - :package-version '((sweep . "0.1.0")) - :type 'function - :group 'sweep) - -(defcustom sweep-top-level-min-history-length 3 - "Minimum input length to record in the `sweep-top-level' history. - -Inputs shorther than the value of this variable will not be -inserted to the input history in `sweep-top-level-mode' buffers." - :package-version '((sweep . "0.2.1")) - :type 'string - :group 'sweep) - -(defvar sweep-install-buffer-name "*Install sweep*" - "Name of the buffer used for compiling sweep-module.") - -(defcustom sweep-init-on-load t - "If non-nil, initialize Prolog when `sweep' is loaded." - :package-version '((sweep "0.1.0")) - :type 'boolean - :group 'sweep) - -(defcustom sweep-init-args (list (expand-file-name - "sweep.pl" - (file-name-directory load-file-name))) - "List of strings used as initialization arguments for Prolog." - :package-version '((sweep "0.1.0")) - :type '(list string) - :group 'sweep) - -(defvar sweep-prolog-server-port nil) - -(defun sweep--compile-module () - "Compile sweep-module." - (interactive) - (let* ((sweep-directory - (shell-quote-argument (file-name-directory load-file-name))) - (make-commands - (concat - "cd " sweep-directory "; make; cd -")) - (buffer (get-buffer-create sweep-install-buffer-name))) - (pop-to-buffer buffer) - (compilation-mode) - (if (zerop (let ((inhibit-read-only t)) - (call-process "sh" nil buffer t "-c" make-commands))) - (message "Compilation of `sweep' module succeeded") - (error "Compilation of `sweep' module failed!")))) - -(declare-function sweep-initialize "sweep-module") -(declare-function sweep-initialized-p "sweep-module") -(declare-function sweep-open-query "sweep-module") -(declare-function sweep-next-solution "sweep-module") -(declare-function sweep-cut-query "sweep-module") -(declare-function sweep-close-query "sweep-module") -(declare-function sweep-cleanup "sweep-module") - -(defun sweep--ensure-module () - (unless (require 'sweep-module nil t) - (if (y-or-n-p "Sweep needs `sweep-module' to work. Compile it now? ") - (progn - (sweep--compile-module) - (require 'sweep-module)) - (error "Sweep will not work until `sweep-module' is compiled!")))) - - -(defface sweep-debug-prefix-face - '((default :inherit shadow)) - "Face used to highlight the \"DEBUG\" message prefix." - :group 'sweep-faces) - -(defvar sweep-debug-prefix-face 'sweep-debug-prefix-face - "Name of the face used to highlight the \"DEBUG\" message prefix.") - -(defface sweep-debug-topic-face - '((default :inherit shadow)) - "Face used to highlight the topic in debug messages." - :group 'sweep-faces) - -(defvar sweep-debug-topic-face 'sweep-debug-topic-face - "Name of the face used to highlight the topic in debug messages.") - -(defface sweep-info-prefix-face - '((default :inherit default)) - "Face used to highlight the \"INFO\" message prefix." - :group 'sweep-faces) - -(defvar sweep-info-prefix-face 'sweep-info-prefix-face - "Name of the face used to highlight the \"INFO\" message prefix.") - -(defface sweep-warning-prefix-face - '((default :inherit font-lock-warning-face)) - "Face used to highlight the \"WARNING\" message prefix." - :group 'sweep-faces) - -(defvar sweep-warning-prefix-face 'sweep-warning-prefix-face - "Name of the face used to highlight the \"WARNING\" message prefix.") - -(defface sweep-error-prefix-face - '((default :inherit error)) - "Face used to highlight the \"ERROR\" message prefix." - :group 'sweep-faces) - -(defvar sweep-error-prefix-face 'sweep-error-prefix-face - "Name of the face used to highlight the \"ERROR\" message prefix.") - -(defun sweep-view-messages () - "View the log of recent Prolog messages." - (interactive) - (with-current-buffer (get-buffer-create sweep-messages-buffer-name) - (goto-char (point-max)) - (let ((win (display-buffer (current-buffer)))) - (set-window-point win (point)) - win))) - -(defun sweep-current-prolog-flags (&optional prefix) - (sweep-open-query "user" "sweep" "sweep_current_prolog_flags" (or prefix "")) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-read-prolog-flag () - "Read a Prolog flag from the minibuffer, with completion." - (let* ((col (sweep-current-prolog-flags)) - (completion-extra-properties - (list :annotation-function - (lambda (key) - (let* ((val (cdr (assoc-string key col)))) - (if val - (concat (make-string - (max (- 32 (length key)) 1) ? ) - val) - nil)))))) - (completing-read sweep-read-flag-prompt col))) - -(defun sweep-set-prolog-flag (flag value) - "Set the Prolog flag FLAG to VALUE. -FLAG and VALUE are specified as strings and read as Prolog terms." - (interactive (let ((f (sweep-read-prolog-flag))) - (list f (read-string (concat "Set " f " to: "))))) - (sweep-open-query "user" - "sweep" - "sweep_set_prolog_flag" - (cons flag value)) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (if (sweep-true-p sol) - (message "Prolog flag %s set to %s" flag value) - (user-error "Setting %s to %s failed!" flag value)))) - -(defun sweep-setup-message-hook () - (with-current-buffer (get-buffer-create sweep-messages-buffer-name) - (setq-local window-point-insertion-type t) - (compilation-minor-mode 1)) - (sweep-open-query "user" - "sweep" - "sweep_setup_message_hook" - nil) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - sol)) - -(defun sweep-message (message) - (with-current-buffer (get-buffer-create sweep-messages-buffer-name) - (save-excursion - (goto-char (point-max)) - (let ((kind (car message)) - (content (cdr message))) - (pcase kind - (`("debug" . ,topic) - (insert (propertize "DEBUG" 'face sweep-debug-prefix-face)) - (insert "[") - (insert (propertize topic 'face sweep-debug-topic-face)) - (insert "]: ") - (insert content)) - ("informational" - (insert (propertize "INFO" 'face sweep-info-prefix-face)) - (insert ": ") - (insert content)) - ("warning" - (insert (propertize "WARNING" 'face sweep-warning-prefix-face)) - (insert ": ") - (insert content)) - ("error" - (insert (propertize "ERROR" 'face sweep-error-prefix-face)) - (insert ": ") - (insert content)))) - (newline)))) - -(defun sweep-start-prolog-server () - (sweep-open-query "user" - "prolog_server" - "prolog_server" - nil t) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (setq sweep-prolog-server-port (cdr sol))))) - -(defun sweep-init () - (apply #'sweep-initialize - (cons (or sweep-swipl-path (executable-find "swipl")) - (cons "-q" (cons "--no-signals" sweep-init-args)))) - (sweep-setup-message-hook) - (sweep-start-prolog-server)) - -(defvar sweep-predicate-completion-collection nil) - -(defvar-local sweep-buffer-module "user") - -(defun sweep-local-predicates-collection (&optional prefix) - (sweep-open-query "user" "sweep" "sweep_local_predicate_completion" - (cons sweep-buffer-module - prefix)) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (setq sweep-predicate-completion-collection (cdr sol))))) - -(defun sweep-predicates-collection (&optional prefix) - (sweep-open-query "user" "sweep" "sweep_predicates_collection" prefix) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-predicate-references (mfn) - (sweep-open-query "user" "sweep" "sweep_predicate_references" mfn) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-predicate-location (mfn) - (sweep-open-query "user" "sweep" "sweep_predicate_location" mfn) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-predicate-apropos (pattern) - (sweep-open-query "user" "sweep" "sweep_predicate_apropos" pattern) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-read-predicate () - "Read a Prolog predicate (M:F/N) from the minibuffer, with completion." - (let* ((col (sweep-predicates-collection)) - (completion-extra-properties - (list :annotation-function - (lambda (key) - (let* ((val (cdr (assoc-string key col)))) - (if val - (concat (make-string (- 64 (length key)) ? ) (car val)) - nil)))))) - (completing-read sweep-read-predicate-prompt col))) - -(defun sweep-predicate-prefix-boundaries (&optional point) - (let ((case-fold-search nil)) - (save-mark-and-excursion - (save-match-data - (when point (goto-char point)) - (unless (bobp) (backward-char)) - (while (looking-at-p "[[:alnum:]_]") - (backward-char)) - (when (looking-at-p ":[[:lower:]]") - (unless (bobp) (backward-char)) - (while (looking-at-p "[[:alnum:]_]") - (backward-char))) - (forward-char) - (when (looking-at-p "[[:lower:]]") - (let ((start (point))) - (while (looking-at-p "[[:alnum:]:_]") - (forward-char)) - (cons start (point)))))))) - -(defun sweep-prefix-operators (&optional file) - (sweep-open-query "user" - "sweep" "sweep_prefix_ops" - (or file (buffer-file-name))) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-completion-at-point-function () - (when-let ((bounds (sweep-predicate-prefix-boundaries))) - (let ((start (car bounds)) - (end (cdr bounds))) - (list start end - (completion-table-with-cache #'sweep-local-predicates-collection) - :exclusive 'no - :annotation-function - (lambda (key) - (when-let ((ann (cdr (assoc-string key sweep-predicate-completion-collection)))) - (concat " " (mapconcat #'identity ann ",")))) - :exit-function - (lambda (key sts) - (when (eq sts 'finished) - (let ((opoint (point))) - (save-match-data - (combine-after-change-calls - (skip-chars-backward "1234567890") - (when (= ?/ (preceding-char)) - (backward-char) - (let ((arity (string-to-number (buffer-substring-no-properties (1+ (point)) opoint)))) - (delete-region (point) opoint) - (when (and - (< 0 arity) - (not - (string= - "op" - (cadr - (assoc-string - key - sweep-predicate-completion-collection))))) - (insert "(") - (dotimes (_ (1- arity)) - (insert "_, ")) - (insert "_)") - (goto-char (1- opoint)))))))))))))) - -;;;###autoload -(defun sweep-find-predicate (mfn) - "Jump to the definition of the Prolog predicate MFN. -MFN must be a string of the form \"M:F/N\" where M is a Prolog -module name, F is a functor name and N is its arity." - (interactive (list (sweep-read-predicate))) - (if-let ((loc (sweep-predicate-location mfn))) - (let ((path (car loc)) - (line (or (cdr loc) 1))) - (find-file path) - (goto-char (point-min)) - (forward-line (1- line))) - (user-error "Unable to locate predicate %s" mfn))) - -(defun sweep-modules-collection () - (sweep-open-query "user" "sweep" "sweep_modules_collection" nil) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-module-path (mod) - (sweep-open-query "user" "sweep" "sweep_module_path" mod) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-read-module-name () - "Read a Prolog module name from the minibuffer, with completion." - (let* ((col (sweep-modules-collection)) - (completion-extra-properties - (list :annotation-function - (lambda (key) - (let* ((val (cdr (assoc-string key col))) - (pat (car val)) - (des (cdr val))) - (concat (make-string (max 0 (- 32 (length key))) ? ) - (if des - (concat pat (make-string (max 0 (- 80 (length pat))) ? ) des) - pat))))))) - (completing-read sweep-read-module-prompt col))) - - -(defun sweep--set-buffer-module () - (sweep-open-query "user" "sweep" "sweep_path_module" (buffer-file-name)) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (setq sweep-buffer-module (cdr sol))))) - -;;;###autoload -(defun sweep-find-module (mod) - "Jump to the source file of the Prolog module MOD." - (interactive (list (sweep-read-module-name))) - (find-file (sweep-module-path mod))) - -(defun sweep-packs-collection () - (sweep-open-query "user" "sweep" "sweep_packs_collection" "") - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol)))) - -(defun sweep-read-pack-name () - "Read a Prolog pack name from the minibuffer, with completion." - (let* ((col (sweep-packs-collection)) - (completion-extra-properties - (list :annotation-function - (lambda (key) - (let* ((val (cdr (assoc-string key col))) - (des (car val)) - (ver (cadr val))) - (concat (make-string (max 0 (- 32 (length key))) ? ) - (if des - (concat ver (make-string (max 0 (- 16 (length ver))) ? ) des) - ver))))))) - (completing-read sweep-read-pack-prompt col))) - -(defun sweep-true-p (sol) - (or (eq (car sol) '!) - (eq (car sol) t))) - -;;;###autoload -(defun sweep-pack-install (pack) - "Install or upgrade Prolog package PACK." - (interactive (list (sweep-read-pack-name))) - (sweep-open-query "user" "sweep" "sweep_pack_install" pack) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (if (sweep-true-p sol) - (message "Package install successful.") - (user-error "Pacakge installation failed!")))) - -;; (defun sweep-file-handler (operation &rest args) -;; (cond ((eq operation 'expand-file-name) (apply sweep-expand-file-name args) ) -;; ;; ((eq operation 'file-name-all-completions)) -;; ;; ((eq operation 'file-name-completion)) -;; (t (let ((inhibit-file-name-handlers -;; (cons 'my-file-handler -;; (and (eq inhibit-file-name-operation operation) -;; inhibit-file-name-handlers))) -;; (inhibit-file-name-operation operation)) -;; (apply operation args))))) - -;; (defun sweep-expand-file-name (name &optional dir) -;; (sweep-open-query "user" "sweep" "sweep_expand_file_name" (cons name dir)) -;; (let ((sol (sweep-next-solution))) -;; (sweep-close-query) -;; (when (sweep-true-p sol) -;; (cdr sol)))) - -(defgroup sweep-faces nil - "Faces used to highlight Prolog code." - :group 'sweep) - -(eval-when-compile - (defmacro sweep-defface (name def doc) - "Define sweep face FACE with doc DOC." - (declare - (indent defun) - (doc-string 3)) - (let ((face (intern (concat "sweep-" (symbol-name name) "-face")))) - `(progn - (defface ,face - '((default :inherit ,def)) - ,(concat "Face used to highlight " (downcase doc)) - :group 'sweep-faces) - (defvar ,face ',face - ,(concat "Name of the face used to highlight " (downcase doc))))))) - -(sweep-defface functor font-lock-function-name-face - "Functors.") - -(sweep-defface arity font-lock-function-name-face - "Arities.") - -(sweep-defface predicate-indicator font-lock-function-name-face - "Predicate indicators.") - -(sweep-defface built-in font-lock-keyword-face - "Built in predicate calls.") - -(sweep-defface neck font-lock-preprocessor-face - "Necks.") - -(sweep-defface goal font-lock-function-name-face - "Unspecified predicate goals.") - -(sweep-defface string font-lock-string-face - "Strings.") - -(sweep-defface comment font-lock-comment-face - "Comments.") - -(defface sweep-head-built-in-face - '((default . (:foreground "black" :background "orange" :weight bold))) - "Face used to highlight built-in predicate definitons." - :group 'sweep-faces) - -(defface sweep-method-face - '((default . (:weight bold))) - "Face used to highlight PCE methods." - :group 'sweep-faces) - -(defface sweep-class-face - '((default . (:underline t))) - "Face used to highlight PCE classes." - :group 'sweep-faces) - -(defface sweep-no-file-face - '((default . (:foreground "red"))) - "Face used to highlight non-existsing file specifications." - :group 'sweep-faces) - -(sweep-defface head-local font-lock-builtin-face - "Local predicate definitions.") - -(sweep-defface head-meta font-lock-preprocessor-face - "Meta predicate definitions.") - -(sweep-defface head-multifile font-lock-type-face - "Multifile predicate definitions.") - -(sweep-defface head-extern font-lock-type-face - "External predicate definitions.") - -(sweep-defface head-unreferenced font-lock-warning-face - "Unreferenced predicate definitions.") - -(sweep-defface head-exported font-lock-builtin-face - "Exported predicate definitions.") - -(sweep-defface head-hook font-lock-type-face - "Hook definitions.") - -(sweep-defface head-iso font-lock-keyword-face - "Hook definitions.") - -(sweep-defface head-undefined font-lock-warning-face - "Undefind head terms.") - -(sweep-defface head-public font-lock-builtin-face - "Public definitions.") - -(sweep-defface meta-spec font-lock-preprocessor-face - "Meta argument specifiers.") - -(sweep-defface recursion font-lock-builtin-face - "Recursive calls.") - -(sweep-defface local font-lock-function-name-face - "Local predicate calls.") - -(sweep-defface autoload font-lock-function-name-face - "Autoloaded predicate calls.") - -(sweep-defface imported font-lock-function-name-face - "Imported predicate calls.") - -(sweep-defface extern font-lock-function-name-face - "External predicate calls.") - -(sweep-defface foreign font-lock-keyword-face - "Foreign predicate calls.") - -(sweep-defface meta font-lock-type-face - "Meta predicate calls.") - -(sweep-defface undefined font-lock-warning-face - "Undefined predicate calls.") - -(sweep-defface thread-local font-lock-constant-face - "Thread local predicate calls.") - -(sweep-defface global font-lock-keyword-face - "Global predicate calls.") - -(sweep-defface multifile font-lock-function-name-face - "Multifile predicate calls.") - -(sweep-defface dynamic font-lock-constant-face - "Dynamic predicate calls.") - -(sweep-defface undefined-import font-lock-warning-face - "Undefined imports.") - -(sweep-defface html-attribute font-lock-function-name-face - "HTML attributes.") - -(sweep-defface html-call font-lock-keyword-face - "Multifile predicate calls.") - -(sweep-defface option-name font-lock-constant-face - "Option names.") - -(sweep-defface no-option-name font-lock-warning-face - "Non-existent option names.") - -(sweep-defface flag-name font-lock-constant-face - "Flag names.") - -(sweep-defface no-flag-name font-lock-warning-face - "Non-existent flag names.") - -(sweep-defface qq-type font-lock-type-face - "Quasi-quotation types.") - -(sweep-defface qq-sep font-lock-type-face - "Quasi-quotation separators.") - -(sweep-defface qq-open font-lock-type-face - "Quasi-quotation open sequences.") - -(sweep-defface qq-close font-lock-type-face - "Quasi-quotation close sequences.") - -(sweep-defface op-type font-lock-type-face - "Operator types.") - -(sweep-defface dict-tag font-lock-constant-face - "Dict tags.") - -(sweep-defface dict-key font-lock-keyword-face - "Dict keys.") - -(sweep-defface dict-sep font-lock-keyword-face - "Dict separators.") - -(sweep-defface type-error font-lock-warning-face - "Type errors.") - -(sweep-defface instantiation-error font-lock-warning-face - "Instantiation errors.") - -(sweep-defface file button - "File specifiers.") - -(sweep-defface file-no-depend font-lock-warning-face - "Unused file specifiers.") - -(sweep-defface unused-import font-lock-warning-face - "Unused imports.") - -(sweep-defface identifier font-lock-type-face - "Identifiers.") - -(sweep-defface hook font-lock-preprocessor-face - "Hooks.") - -(sweep-defface module font-lock-type-face - "Module names.") - -(sweep-defface singleton font-lock-warning-face - "Singletons.") - -(sweep-defface fullstop font-lock-negation-char-face - "Fullstops.") - -(sweep-defface nil font-lock-keyword-face - "The empty list.") - -(sweep-defface variable font-lock-variable-name-face - "Variables.") - -(sweep-defface ext-quant font-lock-keyword-face - "Existential quantifiers.") - -(sweep-defface control font-lock-keyword-face - "Control constructs.") - -(sweep-defface atom font-lock-constant-face - "Atoms.") - -(sweep-defface int font-lock-constant-face - "Integers.") - -(sweep-defface float font-lock-constant-face - "Floats.") - -(sweep-defface codes font-lock-constant-face - "Codes.") - -(sweep-defface error font-lock-warning-face - "Unspecified errors.") - -(sweep-defface syntax-error error - "Syntax errors.") - -(sweep-defface structured-comment font-lock-doc-face - "Structured comments.") - -(defun sweep--colourise (args) - "ARGS is a list of the form (BEG LEN . SEM)." - (let* ((beg (max (point-min) (car args))) - (end (min (point-max) (+ beg (cadr args)))) - (arg (cddr args))) - (with-silent-modifications - (pcase arg - (`("comment" . ,k) - (put-text-property beg end 'font-lock-face - (pcase k - ("structured" sweep-structured-comment-face) - (_ sweep-comment-face)))) - (`("head" . ,h) - (put-text-property beg end 'font-lock-face - (pcase h - (`("unreferenced" . ,_) sweep-head-unreferenced-face) - (`("meta" . ,_) sweep-head-meta-face) - (`("exported" . ,_) sweep-head-exported-face) - (`("hook" . ,_) sweep-head-hook-face) - (`("built_in" . ,_) 'sweep-head-built-in-face) - (`(,(rx "extern(") . ,_) sweep-head-extern-face) - (`(,(rx "public ") . ,_) sweep-head-public-face) - (`(,(rx "local(") . ,_) sweep-head-local-face) - (other (message "unknown head color term %S" other) sweep-head-local-face)))) - (`("goal" . ,g) - (put-text-property beg end 'font-lock-face - (pcase g - (`("recursion" . ,_) sweep-recursion-face) - (`("meta" . ,_) sweep-meta-face) - (`("built_in" . ,_) sweep-built-in-face) - (`("undefined" . ,_) sweep-undefined-face) - (`("global" . ,_) sweep-global-face) - (`(,(rx "dynamic ") . ,_) sweep-dynamic-face) - (`(,(rx "multifile ") . ,_) sweep-multifile-face) - (`(,(rx "thread_local ") . ,_) sweep-thread-local-face) - (`(,(rx "extern(") . ,_) sweep-extern-face) - (`(,(rx "autoload(") . ,_) sweep-autoload-face) - (`(,(rx "imported(") . ,_) sweep-imported-face) - (`(,(rx "global(") . ,_) sweep-global-face) - (`(,(rx "local(") . ,_) sweep-local-face) - (other (message "unknown goal color term %S" other) sweep-goal-face)))) - (`("syntax_error" ,_message ,_eb ,_ee) - (put-text-property beg end 'font-lock-face sweep-syntax-error-face)) - ("unused_import" (put-text-property beg end 'font-lock-face sweep-unused-import-face)) - ("undefined_import" (put-text-property beg end 'font-lock-face sweep-undefined-import-face)) - ("html_attribute" (put-text-property beg end 'font-lock-face sweep-html-attribute-face)) - ("html_call" (put-text-property beg end 'font-lock-face sweep-html-call-face)) - ("dict_tag" (put-text-property beg end 'font-lock-face sweep-dict-tag-face)) - ("dict_key" (put-text-property beg end 'font-lock-face sweep-dict-key-face)) - ("dict_sep" (put-text-property beg end 'font-lock-face sweep-dict-sep-face)) - ("meta" (put-text-property beg end 'font-lock-face sweep-meta-spec-face)) - ("flag_name" (put-text-property beg end 'font-lock-face sweep-flag-name-face)) - ("no_flag_name" (put-text-property beg end 'font-lock-face sweep-flag-name-face)) - ("ext_quant" (put-text-property beg end 'font-lock-face sweep-ext-quant-face)) - ("atom" (put-text-property beg end 'font-lock-face sweep-atom-face)) - ("float" (put-text-property beg end 'font-lock-face sweep-float-face)) - ("int" (put-text-property beg end 'font-lock-face sweep-int-face)) - ("singleton" (put-text-property beg end 'font-lock-face sweep-singleton-face)) - ("option_name" (put-text-property beg end 'font-lock-face sweep-option-name-face)) - ("no_option_name" (put-text-property beg end 'font-lock-face sweep-no-option-name-face)) - ("control" (put-text-property beg end 'font-lock-face sweep-control-face)) - ("var" (put-text-property beg end 'font-lock-face sweep-variable-face)) - ("fullstop" (put-text-property beg end 'font-lock-face sweep-fullstop-face)) - ("functor" (put-text-property beg end 'font-lock-face sweep-functor-face)) - ("arity" (put-text-property beg end 'font-lock-face sweep-arity-face)) - ("predicate_indicator" (put-text-property beg end 'font-lock-face sweep-predicate-indicator-face)) - ("string" (put-text-property beg end 'font-lock-face sweep-string-face)) - ("module" (put-text-property beg end 'font-lock-face sweep-module-face)) - ("neck" (put-text-property beg end 'font-lock-face sweep-neck-face)) - ("hook" (put-text-property beg end 'font-lock-face sweep-hook-face)) - ("qq_type" (put-text-property beg end 'font-lock-face sweep-qq-type-face)) - ("qq_sep" (put-text-property beg end 'font-lock-face sweep-qq-sep-face)) - ("qq_open" (put-text-property beg end 'font-lock-face sweep-qq-open-face)) - ("qq_close" (put-text-property beg end 'font-lock-face sweep-qq-close-face)) - ("identifier" (put-text-property beg end 'font-lock-face sweep-identifier-face)) - ("file" (put-text-property beg end 'font-lock-face sweep-file-face)) - ("file_no_depend" (put-text-property beg end 'font-lock-face sweep-file-no-depend-face)) - ("nofile" (put-text-property beg end 'font-lock-face 'sweep-no-file-face)) - ("op_type" (put-text-property beg end 'font-lock-face sweep-op-type-face)) - ("method" (put-text-property beg end 'font-lock-face 'sweep-method-face)) - ("class" (put-text-property beg end 'font-lock-face 'sweep-class-face)) - (`("goal_term" . ,_) nil) - (`("head_term" . ,_) nil) - ("clause" nil) - ("directive" nil) - ("body" nil) - ("html" nil) - ("parentheses" nil) - ("pce" nil) - ("term" nil) - ("expanded" nil) - ("list" nil) - ("grammar_rule" nil) - ("dict" nil) - ("dict_content" nil) - ("brace_term" nil) - ("rule_condition" nil) - ("exported_operator" nil) - ("empty_list" nil) - ("dcg" nil) - ("qq_content" nil) - ("qq" nil) - (other (message "Unknown color term %S" other)))))) - -(defun sweep-colourise-buffer (&optional buffer) - (interactive) - (with-current-buffer (or buffer (current-buffer)) - (let* ((beg (point-min)) - (end (point-max)) - (contents (buffer-substring-no-properties beg end))) - (with-silent-modifications - (font-lock-unfontify-region beg end)) - (sweep-open-query "user" - "sweep" - "sweep_colourise_buffer" - (cons contents (buffer-file-name))) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - sol)))) - -(defun sweep-colourise-some-terms (beg0 end0 &optional _verbose) - (let* ((beg (save-mark-and-excursion - (goto-char beg0) - (sweep-beginning-of-top-term) - (max (1- (point)) (point-min)))) - (end (save-mark-and-excursion - (goto-char end0) - (sweep-end-of-top-term) - (point))) - (contents (buffer-substring-no-properties beg end))) - (with-silent-modifications - (font-lock-unfontify-region beg end)) - (sweep-open-query "user" - "sweep" - "sweep_colourise_some_terms" - (list contents - (buffer-file-name) - beg)) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - `(jit-lock-bounds ,beg . ,end))))) - -(defun sweep-colourise-query (buffer) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when-let ((beg (cdr comint-last-prompt)) - (end (point-max)) - (query (buffer-substring-no-properties beg end))) - (with-silent-modifications - (font-lock-unfontify-region beg end)) - (sweep-open-query "user" - "sweep" - "sweep_colourise_query" - (cons query (marker-position beg))) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - sol))))) - -(defun sweep-load-buffer (buffer) - "Load the Prolog buffer BUFFER into the embedded SWI-Prolog runtime. - -Interactively, if the major mode of the current buffer is -`sweep-mode' and the command is called without a prefix argument, -load the current buffer. Otherwise, prompt for a `sweep-mode' -buffer to load." - (interactive (list - (if (and (not current-prefix-arg) - (eq major-mode 'sweep-mode)) - (current-buffer) - (read-buffer "Load buffer: " - (when (eq major-mode 'sweep-mode) - (buffer-name)) - t - (lambda (b) - (let ((n (or (and (consp b) (car b)) b))) - (with-current-buffer n - (eq major-mode 'sweep-mode)))))))) - (with-current-buffer buffer - (let* ((beg (point-min)) - (end (point-max)) - (contents (buffer-substring-no-properties beg end))) - (sweep-open-query "user" - "sweep" - "sweep_load_buffer" - (cons contents (buffer-file-name))) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (if (sweep-true-p sol) - (message "Loaded %s." (buffer-name)) - (user-error "Loading %s failed!" (buffer-name))))))) - -;;;###autoload -(defun sweep-top-level (&optional buffer) - "Run a Prolog top-level in BUFFER. -If BUFFER is nil, a buffer called \"*sweep-top-level*\" is used -by default. - -Interactively, a prefix arg means to prompt for BUFFER." - (interactive - (let* ((buffer - (and current-prefix-arg - (read-buffer "Top-level buffer: " - (if (and (eq major-mode 'sweep-top-level-mode) - (null (get-buffer-process - (current-buffer)))) - (buffer-name) - (generate-new-buffer-name "*sweep-top-level*")))))) - (list buffer))) - (let ((buf (get-buffer-create (or buffer "*sweep-top-level*")))) - (with-current-buffer buf - (unless (eq major-mode 'sweep-top-level-mode) - (sweep-top-level-mode))) - (make-comint-in-buffer "sweep-top-level" - buf - (cons "localhost" - sweep-prolog-server-port)) - (pop-to-buffer buf sweep-top-level-display-action))) - -(defun sweep-top-level--post-self-insert-function () - (when-let ((pend (cdr comint-last-prompt))) - (let* ((pstart (car comint-last-prompt)) - (prompt (buffer-substring-no-properties pstart pend))) - (when (and (= (point) (1+ pend)) - (not (string-empty-p prompt)) - (not (string= "?- " (substring prompt - (- pend pstart 3) - (- pend pstart)))) - (not (string= "|: " prompt)) - (not (string= "| " prompt))) - (comint-send-input))))) - -(defvar-local sweep-top-level-timer nil "Buffer-local timer.") - -;;;###autoload -(define-derived-mode sweep-top-level-mode comint-mode "sweep Top-level" - "Major mode for interacting with an inferior Prolog interpreter." - :group 'sweep-top-level - (setq-local comint-prompt-regexp (rx line-start "?- ") - comint-input-ignoredups t - comint-prompt-read-only t - comint-input-filter (lambda (s) - (< sweep-top-level-min-history-length - (length s))) - comint-delimiter-argument-list '(?,) - comment-start "%") - (add-hook 'post-self-insert-hook #'sweep-top-level--post-self-insert-function nil t) - (setq sweep-buffer-module "user") - (add-hook 'completion-at-point-functions #'sweep-completion-at-point-function nil t) - (setq sweep-top-level-timer (run-with-idle-timer 0.2 t #'sweep-colourise-query (current-buffer))) - (add-hook 'kill-buffer-hook - (lambda () - (when (timerp sweep-top-level-timer) - (cancel-timer sweep-top-level-timer))))) - -(sweep--ensure-module) -(when sweep-init-on-load (sweep-init)) - -;;;###autoload -(defvar sweep-prefix-map - (let ((map (make-sparse-keymap))) - (define-key map "m" #'sweep-find-module) - (define-key map "p" #'sweep-find-predicate) - (define-key map "t" #'sweep-top-level) - (define-key map "l" #'sweep-load-buffer) - (define-key map "P" #'sweep-pack-install) - (define-key map "F" #'sweep-set-prolog-flag) - (define-key map "e" #'sweep-view-messages) - map) - "Keymap for `sweep' global commands.") - -;;;###autoload -(defun sweep-file-name-handler (operation &rest args) - (cond ((eq operation 'expand-file-name) - (let ((fn (car args)) - (dn (cadr args))) - (sweep-open-query "user" - "sweep" - "sweep_expand_file_name" - (cons fn dn)) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (if (sweep-true-p sol) - (cdr sol) - (let ((inhibit-file-name-handlers - (cons 'sweep-file-name-handler - (and (eq inhibit-file-name-operation operation) - inhibit-file-name-handlers))) - (inhibit-file-name-operation operation)) - (apply operation args)))))) - (t (let ((inhibit-file-name-handlers - (cons 'sweep-file-name-handler - (and (eq inhibit-file-name-operation operation) - inhibit-file-name-handlers))) - (inhibit-file-name-operation operation)) - (apply operation args))))) - -(add-to-list 'file-name-handler-alist - (cons (rx bol (one-or-more lower) "(") - #'sweep-file-name-handler)) - -(defun sweep-beginning-of-top-term (&optional arg) - (let ((times (or arg 1))) - (if (< 0 times) - (let ((p (point))) - (while (and (< 0 times) (not (bobp))) - (setq times (1- times)) - (when-let ((safe-start (nth 8 (syntax-ppss)))) - (goto-char safe-start)) - (re-search-backward (rx bol graph) nil t) - (let ((safe-start (or (nth 8 (syntax-ppss)) - (nth 8 (syntax-ppss (1+ (point))))))) - (while (and safe-start (not (bobp))) - (goto-char safe-start) - (backward-char) - (re-search-backward (rx bol graph) nil t) - (setq safe-start (or (nth 8 (syntax-ppss)) - (nth 8 (syntax-ppss (1+ (point))))))))) - (not (= p (point)))) - (sweep-beginning-of-next-top-term (- times))))) - -(defun sweep-beginning-of-next-top-term (times) - (let ((p (point))) - (while (and (< 0 times) (not (eobp))) - (setq times (1- times)) - (unless (eobp) - (forward-char) - (re-search-forward (rx bol graph) nil t)) - (while (and (nth 8 (syntax-ppss)) (not (eobp))) - (forward-char) - (re-search-forward (rx bol graph) nil t))) - (not (= p (point))))) - -(defun sweep-end-of-top-term () - (unless (eobp) - (while (and (nth 8 (syntax-ppss)) (not (eobp))) - (forward-char)) - (or (re-search-forward (rx "." (or white "\n")) nil t) - (goto-char (point-max))) - (while (and (nth 8 (syntax-ppss)) (not (eobp))) - (while (and (nth 8 (syntax-ppss)) (not (eobp))) - (forward-char)) - (or (re-search-forward (rx "." (or white "\n")) nil t) - (goto-char (point-max)))))) - -(defvar sweep-mode-syntax-table - (let ((table (make-syntax-table))) - (modify-syntax-entry ?_ "_" table) - (modify-syntax-entry ?+ "." table) - (modify-syntax-entry ?- "." table) - (modify-syntax-entry ?= "." table) - (modify-syntax-entry ?< "." table) - (modify-syntax-entry ?> "." table) - (modify-syntax-entry ?| "." table) - (modify-syntax-entry ?\' "\"" table) - (modify-syntax-entry ?` "\"" table) - (modify-syntax-entry ?% "<" table) - (modify-syntax-entry ?\n ">" table) - (modify-syntax-entry ?* ". 23b" table) - (modify-syntax-entry ?/ ". 14" table) - table)) - -(defvar sweep-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-l") #'sweep-load-buffer) - (define-key map (kbd "C-c C-c") #'sweep-colourise-buffer) - (define-key map (kbd "C-c C-t") #'sweep-top-level) - (define-key map (kbd "C-c C-o") #'sweep-find-file-at-point) - map) - "Keymap for `sweep-mode'.") - -(defun sweep-token-boundaries (&optional pos) - (let ((point (or pos (point)))) - (save-excursion - (goto-char point) - (unless (eobp) - (let ((beg (point)) - (syn (char-syntax (char-after)))) - (cond - ((or (= syn ?w) (= syn ?_)) - (skip-syntax-forward "w_") - (if (= (char-syntax (char-after)) ?\() - (progn - (forward-char) - (list 'functor beg (point))) - (list 'symbol beg (point)))) - ((= syn ?\") - (forward-char) - (while (and (not (eobp)) (nth 3 (syntax-ppss))) - (forward-char)) - (list 'string beg (point))) - ((= syn ?.) - (skip-syntax-forward ".") - (list 'operator beg (point))) - ((= syn ?\() - (list 'open beg (point))) - ((= syn ?\)) - (list 'close beg (point))) - ((= syn ?>) nil) - (t (list 'else beg (point))))))))) - -(defun sweep-last-token-boundaries (&optional pos) - (let ((point (or pos (point))) - (go t)) - (save-excursion - (goto-char point) - (while (and (not (bobp)) go) - (skip-chars-backward " \t\n") - (unless (bobp) - (forward-char -1) - (if (nth 4 (syntax-ppss)) - (goto-char (nth 8 (syntax-ppss))) - (setq go nil)))) - (unless (bobp) - (let ((end (1+ (point))) - (syn (char-syntax (char-after)))) - (cond - ((or (= syn ?w) (= syn ?_)) - (skip-syntax-backward "w_") - (list 'symbol (point) end)) - ((= syn ?\") - (list 'string (nth 8 (syntax-ppss)) end)) - ((and (= syn ?\() - (or (= (char-syntax (char-before)) ?w) - (= (char-syntax (char-before)) ?_))) - (skip-syntax-backward "w_") - (list 'functor (point) end)) - ((= syn ?.) - (skip-syntax-backward ".") - (list 'operator (point) end)) - ((= syn ?\() - (list 'open (1- end) end)) - ((= syn ?\)) - (list 'close (1- end) end)) - (t (list 'else (1- end) end)))))))) - -(defun sweep-backward-term (pre) - (pcase (sweep-last-token-boundaries) - ('nil nil) - (`(open,_ ,_) nil) - (`(functor,_ ,_) nil) - (`(operator ,obeg ,oend) - (unless (and (string= "." (buffer-substring-no-properties obeg oend)) - (member (char-syntax (char-after (1+ obeg))) '(?> ? ))) - (if-let ((opre (sweep-op-infix-precedence - (buffer-substring-no-properties obeg oend)))) - (when (<= opre pre) - (goto-char obeg) - (sweep-backward-term pre)) - (if-let ((ppre (sweep-op-prefix-precedence - (buffer-substring-no-properties obeg oend)))) - (when (<= ppre pre) - (goto-char obeg) - (sweep-backward-term pre)) - (goto-char obeg) - (sweep-backward-term pre))))) - (`(symbol ,obeg ,oend) - (if-let ((opre (sweep-op-infix-precedence - (buffer-substring-no-properties obeg oend)))) - (when (<= opre pre) - (goto-char obeg) - (sweep-backward-term pre)) - (if-let ((ppre (sweep-op-prefix-precedence - (buffer-substring-no-properties obeg oend)))) - (when (<= ppre pre) - (goto-char obeg) - (sweep-backward-term pre)) - (goto-char obeg) - (sweep-backward-term pre)))) - (`(close ,lbeg ,_lend) - (goto-char (nth 1 (syntax-ppss lbeg))) - (when (or (= (char-syntax (char-before)) ?w) - (= (char-syntax (char-before)) ?_)) - (skip-syntax-backward "w_")) - (sweep-backward-term pre)) - (`(,_ ,lbeg ,_) - (goto-char lbeg) - (sweep-backward-term pre)))) - -(defun sweep-op-suffix-precedence (token) - (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name))) - (let ((res nil) (go t)) - (while go - (if-let ((sol (sweep-next-solution)) - (det (car sol)) - (fix (cadr sol)) - (pre (cddr sol))) - (if (member fix '("xf" "yf")) - (setq res pre go nil) - (when (eq '! det) - (setq go nil))) - (setq go nil))) - (sweep-close-query) - res)) - -(defun sweep-op-prefix-precedence (token) - (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name))) - (let ((res nil) (go t)) - (while go - (if-let ((sol (sweep-next-solution)) - (det (car sol)) - (fix (cadr sol)) - (pre (cddr sol))) - (if (member fix '("fx" "fy")) - (setq res pre go nil) - (when (eq '! det) - (setq go nil))) - (setq go nil))) - (sweep-close-query) - res)) - -(defun sweep-op-infix-precedence (token) - (sweep-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name))) - (let ((res nil) (go t)) - (while go - (if-let ((sol (sweep-next-solution)) - (det (car sol)) - (fix (cadr sol)) - (pre (cddr sol))) - (if (member fix '("xfx" "xfy" "yfx")) - (setq res pre go nil) - (when (eq '! det) - (setq go nil))) - (setq go nil))) - (sweep-close-query) - res)) - -(defun sweep-indent-line-after-functor (fbeg _fend) - (save-excursion - (goto-char fbeg) - (+ (current-column) sweep-indent-offset))) - -(defun sweep-indent-line-after-open (fbeg _fend) - (save-excursion - (goto-char fbeg) - (+ (current-column) sweep-indent-offset))) - -(defun sweep-indent-line-after-prefix (fbeg _fend _pre) - (save-excursion - (goto-char fbeg) - (+ (current-column) 4))) - -(defun sweep-indent-line-after-term () - (if-let ((open (nth 1 (syntax-ppss)))) - (save-excursion - (goto-char open) - (current-column)) - 'noindent)) - -(defun sweep-indent-line-after-neck (fbeg _fend) - (save-excursion - (goto-char fbeg) - (sweep-backward-term 1200) - (+ (current-column) sweep-indent-offset))) - -(defun sweep-indent-line-after-infix (fbeg _fend pre) - (save-excursion - (goto-char fbeg) - (let ((lim (or (nth 1 (syntax-ppss)) (point-min))) - (cur (point)) - (go t)) - (while go - (setq cur (point)) - (sweep-backward-term pre) - (when (< (point) lim) - (goto-char cur)) - (when (= (point) cur) - (setq go nil)))) - (current-column))) - -(defun sweep-indent-line () - "Indent the current line in a `sweep-mode' buffer." - (interactive) - (let ((pos (- (point-max) (point)))) - (back-to-indentation) - (let ((indent (if (nth 8 (syntax-ppss)) - 'noindent - (if-let ((open (and (= (char-syntax (char-after)) ?\)) - (nth 1 (syntax-ppss))))) - (save-excursion - (goto-char open) - (when (or (= (char-syntax (char-before)) ?w) - (= (char-syntax (char-before)) ?_)) - (when (save-excursion - (forward-char) - (skip-syntax-forward " " (line-end-position)) - (eolp)) - (skip-syntax-backward "w_"))) - (current-column)) - (pcase (sweep-last-token-boundaries) - ('nil 'noindent) - (`(functor ,lbeg ,lend) - (sweep-indent-line-after-functor lbeg lend)) - (`(open ,lbeg ,lend) - (sweep-indent-line-after-open lbeg lend)) - (`(symbol ,lbeg ,lend) - (let ((sym (buffer-substring-no-properties lbeg lend))) - (cond - ((pcase (sweep-op-prefix-precedence sym) - ('nil (sweep-indent-line-after-term)) - (pre (sweep-indent-line-after-prefix lbeg lend pre))))))) - (`(operator ,lbeg ,lend) - (let ((op (buffer-substring-no-properties lbeg lend))) - (cond - ((string= op ".") 'noindent) - ((pcase (sweep-op-infix-precedence op) - ('nil nil) - (1200 (sweep-indent-line-after-neck lbeg lend)) - (pre (sweep-indent-line-after-infix lbeg lend pre)))) - ((pcase (sweep-op-prefix-precedence op) - ('nil nil) - (pre (sweep-indent-line-after-prefix lbeg lend pre))))))) - (`(,_ltyp ,_lbeg ,_lend) - (sweep-indent-line-after-term))))))) - (when (numberp indent) - (unless (= indent (current-column)) - (combine-after-change-calls - (delete-horizontal-space) - (insert (make-string indent ? ))))) - (when (> (- (point-max) pos) (point)) - (goto-char (- (point-max) pos))) - indent))) - -(defun sweep-syntax-propertize (start end) - (goto-char start) - (let ((case-fold-search nil)) - (funcall - (syntax-propertize-rules - ((rx bow (group-n 1 "0'" anychar)) - (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) - (string-to-syntax "w")))) - ((rx (group-n 1 "!")) - (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) - (string-to-syntax "w"))))) - start end))) - -(defun sweep-at-beginning-of-top-term-p () - (and (looking-at-p (rx bol graph)) - (not (nth 8 (syntax-ppss))))) - -(defun sweep-file-at-point (&optional point) - (let* ((p (or point (point))) - (beg (save-mark-and-excursion - (goto-char p) - (unless (sweep-at-beginning-of-top-term-p) - (sweep-beginning-of-top-term)) - (max (1- (point)) (point-min)))) - (end (save-mark-and-excursion - (goto-char p) - (sweep-end-of-top-term) - (point))) - (contents (buffer-substring-no-properties beg end))) - (sweep-open-query "user" - "sweep" - "sweep_file_at_point" - (list contents - (buffer-file-name) - (- p beg))) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol))))) - -(defun sweep-find-file-at-point (point) - "Find file specificed by the Prolog file spec at POINT. - -Interactively, POINT is set to the current point." - (interactive "d" sweep-mode) - (if-let ((file (sweep-file-at-point point))) - (find-file file) - (user-error "No file specification found at point!"))) - -(defun sweep-identifier-at-point (&optional point) - (let* ((p (or point (point))) - (beg (save-mark-and-excursion - (goto-char p) - (unless (sweep-at-beginning-of-top-term-p) - (sweep-beginning-of-top-term)) - (max (1- (point)) (point-min)))) - (end (save-mark-and-excursion - (goto-char p) - (sweep-end-of-top-term) - (point))) - (contents (buffer-substring-no-properties beg end))) - (sweep-open-query "user" - "sweep" - "sweep_identifier_at_point" - (list contents - (buffer-file-name) - (- p beg))) - (let ((sol (sweep-next-solution))) - (sweep-close-query) - (when (sweep-true-p sol) - (cdr sol))))) - -(defun sweep--xref-backend () - "Hook for `xref-backend-functions'." - 'sweep) - -(cl-defmethod xref-backend-identifier-at-point ((_backend (eql sweep))) - (sweep-identifier-at-point)) - -(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql sweep))) - (completion-table-with-cache #'sweep-predicates-collection)) - -(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql sweep))) - "Case is always significant for Prolog identifiers, so return nil." - nil) - -(cl-defmethod xref-backend-definitions ((_backend (eql sweep)) mfn) - (when-let ((loc (sweep-predicate-location mfn)) - (path (car loc)) - (line (or (cdr loc) 1))) - (list (xref-make (concat path ":" (number-to-string line)) (xref-make-file-location path line 0))))) - -(cl-defmethod xref-backend-references ((_backend (eql sweep)) mfn) - (let ((refs (sweep-predicate-references mfn))) - (seq-map (lambda (loc) - (let ((by (car loc)) - (path (cadr loc)) - (line (or (cddr loc) 1))) - (xref-make by (xref-make-file-location path line 0)))) - refs))) - -(cl-defmethod xref-backend-apropos ((_backend (eql sweep)) pattern) - (let ((matches (sweep-predicate-apropos pattern))) - (seq-map (lambda (match) - (let ((mfn (car match)) - (path (cadr match)) - (line (or (cddr match) 1))) - (xref-make mfn - (xref-make-file-location path line 0)))) - matches))) - -(defvar-local sweep--timer nil) -(defvar-local sweep--colourise-buffer-duration 0.2) - -;;;###autoload -(define-derived-mode sweep-mode prog-mode "sweep" - "Major mode for reading and editing Prolog code." - :group 'sweep - (setq-local comment-start "%") - (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)") - (setq-local parens-require-spaces nil) - (setq-local beginning-of-defun-function #'sweep-beginning-of-top-term) - (setq-local end-of-defun-function #'sweep-end-of-top-term) - (setq-local syntax-propertize-function #'sweep-syntax-propertize) - (setq-local indent-line-function #'sweep-indent-line) - (setq-local font-lock-defaults - '(nil - nil - nil - nil - nil - (font-lock-fontify-region-function . sweep-colourise-some-terms))) - (let ((time (current-time))) - (sweep-colourise-buffer) - (setq sweep--colourise-buffer-duration (float-time (time-since time)))) - (sweep--set-buffer-module) - (add-hook 'xref-backend-functions #'sweep--xref-backend nil t) - (add-hook 'file-name-at-point-functions #'sweep-file-at-point nil t) - (add-hook 'completion-at-point-functions #'sweep-completion-at-point-function nil t) - (when sweep-colourise-buffer-on-idle - (setq sweep--timer (run-with-idle-timer (max sweep-colourise-buffer-min-interval - (* 10 sweep--colourise-buffer-duration)) - t - (let ((buffer (current-buffer))) - (lambda () - (unless (< sweep-colourise-buffer-max-size - (buffer-size buffer)) - (sweep-colourise-buffer buffer)))))) - (add-hook 'kill-buffer-hook - (lambda () - (when (timerp sweep--timer) - (cancel-timer sweep--timer)))))) - -;;;; Testing: - -;; (add-to-list 'load-path (file-name-directory (buffer-file-name))) -;; (require 'sweep) - -(provide 'sweep) - -;;; sweep.el ends here -- 2.39.2