...and replace the `sweep-` prefix for all symbols with `sweeprolog-`.
This follows a request from RMS and Philip Kaludercic on the
emacs-devel mailing list to make the name of the Emacs package more
indicative.
/sweep.info~
/sweep.texi
/sweep.o
+/TODO.org
#+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.
+This manual describes the Emacs package =sweep= (or =sweeprolog=), which
+provides an embedded SWI-Prolog runtime inside of Emacs.
#+toc: headlines 8 insert TOC here, with eight headline levels
The different parts of =sweep= are structured as follows:
-#+CINDEX: sweep-module
+#+CINDEX: sweeprolog-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
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
+#+CINDEX: sweeprolog.el
+- =sweeprolog.el= defines an Elisp library (named simply =sweeprolog=), 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
+ which is by default arranged by =sweeprolog.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
+ =sweeprolog.el= invoke through =sweep-module= to facilitate its different
commands (see [[Finding Prolog code]]).
* Installation
:CUSTOM_ID: installation
:END:
-The dynamic Emacs module =sweep-module= and the Prolog helper library
+The dynamic Emacs module =sweeprolog-module= and the Prolog helper library
=sweep.pl= are included in the latest SWI-Prolog distribution. For
instructions on how to build and install SWI-Prolog, see
[[https://www.swi-prolog.org/build/]].
3. Load =sweep= into Emacs:
#+begin_src emacs-lisp
- (require 'sweep)
+ (require 'sweeprolog)
#+end_src
* Prolog initialization and cleanup
:CUSTOM_ID: prolog-init
:END:
-#+FINDEX: sweep-initialize
+#+FINDEX: sweeprolog-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
+the C-implemented =sweeprolog-initialize= Elisp function defined in
+=sweeprolog-module=. =sweeprolog-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=
+line arguments, where the first argument to =sweeprolog-initialize=
corresponds to =argv[0]=.
-#+VINDEX: sweep-init-args
-By default, =sweep.el= will initialize Prolog automatically when it is
+#+VINDEX: sweeprolog-init-args
+By default, =sweeprolog.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=
+case are determined by the value of the user-option =sweeprolog-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")
+ (add-to-list 'sweeprolog-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.
+#+VINDEX: sweeprolog-init-on-load
+To inhibit =sweeprolog= from initializing Prolog on load, set the user-option
+=sweeprolog-init-on-load= to nil.
-#+FINDEX: sweep-cleanup
-The embedded Prolog runtime can be reset using the =sweep-cleanup=
+#+FINDEX: sweeprolog-cleanup
+The embedded Prolog runtime can be reset using the =sweeprolog-cleanup=
function. This function cleans up the Prolog state and resources,
-afterwards =sweep-initialize= can be called to start Prolog anew.
+afterwards =sweeprolog-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
+#+FINDEX: sweeprolog-open-query
+=sweep= provides the Elisp function =sweeprolog-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
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
+The =sweeprolog-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,
and
- The name of the predicate to call.
-The fourth argument to =sweep-open-query= is converted into a Prolog
+The fourth argument to =sweeprolog-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
+#+FINDEX: sweeprolog-next-solution
+The function =sweeprolog-next-solution= can be used to examine the results of
+a query. If the query succeeded, =sweeprolog-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.
+=sweeprolog-next-solution= returns nil.
-#+FINDEX: sweep-cut-query
-#+FINDEX: sweep-close-query
+#+FINDEX: sweeprolog-cut-query
+#+FINDEX: sweeprolog-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
+opened with =sweeprolog-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
+query (i.e. after =sweeprolog-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
+either =sweeprolog-cut-query= or =sweeprolog-close-query=. Both of these functions
+close the current query, but =sweeprolog-close-query= also destroys any
Prolog bindings created by the query.
** Conversion of Elisp objects to Prolog terms
=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
+=sweeprolog-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/:
:END:
=sweep= converts Prolog terms into Elisp object to allow efficient
-processing of Prolog query results in Elisp (see =sweep-next-solution=).
+processing of Prolog query results in Elisp (see =sweeprolog-next-solution=).
- Prolog strings are converted to equivalent Elisp strings.
- Prolog integers are converted to equivalent Elisp integers.
#+name: count-list-permutations
#+begin_src emacs-lisp
- (sweep-open-query "user" "lists" "permutation" '(1 2 3 4 5))
+ (sweeprolog-open-query "user" "lists" "permutation" '(1 2 3 4 5))
(let ((num 0)
- (sol (sweep-next-solution)))
+ (sol (sweeprolog-next-solution)))
(while sol
(setq num (1+ num))
- (setq sol (sweep-next-solution)))
- (sweep-close-query)
+ (setq sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
num)
#+end_src
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
+Prolog query initiated by =sweeprolog-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
:CUSTOM_ID: editing-prolog-code
:END:
-#+CINDEX: sweep-mode
-#+FINDEX: sweep-mode
-#+VINDEX: sweep-mode
+#+CINDEX: sweeprolog-mode
+#+FINDEX: sweeprolog-mode
+#+VINDEX: sweeprolog-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:
+code, called =sweeprolog-mode=. To activate this mode in a buffer, type =M-x
+sweeprolog-mode=. To instruct Emacs to always open Prolog files in
+=sweeprolog-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))
+ (add-to-list 'auto-mode-alist '("\\.pl\\'" . sweeprolog-mode))
+ (add-to-list 'auto-mode-alist '("\\.plt\\'" . sweeprolog-mode))
#+end_src
** Indentation
#+CINDEX: indentation
-In =sweep-mode= buffers, the appropriate indentation for each line is
+In =sweeprolog-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
+#+FINDEX: sweeprolog-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
+=sweeprolog-indent-line= which takes no arguments and indents that line at
+point. =sweeprolog-mode= supports the standard Emacs interface for
+indentation by arranging for =sweeprolog-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]].
:CUSTOM_ID: indentation-rules
:END:
-Lines in =sweep-mode= buffers are indented according to the following
+Lines in =sweeprolog-mode= buffers are indented according to the following
rules:
1. If the current line starts inside a string or a multi-line comment,
).
#+end_src
-#+VINDEX: sweep-indent-offset
+#+VINDEX: sweeprolog-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
+ the user option =sweeprolog-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:
+ =sweeprolog-indent-offset= is set to the default value of four columns:
#+begin_src prolog
some_functor(arg1, arg2) :-
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=.
+ =sweeprolog-indent-offset=.
This rule yields the following layout:
#+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=.
+ starting column of the operator plus =sweeprolog-indent-offset=.
This rule yields the following layout:
:END:
#+CINDEX: fontification
-=sweep-mode= integrates with the standard Emacs =font-lock= system which
+=sweeprolog-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
+manual]]). =sweeprolog-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=,
+is performed on demand. When a buffer is first opened in =sweeprolog-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
+#+FINDEX: sweeprolog-colourise-buffer
+At any point in a =sweeprolog-mode= buffer, the command =C-c C-c= (or =M-x
+sweeprolog-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
+#+VINDEX: sweeprolog-colourise-buffer-on-idle
+#+VINDEX: sweeprolog-colourise-buffer-max-size
+#+VINDEX: sweeprolog-colourise-buffer-min-interval
+If the user option =sweeprolog-colourise-buffer-on-idle= is set to non-nil
+(as it is by default), =sweeprolog-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).
+=sweeprolog-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=.
+=sweeprolog-colourise-buffer-min-interval=.
-#+CINDEX: sweep-faces
+#+CINDEX: sweeprolog-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
- The =dark= style mimics the colors used in the SWI-Prolog built-in
editor in dark mode.
-#+VINDEX: sweep-faces-style
-To choose a style, customize the user option =sweep-faces-style= with
-=M-x customize-option RET sweep-faces-style RET=. The new style will
-apply to all new =sweep-mode= buffers. To apply the new style to an
+#+VINDEX: sweeprolog-faces-style
+To choose a style, customize the user option =sweeprolog-faces-style= with
+=M-x customize-option RET sweeprolog-faces-style RET=. The new style will
+apply to all new =sweeprolog-mode= buffers. To apply the new style to an
existing buffer, use =C-x x f= (=font-lock-update=) in that buffer.
To view and customize all of the faces defined and used in =sweep=, type
-=M-x customize-group RET sweep-faces RET=.
+=M-x customize-group RET sweeprolog-faces RET=.
** Term-based editing and motion commands
:PROPERTIES:
Emacs includes many useful features for operating on syntactic units
in source code buffer, such as marking, transposing and moving over
expressions. By default, these features are geared towards working
-with Lisp expressions, or "sexps". =sweep-mode= extends the Emacs'
+with Lisp expressions, or "sexps". =sweeprolog-mode= extends the Emacs'
notion of syntactic expressions to accommodate for Prolog terms, which
allows the standard sexp-based commands to operate on them seamlessly.
[[info:emacs#Expressions][Expressions in the Emacs manual]] covers the most important commands
that operate on sexps, and by extension on Prolog terms. Another
useful command for Prolog programmers is =M-x kill-backward-up-list=,
-bound by default to =C-M-^= in =sweep-mode= buffers. This command
+bound by default to =C-M-^= in =sweeprolog-mode= buffers. This command
replaces the parent term containing the term at point with the term
itself. To illustrate the utility of this command, consider the
following clause:
** Definitions and references
:PROPERTIES:
-:CUSTOM_ID: sweep-xref
+:CUSTOM_ID: sweeprolog-xref
:END:
#+CINDEX: xref
-=sweep-mode= integrates with the Emacs =xref= API to facilitate quick
+=sweeprolog-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
commands.
#+CINDEX: imenu
-=sweep-mode= also integrates with Emacs' =imenu=, which provides a simple
+=sweeprolog-mode= also integrates with Emacs' =imenu=, which provides a simple
facility for looking up and jumping to definitions in the current
buffer. To jump to a definition in the current buffer, type =M-x imenu=
(bound by default to =M-g i= in Emacs version 29). For information
: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
+#+FINDEX: sweeprolog-find-file-at-point
+File specifications that occur in =sweeprolog-mode= buffers can be followed
+with =C-c C-o= (or =M-x sweeprolog-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=:
: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
+#+FINDEX: sweeprolog-load-buffer
+The command =M-x sweeprolog-load-buffer= can be used to load the contents of
+a =sweeprolog-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
+top-level]]). In =sweeprolog-mode= buffers, =sweeprolog-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
+if its major mode is =sweeprolog-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
+=sweeprolog-mode= buffer, invoke =sweeprolog-load-buffer= with a prefix argument
(=C-u C-c C-l=).
More relevant information about loading code in SWI-Prolog can be
:END:
#+CINDEX: top-level
-#+FINDEX: sweep-top-level
+#+FINDEX: sweeprolog-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*=
+sweeprolog-top-level=. This command opens a buffer called =*sweeprolog-top-level*=
which hosts the live Prolog top-level.
-#+FINDEX: sweep-top-level-mode
-#+VINDEX: sweep-top-level-mode
+#+FINDEX: sweeprolog-top-level-mode
+#+VINDEX: sweeprolog-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
+=sweeprolog-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]].
: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=
+its own buffer. If a top-level buffer already exists, =sweeprolog-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.
+top-level buffers, run =sweeprolog-top-level= with a prefix argument
+(i.e. =C-u M-x sweeprolog-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=
+buffer called =*sweeprolog-top-level*= and then run =M-x sweeprolog-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*=.
+something like =*sweeprolog-top-level*<2>= and allow the new top-level to
+claim the buffer name =*sweeprolog-top-level*=.
** Top-level history
:PROPERTIES:
:CUSTOM_ID: top-level-history
:END:
-=sweep-top-level-mode= buffers provide a history of previously user
+=sweeprolog-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
+#+VINDEX: sweeprolog-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
+least =sweeprolog-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
:CUSTOM_ID: completion-in-top-level
:END:
-The =sweep-top-level-mode=, enabled in the =sweep= top-level buffer,
+The =sweeprolog-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-<TAB>=). For
:CUSTOM_ID: finding-prolog-code
:END:
-#+FINDEX: sweep-find-module
-=sweep= provides the command =M-x sweep-find-module= for
+#+FINDEX: sweeprolog-find-module
+=sweep= provides the command =M-x sweeprolog-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
+#+FINDEX: sweeprolog-find-predicate
+Along with =M-x sweeprolog-find-module=, =sweep= provides the
+command =M-x sweeprolog-find-predicate= jumping to the definition a
loaded or auto-loadable Prolog predicate.
** Prolog file specification expansion
:CUSTOM_ID: quick-command-access
:END:
-#+VINDEX: sweep-prefix-map
-=sweep= defines a keymap called =sweep-prefix-map= which provides
+#+VINDEX: sweeprolog-prefix-map
+=sweep= defines a keymap called =sweeprolog-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
+=sweeprolog-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)
+ (keymap-global-set "C-c p" sweeprolog-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=.
+=sweeprolog-top-level=.
* Examining Prolog messages
:PROPERTIES:
:END:
#+CINDEX: messages
-#+VINDEX: sweep-messages-buffer-name
+#+VINDEX: sweeprolog-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=
+instead, type =M-x customize-option RET sweeprolog-messages-buffer-name RET=
and set the option to a suitable value.
The =sweep= messages buffer uses the minor mode =compilation-minor-mode=,
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
+#+FINDEX: sweeprolog-view-messages
+=sweep= includes the command =sweeprolog-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]]).
+=sweeprolog-prefix-map= to the =e= key (see [[Quick access to sweep commands]]).
* Setting Prolog flags
:PROPERTIES:
:END:
#+CINDEX: prolog flags
-#+FINDEX: sweep-set-prolog-flag
-The command =M-x sweep-set-prolog-flag= can be used to interactively
+#+FINDEX: sweeprolog-set-prolog-flag
+The command =M-x sweeprolog-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
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=.
+with =M-x sweeprolog-set-prolog-flag RET double_quotes RET codes RET=.
Evaluating =A = "foo"= again exhibits the different interpretation:
#+begin_src prolog
:CUSTOM_ID: prolog-packages
:END:
-#+FINDEX: sweep-pack-install
-The command =M-x sweep-pack-install= can be used to install
+#+FINDEX: sweeprolog-pack-install
+The command =M-x sweeprolog-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.
+++ /dev/null
-;;; 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
{
emacs_env *env = runtime->get_environment (runtime);
- emacs_value symbol_initialize = env->intern (env, "sweep-initialize");
+ emacs_value symbol_initialize = env->intern (env, "sweeprolog-initialize");
emacs_value func_initialize =
env->make_function(env,
1, emacs_variadic_function,
emacs_value args_initialize[] = {symbol_initialize, func_initialize};
env->funcall (env, env->intern (env, "defalias"), 2, args_initialize);
- emacs_value symbol_is_initialized = env->intern (env, "sweep-initialized-p");
+ emacs_value symbol_is_initialized = env->intern (env, "sweeprolog-initialized-p");
emacs_value func_is_initialized =
env->make_function(env,
0, 0,
emacs_value args_is_initialized[] = {symbol_is_initialized, func_is_initialized};
env->funcall (env, env->intern (env, "defalias"), 2, args_is_initialized);
- emacs_value symbol_open_query = env->intern (env, "sweep-open-query");
+ emacs_value symbol_open_query = env->intern (env, "sweeprolog-open-query");
emacs_value func_open_query =
env->make_function(env,
4, 5,
ARG4 is any object that can be converted to a Prolog term, and will be passed as the first argument of the invoked predicate.\n\
The second argument of the predicate is left unbound and is assumed to treated by the invoked predicate as an output variable.\n\
If ARG5 is non-nil, reverse the order of the predicate arguments such that the first argument is the output variable and the second argument is the input term derived from ARG4.\n\
-Further instantiations of the output variable can be examined via `sweep-next-solution'.",
+Further instantiations of the output variable can be examined via `sweeprolog-next-solution'.",
NULL);
emacs_value args_open_query[] = {symbol_open_query, func_open_query};
env->funcall (env, env->intern (env, "defalias"), 2, args_open_query);
- emacs_value symbol_next_solution = env->intern (env, "sweep-next-solution");
+ emacs_value symbol_next_solution = env->intern (env, "sweeprolog-next-solution");
emacs_value func_next_solution =
env->make_function(env,
0, 0,
sweep_next_solution,
"Return the next solution from Prolog, or nil if there are none.\n\
-See also `sweep-open-query'.",
+See also `sweeprolog-open-query'.",
NULL);
emacs_value args_next_solution[] = {symbol_next_solution, func_next_solution};
env->funcall (env, env->intern (env, "defalias"), 2, args_next_solution);
- emacs_value symbol_cut_query = env->intern (env, "sweep-cut-query");
+ emacs_value symbol_cut_query = env->intern (env, "sweeprolog-cut-query");
emacs_value func_cut_query =
env->make_function(env,
0, 0,
emacs_value args_cut_query[] = {symbol_cut_query, func_cut_query};
env->funcall (env, env->intern (env, "defalias"), 2, args_cut_query);
- emacs_value symbol_close_query = env->intern (env, "sweep-close-query");
+ emacs_value symbol_close_query = env->intern (env, "sweeprolog-close-query");
emacs_value func_close_query =
env->make_function(env,
0, 0,
env->funcall (env, env->intern (env, "defalias"), 2, args_close_query);
- emacs_value symbol_cleanup = env->intern (env, "sweep-cleanup");
+ emacs_value symbol_cleanup = env->intern (env, "sweeprolog-cleanup");
emacs_value func_cleanup = env->make_function (env, 0, 0, sweep_cleanup, "Cleanup Prolog.", NULL);
emacs_value args_cleanup[] = {symbol_cleanup, func_cleanup};
env->funcall (env, env->intern (env, "defalias"), 2, args_cleanup);
+++ /dev/null
-;;; sweep.el --- Embedded SWI-Prolog -*- lexical-binding:t -*-
-
-;; Copyright (C) 2022 Eshel Yaron
-
-;; Author: Eshel Yaron <me(at)eshelyaron(dot)com>
-;; Maintainer: Eshel Yaron <me(at)eshelyaron(dot)com>
-;; Keywords: prolog languages extensions
-;; URL: https://git.sr.ht/~eshel/sweep
-;; Package-Version: 0.3.3
-;; 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
-;; <https://eshelyaron.com/sweep.html>. 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)
-
-(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 "-q"
- "--no-signals"
- "-g"
- "[library(sweep)]")
- "List of strings used as initialization arguments for Prolog."
- :package-version '((sweep "0.3.1"))
- :type '(list string)
- :group 'sweep)
-
-(defvar sweep-prolog-server-port nil)
-
-(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 ()
- (let ((sweep-module-path (car
- (save-match-data
- (split-string
- (shell-command-to-string
- (concat
- (or sweep-swipl-path (executable-find "swipl"))
- " -g"
- " write_sweep_module_location"
- " -t"
- " halt"))
- "\n")))))
- (load sweep-module-path)))
-
-(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"))
- 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)
-
-(defcustom sweep-faces-style nil
- "Style of faces to use for highlighting Prolog code."
- :type '(choice (const :tag "Default" nil)
- (const :tag "Light" light)
- (const :tag "Dark" dark))
- :package-version '((sweep . "0.3.2"))
- :group 'sweep-faces)
-
-(eval-when-compile
- (defmacro sweep-defface (name def light dark doc)
- "Define sweep face FACE with doc DOC."
- (declare
- (indent defun)
- (doc-string 4))
- (let ((func (intern (concat "sweep-" (symbol-name name) "-face")))
- (facd (intern (concat "sweep-" (symbol-name name) "-dark-face")))
- (facl (intern (concat "sweep-" (symbol-name name) "-light-face")))
- (face (intern (concat "sweep-" (symbol-name name) "-default-face"))))
- `(progn
- (defface ,facl
- '((default . ,light))
- ,(concat "Light face used to highlight " (downcase doc))
- :group 'sweep-faces)
- (defface ,facd
- '((default . ,dark))
- ,(concat "Dark face used to highlight " (downcase doc))
- :group 'sweep-faces)
- (defface ,face
- '((default . ,def))
- ,(concat "Face used to highlight " (downcase doc))
- :group 'sweep-faces)
- (defun ,func ()
- (pcase sweep-faces-style
- ('light ',facl)
- ('dark ',facd)
- (_ ',face)))))))
-
-(sweep-defface
- functor
- (:inherit font-lock-function-name-face)
- (:foreground "navyblue")
- (:foreground "darkcyan")
- "Functors.")
-
-(sweep-defface
- arity
- (:inherit font-lock-function-name-face)
- (:foreground "navyblue")
- (:foreground "darkcyan")
- "Arities.")
-
-(sweep-defface
- predicate-indicator
- (:inherit font-lock-function-name-face)
- (:foreground "navyblue")
- (:foreground "darkcyan")
- "Predicate indicators.")
-
-(sweep-defface
- built-in
- (:inherit font-lock-keyword-face)
- (:foreground "blue")
- (:foreground "cyan")
- "Built in predicate calls.")
-
-(sweep-defface
- neck
- (:inherit font-lock-preprocessor-face)
- (:weight bold)
- (:weight bold)
- "Necks.")
-
-(sweep-defface goal
- (:inherit font-lock-function-name-face)
- (:inherit font-lock-function-name-face)
- (:inherit font-lock-function-name-face)
- "Unspecified predicate goals.")
-
-(sweep-defface
- string
- (:inherit font-lock-string-face)
- (:foreground "navyblue")
- (:foreground "palegreen")
- "Strings.")
-
-(sweep-defface
- comment
- (:inherit font-lock-comment-face)
- (:foreground "darkgreen")
- (:foreground "green")
- "Comments.")
-
-(sweep-defface
- head-built-in
- (:background "orange" :weight bold)
- (:background "orange" :weight bold)
- (:background "orange" :weight bold)
- "Built-in predicate definitons.")
-
-(sweep-defface
- method
- (:weight bold)
- (:weight bold)
- (:weight bold)
- "PCE classes.")
-
-(sweep-defface
- class
- (:underline t)
- (:underline t)
- (:underline t)
- "PCE classes.")
-
-(sweep-defface
- no-file
- (:foreground "red")
- (:foreground "red")
- (:foreground "red")
- "Non-existsing file specifications.")
-
-(sweep-defface
- head-local
- (:inherit font-lock-builtin-face)
- (:weight bold)
- (:weight bold)
- "Local predicate definitions.")
-
-(sweep-defface
- head-meta
- (:inherit font-lock-preprocessor-face)
- (:inherit default)
- (:inherit default)
- "Meta predicate definitions.")
-
-(sweep-defface
- head-multifile
- (:inherit font-lock-type-face)
- (:foreground "navyblue" :weight bold)
- (:foreground "palegreen" :weight bold)
- "Multifile predicate definitions.")
-
-(sweep-defface
- head-extern
- (:inherit font-lock-type-face)
- (:foreground "blue" :weight bold)
- (:foreground "cyan" :weight bold)
- "External predicate definitions.")
-
-(sweep-defface
- head-unreferenced
- (:inherit font-lock-warning-face)
- (:foreground "red" :weight bold)
- (:foreground "red" :weight bold)
- "Unreferenced predicate definitions.")
-
-(sweep-defface
- head-exported
- (:inherit font-lock-builtin-face)
- (:foreground "blue" :weight bold)
- (:foreground "cyan" :weight bold)
- "Exported predicate definitions.")
-
-(sweep-defface
- head-hook
- (:inherit font-lock-type-face)
- (:foreground "blue" :underline t)
- (:foreground "cyan" :underline t)
- "Hook definitions.")
-
-(sweep-defface
- head-iso
- (:inherit font-lock-keyword-face)
- (:background "orange" :weight bold)
- (:background "orange" :weight bold)
- "Hook definitions.")
-
-(sweep-defface
- head-undefined
- (:inherit font-lock-warning-face)
- (:weight bold)
- (:weight bold)
- "Undefind head terms.")
-
-(sweep-defface
- head-public
- (:inherit font-lock-builtin-face)
- (:foreground "#016300" :weight bold)
- (:foreground "#016300" :weight bold)
- "Public definitions.")
-
-(sweep-defface
- meta-spec
- (:inherit font-lock-preprocessor-face)
- (:inherit font-lock-preprocessor-face)
- (:inherit font-lock-preprocessor-face)
- "Meta argument specifiers.")
-
-(sweep-defface
- recursion
- (:inherit font-lock-builtin-face)
- (:underline t)
- (:underline t)
- "Recursive calls.")
-
-(sweep-defface
- local
- (:inherit font-lock-function-name-face)
- (:foreground "navyblue")
- (:foreground "darkcyan")
- "Local predicate calls.")
-
-(sweep-defface
- autoload
- (:inherit font-lock-function-name-face)
- (:foreground "navyblue")
- (:foreground "darkcyan")
- "Autoloaded predicate calls.")
-
-(sweep-defface
- imported
- (:inherit font-lock-function-name-face)
- (:foreground "blue")
- (:foreground "cyan")
- "Imported predicate calls.")
-
-(sweep-defface
- extern
- (:inherit font-lock-function-name-face)
- (:foreground "blue" :underline t)
- (:foreground "cyan" :underline t)
- "External predicate calls.")
-
-(sweep-defface
- foreign
- (:inherit font-lock-keyword-face)
- (:foreground "darkturquoise")
- (:foreground "darkturquoise")
- "Foreign predicate calls.")
-
-(sweep-defface
- meta
- (:inherit font-lock-type-face)
- (:foreground "red4")
- (:foreground "red4")
- "Meta predicate calls.")
-
-(sweep-defface
- undefined
- (:inherit font-lock-warning-face)
- (:foreground "red")
- (:foreground "orange")
- "Undefined predicate calls.")
-
-(sweep-defface
- thread-local
- (:inherit font-lock-constant-face)
- (:foreground "magenta" :underline t)
- (:foreground "magenta" :underline t)
- "Thread local predicate calls.")
-
-(sweep-defface
- global
- (:inherit font-lock-keyword-face)
- (:foreground "magenta")
- (:foreground "darkcyan")
- "Global predicate calls.")
-
-(sweep-defface
- multifile
- (:inherit font-lock-function-name-face)
- (:foreground "navyblue")
- (:foreground "palegreen")
- "Multifile predicate calls.")
-
-(sweep-defface
- dynamic
- (:inherit font-lock-constant-face)
- (:foreground "magenta")
- (:foreground "magenta")
- "Dynamic predicate calls.")
-
-(sweep-defface
- undefined-import
- (:inherit font-lock-warning-face)
- (:foreground "red")
- (:foreground "red")
- "Undefined imports.")
-
-(sweep-defface
- html-attribute
- (:inherit font-lock-function-name-face)
- (:foreground "magenta4")
- (:foreground "magenta4")
- "HTML attributes.")
-
-(sweep-defface
- html-call
- (:inherit font-lock-keyword-face)
- (:foreground "magenta4" :weight bold)
- (:foreground "magenta4" :weight bold)
- "Multifile predicate calls.")
-
-(sweep-defface
- option-name
- (:inherit font-lock-constant-face)
- (:foreground "#3434ba")
- (:foreground "#3434ba")
- "Option names.")
-
-(sweep-defface
- no-option-name
- (:inherit font-lock-warning-face)
- (:foreground "red")
- (:foreground "orange")
- "Non-existent option names.")
-
-(sweep-defface
- flag-name
- (:inherit font-lock-constant-face)
- (:foreground "blue")
- (:foreground "cyan")
- "Flag names.")
-
-(sweep-defface
- no-flag-name
- (:inherit font-lock-warning-face)
- (:foreground "red")
- (:foreground "red")
- "Non-existent flag names.")
-
-(sweep-defface
- qq-type
- (:inherit font-lock-type-face)
- (:weight bold)
- (:weight bold)
- "Quasi-quotation types.")
-
-(sweep-defface
- qq-sep
- (:inherit font-lock-type-face)
- (:weight bold)
- (:weight bold)
- "Quasi-quotation separators.")
-
-(sweep-defface
- qq-open
- (:inherit font-lock-type-face)
- (:weight bold)
- (:weight bold)
- "Quasi-quotation open sequences.")
-
-(sweep-defface
- qq-close
- (:inherit font-lock-type-face)
- (:weight bold)
- (:weight bold)
- "Quasi-quotation close sequences.")
-
-(sweep-defface
- op-type
- (:inherit font-lock-type-face)
- (:foreground "blue")
- (:foreground "cyan")
- "Operator types.")
-
-(sweep-defface
- dict-tag
- (:inherit font-lock-constant-face)
- (:weight bold)
- (:weight bold)
- "Dict tags.")
-
-(sweep-defface
- dict-key
- (:inherit font-lock-keyword-face)
- (:weight bold)
- (:weight bold)
- "Dict keys.")
-
-(sweep-defface
- dict-sep
- (:inherit font-lock-keyword-face)
- (:weight bold)
- (:weight bold)
- "Dict separators.")
-
-(sweep-defface
- file
- (:inherit button)
- (:foreground "blue" :underline t)
- (:foreground "cyan" :underline t)
- "File specifiers.")
-
-(sweep-defface
- file-no-depend
- (:inherit font-lock-warning-face)
- (:foreground "blue" :underline t :background "pink")
- (:foreground "cyan" :underline t :background "pink")
- "Unused file specifiers.")
-
-(sweep-defface
- unused-import
- (:inherit font-lock-warning-face)
- (:foreground "blue" :background "pink")
- (:foreground "cyan" :background "pink")
- "Unused imports.")
-
-(sweep-defface
- identifier
- (:inherit font-lock-type-face)
- (:weight bold)
- (:weight bold)
- "Identifiers.")
-
-(sweep-defface
- hook
- (:inherit font-lock-preprocessor-face)
- (:foreground "blue" :underline t)
- (:foreground "cyan" :underline t)
- "Hooks.")
-
-(sweep-defface
- module
- (:inherit font-lock-type-face)
- (:foreground "darkslateblue")
- (:foreground "lightslateblue")
- "Module names.")
-
-(sweep-defface
- singleton
- (:inherit font-lock-warning-face)
- (:foreground "red4" :weight bold)
- (:foreground "orangered1" :weight bold)
- "Singletons.")
-
-(sweep-defface
- fullstop
- (:inherit font-lock-negation-char-face)
- (:inherit font-lock-negation-char-face)
- (:inherit font-lock-negation-char-face)
- "Fullstops.")
-
-(sweep-defface
- nil
- (:inherit font-lock-keyword-face)
- (:inherit font-lock-keyword-face)
- (:inherit font-lock-keyword-face)
- "The empty list.")
-
-(sweep-defface
- variable
- (:inherit font-lock-variable-name-face)
- (:foreground "red4")
- (:foreground "orangered1")
- "Variables.")
-
-(sweep-defface
- ext-quant
- (:inherit font-lock-keyword-face)
- (:inherit font-lock-keyword-face)
- (:inherit font-lock-keyword-face)
- "Existential quantifiers.")
-
-(sweep-defface
- control
- (:inherit font-lock-keyword-face)
- (:inherit font-lock-keyword-face)
- (:inherit font-lock-keyword-face)
- "Control constructs.")
-
-(sweep-defface
- atom
- (:inherit font-lock-constant-face)
- (:inherit font-lock-constant-face)
- (:inherit font-lock-constant-face)
- "Atoms.")
-
-(sweep-defface
- int
- (:inherit font-lock-constant-face)
- (:inherit font-lock-constant-face)
- (:inherit font-lock-constant-face)
- "Integers.")
-
-(sweep-defface
- float
- (:inherit font-lock-constant-face)
- (:inherit font-lock-constant-face)
- (:inherit font-lock-constant-face)
- "Floats.")
-
-(sweep-defface
- codes
- (:inherit font-lock-constant-face)
- (:inherit font-lock-constant-face)
- (:inherit font-lock-constant-face)
- "Codes.")
-
-(sweep-defface
- error
- (:inherit font-lock-warning-face)
- (:background "orange")
- (:background "orange")
- "Unspecified errors.")
-
-(sweep-defface
- type-error
- (:inherit font-lock-warning-face)
- (:background "orange")
- (:background "orange")
- "Type errors.")
-
-(sweep-defface
- instantiation-error
- (:inherit font-lock-warning-face)
- (:background "orange")
- (:background "orange")
- "Instantiation errors.")
-
-(sweep-defface
- syntax-error
- (:inherit error)
- (:background "orange")
- (:background "orange")
- "Syntax errors.")
-
-(sweep-defface
- around-syntax-error
- (:inherit default)
- (:inherit default)
- (:inherit default)
- "Text around a syntax error.")
-
-(sweep-defface
- clause
- (:inherit default)
- (:inherit default)
- (:inherit default)
- "Predicate clauses.")
-
-(sweep-defface
- grammar-rule
- (:inherit default)
- (:inherit default)
- (:inherit default)
- "DCG grammar rules.")
-
-(sweep-defface
- term
- (:inherit default)
- (:inherit default)
- (:inherit default)
- "Top terms.")
-
-(sweep-defface
- directive
- (:inherit default)
- (:inherit default)
- (:inherit default)
- "Directives.")
-
-(sweep-defface
- structured-comment
- (:inherit font-lock-doc-face)
- (:inherit font-lock-doc-face :foreground "darkgreen")
- (:inherit font-lock-doc-face :foreground "green")
- "Structured comments.")
-
-(defun sweep--colour-term-to-face (arg)
- (pcase arg
- (`("comment" . "structured") (sweep-structured-comment-face))
- (`("comment" . ,_) (sweep-comment-face))
- (`("head" "unreferenced" . ,_) (sweep-head-unreferenced-face))
- (`("head" "meta" . ,_) (sweep-head-meta-face))
- (`("head" "exported" . ,_) (sweep-head-exported-face))
- (`("head" "hook" . ,_) (sweep-head-hook-face))
- (`("head" "built_in" . ,_) (sweep-head-built-in-face))
- (`("head" ,(rx "extern(") . ,_) (sweep-head-extern-face))
- (`("head" ,(rx "public(") . ,_) (sweep-head-public-face))
- (`("head" ,(rx "local(") . ,_) (sweep-head-local-face))
- (`("goal" "recursion" . ,_) (sweep-recursion-face))
- (`("goal" "meta" . ,_) (sweep-meta-face))
- (`("goal" "built_in" . ,_) (sweep-built-in-face))
- (`("goal" "undefined" . ,_) (sweep-undefined-face))
- (`("goal" "global" . ,_) (sweep-global-face))
- (`("goal",(rx "dynamic ") . ,_) (sweep-dynamic-face))
- (`("goal",(rx "multifile ") . ,_) (sweep-multifile-face))
- (`("goal",(rx "thread_local ") . ,_) (sweep-thread-local-face))
- (`("goal",(rx "extern(") . ,_) (sweep-extern-face))
- (`("goal",(rx "autoload(") . ,_) (sweep-autoload-face))
- (`("goal",(rx "imported(") . ,_) (sweep-imported-face))
- (`("goal",(rx "global(") . ,_) (sweep-global-face))
- (`("goal",(rx "local(") . ,_) (sweep-local-face))
- (`("syntax_error" ,_message ,eb ,ee)
- (with-silent-modifications
- (put-text-property eb ee 'font-lock-face
- (sweep-around-syntax-error-face)))
- (sweep-syntax-error-face))
- ("unused_import" (sweep-unused-import-face))
- ("undefined_import" (sweep-undefined-import-face))
- ("html_attribute" (sweep-html-attribute-face))
- ("html_call" (sweep-html-call-face))
- ("dict_tag" (sweep-dict-tag-face))
- ("dict_key" (sweep-dict-key-face))
- ("dict_sep" (sweep-dict-sep-face))
- ("meta" (sweep-meta-spec-face))
- ("flag_name" (sweep-flag-name-face))
- ("no_flag_name" (sweep-flag-name-face))
- ("ext_quant" (sweep-ext-quant-face))
- ("atom" (sweep-atom-face))
- ("float" (sweep-float-face))
- ("int" (sweep-int-face))
- ("singleton" (sweep-singleton-face))
- ("option_name" (sweep-option-name-face))
- ("no_option_name" (sweep-no-option-name-face))
- ("control" (sweep-control-face))
- ("var" (sweep-variable-face))
- ("fullstop" (sweep-fullstop-face))
- ("functor" (sweep-functor-face))
- ("arity" (sweep-arity-face))
- ("predicate_indicator" (sweep-predicate-indicator-face))
- ("string" (sweep-string-face))
- ("module" (sweep-module-face))
- ("neck" (sweep-neck-face))
- ("hook" (sweep-hook-face))
- ("qq_type" (sweep-qq-type-face))
- ("qq_sep" (sweep-qq-sep-face))
- ("qq_open" (sweep-qq-open-face))
- ("qq_close" (sweep-qq-close-face))
- ("identifier" (sweep-identifier-face))
- ("file" (sweep-file-face))
- ("file_no_depend" (sweep-file-no-depend-face))
- ("nofile" (sweep-no-file-face))
- ("op_type" (sweep-op-type-face))
- ("directive" (sweep-directive-face))
- ("clause" (sweep-clause-face))
- ("term" (sweep-term-face))
- ("grammar_rule" (sweep-grammar-rule-face))
- ("method" (sweep-method-face))
- ("class" (sweep-class-face))))
-
-(defun sweep--colourise (args)
- "ARGS is a list of the form (BEG LEN . SEM)."
- (when-let ((beg (max (point-min) (car args)))
- (end (min (point-max) (+ beg (cadr args))))
- (arg (cddr args))
- (flf (sweep--colour-term-to-face arg)))
- (with-silent-modifications
- (put-text-property beg end 'font-lock-face flf))))
-
-(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)
- (define-key map (kbd "C-M-^") #'kill-backward-up-list)
- 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-next-token-boundaries (&optional pos)
- (let ((point (or pos (point))))
- (save-excursion
- (goto-char point)
- (while (forward-comment 1))
- (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--forward-term (pre)
- (pcase (sweep-next-token-boundaries)
- ('nil
- (signal 'scan-error
- (list "Cannot scan beyond end of buffer."
- (point-max)
- (point-max))))
- (`(close ,lbeg ,lend)
- (signal 'scan-error
- (list "Cannot scan beyond closing parenthesis or bracket."
- lbeg
- lend)))
- (`(open ,obeg ,_)
- (goto-char obeg)
- (goto-char (scan-lists (point) 1 0))
- (sweep--forward-term pre))
- (`(functor ,_ ,oend)
- (goto-char (1- oend))
- (goto-char (scan-lists (point) 1 0))
- (sweep--forward-term pre))
- (`(operator ,obeg ,oend)
- (if (and (string= "." (buffer-substring-no-properties obeg oend))
- (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
- (signal 'scan-error
- (list "Cannot scan beyond fullstop."
- obeg
- (1+ obeg)))
- (if-let ((opre (sweep-op-infix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan beyond infix operator of higher precedence %s." opre)
- obeg
- oend))
- (goto-char oend)
- (sweep--forward-term pre))
- (if-let ((ppre (sweep-op-suffix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan beyond suffix operator of higher precedence %s." opre)
- obeg
- oend))
- (goto-char oend)
- (sweep--forward-term pre))
- (goto-char oend)
- (sweep--forward-term pre)))))
- (`(symbol ,obeg ,oend)
- (if-let ((opre (sweep-op-infix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan backwards infix operator of higher precedence %s." opre)
- obeg
- oend))
- (goto-char oend)
- (sweep--forward-term pre))
- (if-let ((ppre (sweep-op-prefix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
- obeg
- oend))
- (goto-char oend)
- (sweep--forward-term pre))
- (goto-char oend)
- (sweep--forward-term pre))))
- (`(,_ ,_ ,oend)
- (goto-char oend)
- (sweep--forward-term pre))))
-
-(defun sweep-forward-term (pre)
- (condition-case _
- (sweep--forward-term pre)
- (scan-error nil)))
-
-(defun sweep--backward-term (pre)
- (pcase (sweep-last-token-boundaries)
- ('nil
- (signal 'scan-error
- (list "Cannot scan backwards beyond beginning of buffer."
- (point-min)
- (point-min))))
- (`(open ,obeg ,oend)
- (signal 'scan-error
- (list "Cannot scan backwards beyond opening parenthesis or bracket."
- obeg
- oend)))
- (`(functor ,obeg ,oend)
- (signal 'scan-error
- (list "Cannot scan backwards beyond functor."
- obeg
- oend)))
- (`(operator ,obeg ,oend)
- (if (and (string= "." (buffer-substring-no-properties obeg oend))
- (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
- (signal 'scan-error
- (list "Cannot scan backwards beyond fullstop."
- obeg
- (1+ obeg)))
- (if-let ((opre (sweep-op-infix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan backwards beyond infix operator of higher precedence %s." opre)
- obeg
- oend))
- (goto-char obeg)
- (sweep--backward-term pre))
- (if-let ((ppre (sweep-op-prefix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
- obeg
- oend))
- (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))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan backwards beyond infix operator of higher precedence %s." opre)
- obeg
- oend))
- (goto-char obeg)
- (sweep--backward-term pre))
- (if-let ((ppre (sweep-op-prefix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
- obeg
- oend))
- (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-backward-term (pre)
- (condition-case _
- (sweep--backward-term pre)
- (scan-error nil)))
-
-(defvar-local sweep--forward-sexp-first-call t)
-
-(defun sweep--backward-sexp ()
- (let ((point (point))
- (prec (pcase (sweep-last-token-boundaries)
- (`(operator ,obeg ,oend)
- (unless (and nil
- (string= "." (buffer-substring-no-properties obeg oend))
- (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
- (if-let ((pprec
- (sweep-op-infix-precedence
- (buffer-substring-no-properties obeg oend))))
- (progn (goto-char obeg) (1- pprec))
- 0)))
- (_ 0))))
- (condition-case error
- (sweep--backward-term prec)
- (scan-error (when (= point (point))
- (signal 'scan-error (cdr error)))))))
-
-(defun sweep--forward-sexp ()
- (let ((point (point))
- (prec (pcase (sweep-next-token-boundaries)
- (`(operator ,obeg ,oend)
- (unless (and nil
- (string= "." (buffer-substring-no-properties obeg oend))
- (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
- (if-let ((pprec
- (sweep-op-infix-precedence
- (buffer-substring-no-properties obeg oend))))
- (progn (goto-char oend) (1- pprec))
- 0)))
- (_ 0))))
- (condition-case error
- (sweep--forward-term prec)
- (scan-error (when (= point (point))
- (signal 'scan-error (cdr error)))))))
-
-(defun sweep-forward-sexp-function (arg)
- (let* ((times (abs arg))
- (func (or (and (not (= arg 0))
- (< 0 (/ times arg))
- #'sweep--forward-sexp)
- #'sweep--backward-sexp)))
- (while (< 0 times)
- (funcall func)
- (setq times (1- times)))))
-
-(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 (not (eobp))
- (= (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)))
-
-(defun sweep-create-index-function ()
- (sweep-open-query "user"
- "sweep"
- "sweep_imenu_index"
- (buffer-file-name))
- (let ((sol (sweep-next-solution)))
- (sweep-close-query)
- (when (sweep-true-p sol)
- (seq-map (lambda (entry)
- (let ((car (car entry))
- (line (cdr entry)))
- (goto-char (point-min))
- (forward-line (1- line))
- (cons car (line-beginning-position))))
- (cdr sol)))))
-
-(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 imenu-create-index-function #'sweep-create-index-function)
- (setq-local beginning-of-defun-function #'sweep-beginning-of-top-term)
- (setq-local end-of-defun-function #'sweep-end-of-top-term)
- (setq-local forward-sexp-function #'sweep-forward-sexp-function)
- (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
sweep_handle_color(1)),
forall(sweep_current_comment(Kind, Start, Len),
( atom_string(Kind, String),
- user:sweep_funcall("sweep--colourise", [Start,Len,"comment"|String], _)
+ user:sweep_funcall("sweeprolog--colourise", [Start,Len,"comment"|String], _)
)),
erase(Ref0),
erase(Ref1).
[operators(Ops)]),
forall(sweep_current_comment(Kind, Start, Len),
( atom_string(Kind, String),
- user:sweep_funcall("sweep--colourise", [Start,Len,"comment"|String], _)
+ user:sweep_funcall("sweeprolog--colourise", [Start,Len,"comment"|String], _)
)).
sweep_documentation([Path, Functor, Arity], Docs) :-
sweep_handle_query_color(Offset, Col, Beg, Len) :-
sweep_color_normalized(Offset, Col, Nom),
Start is Beg + Offset,
- user:sweep_funcall("sweep--colourise", [Start,Len|Nom], _).
+ user:sweep_funcall("sweeprolog--colourise", [Start,Len|Nom], _).
sweep_color_normalized(Offset, Col, Nom) :-
Col =.. [Nom0|Rest],
retractall(user:thread_message_hook(_, _, _)),
asserta((
user:thread_message_hook(Term, Kind, Lines) :-
- sweep_message_hook(Term, Kind, Lines)
+ sweep_message_hook(Term, Kind, Lines)
)).
sweep_message_hook(Term, Kind0, _Lines) :-
should_handle_message_kind(Kind0, Kind),
!,
message_to_string(Term, String),
- user:sweep_funcall("sweep-message", [Kind|String], _).
+ user:sweep_funcall("sweeprolog-message", [Kind|String], _).
should_handle_message_kind(error, "error").
should_handle_message_kind(warning, "warning").
--- /dev/null
+;;; sweeprolog-tests.el --- ERT suite for sweep -*- lexical-binding:t -*-
+
+(require 'sweeprolog)
+
+(ert-deftest lists:member/2 ()
+ "Tests calling the Prolog predicate permutation/2 from Elisp."
+ (should (equal (sweeprolog-open-query "user" "lists" "member" (list 1 2 3) t) t))
+ (should (equal (sweeprolog-next-solution) (cons t 1)))
+ (should (equal (sweeprolog-next-solution) (cons t 2)))
+ (should (equal (sweeprolog-next-solution) (cons '! 3)))
+ (should (equal (sweeprolog-cut-query) t)))
+
+(ert-deftest lists:permutation/2 ()
+ "Tests calling the Prolog predicate permutation/2 from Elisp."
+ (should (equal (sweeprolog-open-query "user" "lists" "permutation" (list 1 2 3)) t))
+ (should (equal (sweeprolog-next-solution) (list t 1 2 3)))
+ (should (equal (sweeprolog-next-solution) (list t 1 3 2)))
+ (should (equal (sweeprolog-next-solution) (list t 2 1 3)))
+ (should (equal (sweeprolog-next-solution) (list t 2 3 1)))
+ (should (equal (sweeprolog-next-solution) (list t 3 1 2)))
+ (should (equal (sweeprolog-next-solution) (list t 3 2 1)))
+ (should (equal (sweeprolog-next-solution) nil))
+ (should (equal (sweeprolog-cut-query) t)))
+
+(ert-deftest system:=/2 ()
+ "Tests unifying Prolog terms with =/2 from Elisp."
+ (should (equal (sweeprolog-open-query "user" "system" "=" (list 1 nil (list "foo" "bar") 3.14)) t))
+ (should (equal (sweeprolog-next-solution) (list '! 1 nil (list "foo" "bar") 3.14)))
+ (should (equal (sweeprolog-next-solution) nil))
+ (should (equal (sweeprolog-cut-query) t)))
+
+
+(defun sweeprolog-test-indentation (given expected)
+ (with-temp-buffer
+ (sweeprolog-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."
+ (sweeprolog-test-indentation
+ "
+some_functor(
+arg1,
+arg2,
+)."
+ "
+some_functor(
+ arg1,
+ arg2,
+)."
+ )
+ (sweeprolog-test-indentation
+ "
+asserta( some_functor(arg1, arg2) :-
+body_term
+).
+"
+ "
+asserta( some_functor(arg1, arg2) :-
+ body_term
+ ).
+"
+ )
+ (sweeprolog-test-indentation
+ "
+:- module(spam, [ foo,
+bar,
+baz
+]
+).
+"
+ "
+:- module(spam, [ foo,
+ bar,
+ baz
+ ]
+ ).
+"
+ )
+ (sweeprolog-test-indentation
+ "
+:- module(spam, [
+foo,
+bar,
+baz
+]
+).
+"
+ "
+:- module(spam, [
+ foo,
+ bar,
+ baz
+ ]
+ ).
+"
+ )
+ (sweeprolog-test-indentation
+ "
+[
+ ].
+"
+ "
+[
+].
+"
+ )
+ (sweeprolog-test-indentation
+ "
+:-
+use_module(foo),
+use_module(bar).
+"
+ "
+:-
+ use_module(foo),
+ use_module(bar).
+"
+ )
+ (sweeprolog-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)
+ ).
+")
+ (sweeprolog-test-indentation
+ "
+A is 1 * 2 + 3 *
+4.
+"
+ "
+A is 1 * 2 + 3 *
+ 4.
+")
+ (sweeprolog-test-indentation
+ "
+A is 1 * 2 ^ 3 *
+4.
+"
+ "
+A is 1 * 2 ^ 3 *
+ 4.
+")
+ (sweeprolog-test-indentation
+ "
+( if
+ -> ( iff1, iff2, iff3,
+iff4
+-> thenn
+; elsee
+)
+ ; else
+ )
+"
+ "
+( if
+-> ( iff1, iff2, iff3,
+ iff4
+ -> thenn
+ ; elsee
+ )
+; else
+)
+")
+ (sweeprolog-test-indentation
+ "
+( if
+ -> ( iff
+-> thenn
+; elsee
+)
+ ; else
+ )
+"
+ "
+( if
+-> ( iff
+ -> thenn
+ ; elsee
+ )
+; else
+)
+")
+ (sweeprolog-test-indentation
+ "
+( if
+ ; then
+ -> else
+ )
+"
+ "
+( if
+; then
+-> else
+)
+")
+ (sweeprolog-test-indentation
+ "
+asserta( foo(bar, baz) :-
+true).
+"
+ "
+asserta( foo(bar, baz) :-
+ true).
+")
+ (sweeprolog-test-indentation
+ "
+foo(bar, baz) :-
+true.
+"
+ "
+foo(bar, baz) :-
+ true.
+")
+
+ (sweeprolog-test-indentation
+ "
+:- multifile
+foo/2.
+"
+ "
+:- multifile
+ foo/2.
+")
+
+ (sweeprolog-test-indentation
+ "
+ %%%%
+ %%%%
+"
+ "
+ %%%%
+ %%%%
+")
+
+ (sweeprolog-test-indentation
+ "
+(
+foo"
+ "
+(
+ foo")
+ (sweeprolog-test-indentation
+ "
+functor(
+foo"
+ "
+functor(
+ foo")
+ )
+
+;;; sweeprolog-tests.el ends here
--- /dev/null
+;;; sweeprolog.el --- Embedded SWI-Prolog -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Eshel Yaron
+
+;; Author: Eshel Yaron <me(at)eshelyaron(dot)com>
+;; Maintainer: Eshel Yaron <me(at)eshelyaron(dot)com>
+;; Keywords: prolog languages extensions
+;; URL: https://git.sr.ht/~eshel/sweep
+;; Package-Version: 0.4.0
+;; 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
+;; <https://eshelyaron.com/sweep.html>. The manual can also be read
+;; locally by evaluating (info "(sweep) Top")
+
+;;; Code:
+
+(require 'comint)
+(require 'xref)
+
+(defgroup sweeprolog nil
+ "SWI-Prolog Embedded in Emacs."
+ :group 'prolog)
+
+(defcustom sweeprolog-indent-offset 4
+ "Number of columns to indent lines with in `sweeprolog-mode' buffers."
+ :package-version '((sweeprolog . "0.3.1"))
+ :type 'integer
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-colourise-buffer-on-idle t
+ "If non-nil, update highlighting of `sweeprolog-mode' buffers on idle."
+ :package-version '((sweeprolog . "0.2.0"))
+ :type 'boolean
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-colourise-buffer-max-size 100000
+ "Maximum buffer size to recolourise on idle."
+ :package-version '((sweeprolog . "0.2.0"))
+ :type 'integer
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-colourise-buffer-min-interval 2
+ "Minimum idle time to wait before recolourising the buffer."
+ :package-version '((sweeprolog . "0.2.0"))
+ :type 'float
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-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 '((sweeprolog . "0.1.1"))
+ :type 'string
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-messages-buffer-name "*sweep Messages*"
+ "The name of the buffer to use for logging Prolog messages."
+ :package-version '((sweeprolog . "0.1.1"))
+ :type 'string
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-read-flag-prompt "Flag: "
+ "Prompt used for reading a Prolog flag name from the minibuffer."
+ :package-version '((sweeprolog . "0.1.2"))
+ :type 'string
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-read-module-prompt "Module: "
+ "Prompt used for reading a Prolog module name from the minibuffer."
+ :package-version '((sweeprolog . "0.1.0"))
+ :type 'string
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-read-predicate-prompt "Predicate: "
+ "Prompt used for reading a Prolog precicate name from the minibuffer."
+ :package-version '((sweeprolog . "0.1.0"))
+ :type 'string
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-read-pack-prompt "Pack: "
+ "Prompt used for reading a Prolog pack name from the minibuffer."
+ :package-version '((sweeprolog . "0.1.0"))
+ :type 'string
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-top-level-display-action nil
+ "Display action used for displaying the `sweeprolog-top-level' buffer."
+ :package-version '((sweeprolog . "0.1.0"))
+ :type 'function
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-top-level-min-history-length 3
+ "Minimum input length to record in the `sweeprolog-top-level' history.
+
+Inputs shorther than the value of this variable will not be
+inserted to the input history in `sweeprolog-top-level-mode' buffers."
+ :package-version '((sweeprolog . "0.2.1"))
+ :type 'string
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-init-on-load t
+ "If non-nil, initialize Prolog when `sweeprolog' is loaded."
+ :package-version '((sweeprolog "0.1.0"))
+ :type 'boolean
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-init-args (list "-q"
+ "--no-signals"
+ "-g"
+ "[library(sweep)]")
+ "List of strings used as initialization arguments for Prolog."
+ :package-version '((sweeprolog "0.3.1"))
+ :type '(repeat string)
+ :group 'sweeprolog)
+
+(defvar sweeprolog-prolog-server-port nil)
+
+(declare-function sweeprolog-initialize "sweep-module")
+(declare-function sweeprolog-initialized-p "sweep-module")
+(declare-function sweeprolog-open-query "sweep-module")
+(declare-function sweeprolog-next-solution "sweep-module")
+(declare-function sweeprolog-cut-query "sweep-module")
+(declare-function sweeprolog-close-query "sweep-module")
+(declare-function sweeprolog-cleanup "sweep-module")
+
+(defun sweeprolog--ensure-module ()
+ (let ((sweep-module-path (car
+ (save-match-data
+ (split-string
+ (shell-command-to-string
+ (concat
+ (or sweeprolog-swipl-path (executable-find "swipl"))
+ " -g"
+ " write_sweep_module_location"
+ " -t"
+ " halt"))
+ "\n")))))
+ (load sweep-module-path)))
+
+(defface sweeprolog-debug-prefix-face
+ '((default :inherit shadow))
+ "Face used to highlight the \"DEBUG\" message prefix."
+ :group 'sweeprolog-faces)
+
+(defvar sweeprolog-debug-prefix-face 'sweeprolog-debug-prefix-face
+ "Name of the face used to highlight the \"DEBUG\" message prefix.")
+
+(defface sweeprolog-debug-topic-face
+ '((default :inherit shadow))
+ "Face used to highlight the topic in debug messages."
+ :group 'sweeprolog-faces)
+
+(defvar sweeprolog-debug-topic-face 'sweeprolog-debug-topic-face
+ "Name of the face used to highlight the topic in debug messages.")
+
+(defface sweeprolog-info-prefix-face
+ '((default :inherit default))
+ "Face used to highlight the \"INFO\" message prefix."
+ :group 'sweeprolog-faces)
+
+(defvar sweeprolog-info-prefix-face 'sweeprolog-info-prefix-face
+ "Name of the face used to highlight the \"INFO\" message prefix.")
+
+(defface sweeprolog-warning-prefix-face
+ '((default :inherit font-lock-warning-face))
+ "Face used to highlight the \"WARNING\" message prefix."
+ :group 'sweeprolog-faces)
+
+(defvar sweeprolog-warning-prefix-face 'sweeprolog-warning-prefix-face
+ "Name of the face used to highlight the \"WARNING\" message prefix.")
+
+(defface sweeprolog-error-prefix-face
+ '((default :inherit error))
+ "Face used to highlight the \"ERROR\" message prefix."
+ :group 'sweeprolog-faces)
+
+(defvar sweeprolog-error-prefix-face 'sweeprolog-error-prefix-face
+ "Name of the face used to highlight the \"ERROR\" message prefix.")
+
+(defun sweeprolog-view-messages ()
+ "View the log of recent Prolog messages."
+ (interactive)
+ (with-current-buffer (get-buffer-create sweeprolog-messages-buffer-name)
+ (goto-char (point-max))
+ (let ((win (display-buffer (current-buffer))))
+ (set-window-point win (point))
+ win)))
+
+(defun sweeprolog-current-prolog-flags (&optional prefix)
+ (sweeprolog-open-query "user" "sweep" "sweep_current_prolog_flags" (or prefix ""))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-read-prolog-flag ()
+ "Read a Prolog flag from the minibuffer, with completion."
+ (let* ((col (sweeprolog-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 sweeprolog-read-flag-prompt col)))
+
+(defun sweeprolog-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 (sweeprolog-read-prolog-flag)))
+ (list f (read-string (concat "Set " f " to: ")))))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_set_prolog_flag"
+ (cons flag value))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (if (sweeprolog-true-p sol)
+ (message "Prolog flag %s set to %s" flag value)
+ (user-error "Setting %s to %s failed!" flag value))))
+
+(defun sweeprolog-setup-message-hook ()
+ (with-current-buffer (get-buffer-create sweeprolog-messages-buffer-name)
+ (setq-local window-point-insertion-type t)
+ (compilation-minor-mode 1))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_setup_message_hook"
+ nil)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ sol))
+
+(defun sweeprolog-message (message)
+ (with-current-buffer (get-buffer-create sweeprolog-messages-buffer-name)
+ (save-excursion
+ (goto-char (point-max))
+ (let ((kind (car message))
+ (content (cdr message)))
+ (pcase kind
+ (`("debug" . ,topic)
+ (insert (propertize "DEBUG" 'face sweeprolog-debug-prefix-face))
+ (insert "[")
+ (insert (propertize topic 'face sweeprolog-debug-topic-face))
+ (insert "]: ")
+ (insert content))
+ ("informational"
+ (insert (propertize "INFO" 'face sweeprolog-info-prefix-face))
+ (insert ": ")
+ (insert content))
+ ("warning"
+ (insert (propertize "WARNING" 'face sweeprolog-warning-prefix-face))
+ (insert ": ")
+ (insert content))
+ ("error"
+ (insert (propertize "ERROR" 'face sweeprolog-error-prefix-face))
+ (insert ": ")
+ (insert content))))
+ (newline))))
+
+(defun sweeprolog-start-prolog-server ()
+ (sweeprolog-open-query "user"
+ "prolog_server"
+ "prolog_server"
+ nil t)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (setq sweeprolog-prolog-server-port (cdr sol)))))
+
+(defun sweeprolog-init ()
+ (apply #'sweeprolog-initialize
+ (cons (or sweeprolog-swipl-path (executable-find "swipl"))
+ sweeprolog-init-args))
+ (sweeprolog-setup-message-hook)
+ (sweeprolog-start-prolog-server))
+
+(defvar sweeprolog-predicate-completion-collection nil)
+
+(defvar-local sweeprolog-buffer-module "user")
+
+(defun sweeprolog-local-predicates-collection (&optional prefix)
+ (sweeprolog-open-query "user" "sweep" "sweep_local_predicate_completion"
+ (cons sweeprolog-buffer-module
+ prefix))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (setq sweeprolog-predicate-completion-collection (cdr sol)))))
+
+(defun sweeprolog-predicates-collection (&optional prefix)
+ (sweeprolog-open-query "user" "sweep" "sweep_predicates_collection" prefix)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-predicate-references (mfn)
+ (sweeprolog-open-query "user" "sweep" "sweep_predicate_references" mfn)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-predicate-location (mfn)
+ (sweeprolog-open-query "user" "sweep" "sweep_predicate_location" mfn)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-predicate-apropos (pattern)
+ (sweeprolog-open-query "user" "sweep" "sweep_predicate_apropos" pattern)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-read-predicate ()
+ "Read a Prolog predicate (M:F/N) from the minibuffer, with completion."
+ (let* ((col (sweeprolog-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 sweeprolog-read-predicate-prompt col)))
+
+(defun sweeprolog-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 sweeprolog-prefix-operators (&optional file)
+ (sweeprolog-open-query "user"
+ "sweep" "sweep_prefix_ops"
+ (or file (buffer-file-name)))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-completion-at-point-function ()
+ (when-let ((bounds (sweeprolog-predicate-prefix-boundaries)))
+ (let ((start (car bounds))
+ (end (cdr bounds)))
+ (list start end
+ (completion-table-with-cache #'sweeprolog-local-predicates-collection)
+ :exclusive 'no
+ :annotation-function
+ (lambda (key)
+ (when-let ((ann (cdr (assoc-string key sweeprolog-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
+ sweeprolog-predicate-completion-collection)))))
+ (insert "(")
+ (dotimes (_ (1- arity))
+ (insert "_, "))
+ (insert "_)")
+ (goto-char (1- opoint))))))))))))))
+
+;;;###autoload
+(defun sweeprolog-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 (sweeprolog-read-predicate)))
+ (if-let ((loc (sweeprolog-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 sweeprolog-modules-collection ()
+ (sweeprolog-open-query "user" "sweep" "sweep_modules_collection" nil)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-module-path (mod)
+ (sweeprolog-open-query "user" "sweep" "sweep_module_path" mod)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-read-module-name ()
+ "Read a Prolog module name from the minibuffer, with completion."
+ (let* ((col (sweeprolog-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 sweeprolog-read-module-prompt col)))
+
+
+(defun sweeprolog--set-buffer-module ()
+ (sweeprolog-open-query "user" "sweep" "sweep_path_module" (buffer-file-name))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (setq sweeprolog-buffer-module (cdr sol)))))
+
+;;;###autoload
+(defun sweeprolog-find-module (mod)
+ "Jump to the source file of the Prolog module MOD."
+ (interactive (list (sweeprolog-read-module-name)))
+ (find-file (sweeprolog-module-path mod)))
+
+(defun sweeprolog-packs-collection ()
+ (sweeprolog-open-query "user" "sweep" "sweep_packs_collection" "")
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol))))
+
+(defun sweeprolog-read-pack-name ()
+ "Read a Prolog pack name from the minibuffer, with completion."
+ (let* ((col (sweeprolog-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 sweeprolog-read-pack-prompt col)))
+
+(defun sweeprolog-true-p (sol)
+ (or (eq (car sol) '!)
+ (eq (car sol) t)))
+
+;;;###autoload
+(defun sweeprolog-pack-install (pack)
+ "Install or upgrade Prolog package PACK."
+ (interactive (list (sweeprolog-read-pack-name)))
+ (sweeprolog-open-query "user" "sweep" "sweep_pack_install" pack)
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (if (sweeprolog-true-p sol)
+ (message "Package install successful.")
+ (user-error "Pacakge installation failed!"))))
+
+
+(defgroup sweeprolog-faces nil
+ "Faces used to highlight Prolog code."
+ :group 'sweeprolog)
+
+(defcustom sweeprolog-faces-style nil
+ "Style of faces to use for highlighting Prolog code."
+ :type '(choice (const :tag "Default" nil)
+ (const :tag "Light" light)
+ (const :tag "Dark" dark))
+ :package-version '((sweeprolog . "0.3.2"))
+ :group 'sweeprolog-faces)
+
+(eval-when-compile
+ (defmacro sweeprolog-defface (name def light dark doc)
+ "Define sweeprolog face FACE with doc DOC."
+ (declare
+ (indent defun)
+ (doc-string 4))
+ (let ((func (intern (concat "sweeprolog-" (symbol-name name) "-face")))
+ (facd (intern (concat "sweeprolog-" (symbol-name name) "-dark-face")))
+ (facl (intern (concat "sweeprolog-" (symbol-name name) "-light-face")))
+ (face (intern (concat "sweeprolog-" (symbol-name name) "-default-face"))))
+ `(progn
+ (defface ,facl
+ '((default . ,light))
+ ,(concat "Light face used to highlight " (downcase doc))
+ :group 'sweeprolog-faces)
+ (defface ,facd
+ '((default . ,dark))
+ ,(concat "Dark face used to highlight " (downcase doc))
+ :group 'sweeprolog-faces)
+ (defface ,face
+ '((default . ,def))
+ ,(concat "Face used to highlight " (downcase doc))
+ :group 'sweeprolog-faces)
+ (defun ,func ()
+ (pcase sweeprolog-faces-style
+ ('light ',facl)
+ ('dark ',facd)
+ (_ ',face)))))))
+
+(sweeprolog-defface
+ functor
+ (:inherit font-lock-function-name-face)
+ (:foreground "navyblue")
+ (:foreground "darkcyan")
+ "Functors.")
+
+(sweeprolog-defface
+ arity
+ (:inherit font-lock-function-name-face)
+ (:foreground "navyblue")
+ (:foreground "darkcyan")
+ "Arities.")
+
+(sweeprolog-defface
+ predicate-indicator
+ (:inherit font-lock-function-name-face)
+ (:foreground "navyblue")
+ (:foreground "darkcyan")
+ "Predicate indicators.")
+
+(sweeprolog-defface
+ built-in
+ (:inherit font-lock-keyword-face)
+ (:foreground "blue")
+ (:foreground "cyan")
+ "Built in predicate calls.")
+
+(sweeprolog-defface
+ neck
+ (:inherit font-lock-preprocessor-face)
+ (:weight bold)
+ (:weight bold)
+ "Necks.")
+
+(sweeprolog-defface goal
+ (:inherit font-lock-function-name-face)
+ (:inherit font-lock-function-name-face)
+ (:inherit font-lock-function-name-face)
+ "Unspecified predicate goals.")
+
+(sweeprolog-defface
+ string
+ (:inherit font-lock-string-face)
+ (:foreground "navyblue")
+ (:foreground "palegreen")
+ "Strings.")
+
+(sweeprolog-defface
+ comment
+ (:inherit font-lock-comment-face)
+ (:foreground "darkgreen")
+ (:foreground "green")
+ "Comments.")
+
+(sweeprolog-defface
+ head-built-in
+ (:background "orange" :weight bold)
+ (:background "orange" :weight bold)
+ (:background "orange" :weight bold)
+ "Built-in predicate definitons.")
+
+(sweeprolog-defface
+ method
+ (:weight bold)
+ (:weight bold)
+ (:weight bold)
+ "PCE classes.")
+
+(sweeprolog-defface
+ class
+ (:underline t)
+ (:underline t)
+ (:underline t)
+ "PCE classes.")
+
+(sweeprolog-defface
+ no-file
+ (:foreground "red")
+ (:foreground "red")
+ (:foreground "red")
+ "Non-existsing file specifications.")
+
+(sweeprolog-defface
+ head-local
+ (:inherit font-lock-builtin-face)
+ (:weight bold)
+ (:weight bold)
+ "Local predicate definitions.")
+
+(sweeprolog-defface
+ head-meta
+ (:inherit font-lock-preprocessor-face)
+ (:inherit default)
+ (:inherit default)
+ "Meta predicate definitions.")
+
+(sweeprolog-defface
+ head-multifile
+ (:inherit font-lock-type-face)
+ (:foreground "navyblue" :weight bold)
+ (:foreground "palegreen" :weight bold)
+ "Multifile predicate definitions.")
+
+(sweeprolog-defface
+ head-extern
+ (:inherit font-lock-type-face)
+ (:foreground "blue" :weight bold)
+ (:foreground "cyan" :weight bold)
+ "External predicate definitions.")
+
+(sweeprolog-defface
+ head-unreferenced
+ (:inherit font-lock-warning-face)
+ (:foreground "red" :weight bold)
+ (:foreground "red" :weight bold)
+ "Unreferenced predicate definitions.")
+
+(sweeprolog-defface
+ head-exported
+ (:inherit font-lock-builtin-face)
+ (:foreground "blue" :weight bold)
+ (:foreground "cyan" :weight bold)
+ "Exported predicate definitions.")
+
+(sweeprolog-defface
+ head-hook
+ (:inherit font-lock-type-face)
+ (:foreground "blue" :underline t)
+ (:foreground "cyan" :underline t)
+ "Hook definitions.")
+
+(sweeprolog-defface
+ head-iso
+ (:inherit font-lock-keyword-face)
+ (:background "orange" :weight bold)
+ (:background "orange" :weight bold)
+ "Hook definitions.")
+
+(sweeprolog-defface
+ head-undefined
+ (:inherit font-lock-warning-face)
+ (:weight bold)
+ (:weight bold)
+ "Undefind head terms.")
+
+(sweeprolog-defface
+ head-public
+ (:inherit font-lock-builtin-face)
+ (:foreground "#016300" :weight bold)
+ (:foreground "#016300" :weight bold)
+ "Public definitions.")
+
+(sweeprolog-defface
+ meta-spec
+ (:inherit font-lock-preprocessor-face)
+ (:inherit font-lock-preprocessor-face)
+ (:inherit font-lock-preprocessor-face)
+ "Meta argument specifiers.")
+
+(sweeprolog-defface
+ recursion
+ (:inherit font-lock-builtin-face)
+ (:underline t)
+ (:underline t)
+ "Recursive calls.")
+
+(sweeprolog-defface
+ local
+ (:inherit font-lock-function-name-face)
+ (:foreground "navyblue")
+ (:foreground "darkcyan")
+ "Local predicate calls.")
+
+(sweeprolog-defface
+ autoload
+ (:inherit font-lock-function-name-face)
+ (:foreground "navyblue")
+ (:foreground "darkcyan")
+ "Autoloaded predicate calls.")
+
+(sweeprolog-defface
+ imported
+ (:inherit font-lock-function-name-face)
+ (:foreground "blue")
+ (:foreground "cyan")
+ "Imported predicate calls.")
+
+(sweeprolog-defface
+ extern
+ (:inherit font-lock-function-name-face)
+ (:foreground "blue" :underline t)
+ (:foreground "cyan" :underline t)
+ "External predicate calls.")
+
+(sweeprolog-defface
+ foreign
+ (:inherit font-lock-keyword-face)
+ (:foreground "darkturquoise")
+ (:foreground "darkturquoise")
+ "Foreign predicate calls.")
+
+(sweeprolog-defface
+ meta
+ (:inherit font-lock-type-face)
+ (:foreground "red4")
+ (:foreground "red4")
+ "Meta predicate calls.")
+
+(sweeprolog-defface
+ undefined
+ (:inherit font-lock-warning-face)
+ (:foreground "red")
+ (:foreground "orange")
+ "Undefined predicate calls.")
+
+(sweeprolog-defface
+ thread-local
+ (:inherit font-lock-constant-face)
+ (:foreground "magenta" :underline t)
+ (:foreground "magenta" :underline t)
+ "Thread local predicate calls.")
+
+(sweeprolog-defface
+ global
+ (:inherit font-lock-keyword-face)
+ (:foreground "magenta")
+ (:foreground "darkcyan")
+ "Global predicate calls.")
+
+(sweeprolog-defface
+ multifile
+ (:inherit font-lock-function-name-face)
+ (:foreground "navyblue")
+ (:foreground "palegreen")
+ "Multifile predicate calls.")
+
+(sweeprolog-defface
+ dynamic
+ (:inherit font-lock-constant-face)
+ (:foreground "magenta")
+ (:foreground "magenta")
+ "Dynamic predicate calls.")
+
+(sweeprolog-defface
+ undefined-import
+ (:inherit font-lock-warning-face)
+ (:foreground "red")
+ (:foreground "red")
+ "Undefined imports.")
+
+(sweeprolog-defface
+ html-attribute
+ (:inherit font-lock-function-name-face)
+ (:foreground "magenta4")
+ (:foreground "magenta4")
+ "HTML attributes.")
+
+(sweeprolog-defface
+ html-call
+ (:inherit font-lock-keyword-face)
+ (:foreground "magenta4" :weight bold)
+ (:foreground "magenta4" :weight bold)
+ "Multifile predicate calls.")
+
+(sweeprolog-defface
+ option-name
+ (:inherit font-lock-constant-face)
+ (:foreground "#3434ba")
+ (:foreground "#3434ba")
+ "Option names.")
+
+(sweeprolog-defface
+ no-option-name
+ (:inherit font-lock-warning-face)
+ (:foreground "red")
+ (:foreground "orange")
+ "Non-existent option names.")
+
+(sweeprolog-defface
+ flag-name
+ (:inherit font-lock-constant-face)
+ (:foreground "blue")
+ (:foreground "cyan")
+ "Flag names.")
+
+(sweeprolog-defface
+ no-flag-name
+ (:inherit font-lock-warning-face)
+ (:foreground "red")
+ (:foreground "red")
+ "Non-existent flag names.")
+
+(sweeprolog-defface
+ qq-type
+ (:inherit font-lock-type-face)
+ (:weight bold)
+ (:weight bold)
+ "Quasi-quotation types.")
+
+(sweeprolog-defface
+ qq-sep
+ (:inherit font-lock-type-face)
+ (:weight bold)
+ (:weight bold)
+ "Quasi-quotation separators.")
+
+(sweeprolog-defface
+ qq-open
+ (:inherit font-lock-type-face)
+ (:weight bold)
+ (:weight bold)
+ "Quasi-quotation open sequences.")
+
+(sweeprolog-defface
+ qq-close
+ (:inherit font-lock-type-face)
+ (:weight bold)
+ (:weight bold)
+ "Quasi-quotation close sequences.")
+
+(sweeprolog-defface
+ op-type
+ (:inherit font-lock-type-face)
+ (:foreground "blue")
+ (:foreground "cyan")
+ "Operator types.")
+
+(sweeprolog-defface
+ dict-tag
+ (:inherit font-lock-constant-face)
+ (:weight bold)
+ (:weight bold)
+ "Dict tags.")
+
+(sweeprolog-defface
+ dict-key
+ (:inherit font-lock-keyword-face)
+ (:weight bold)
+ (:weight bold)
+ "Dict keys.")
+
+(sweeprolog-defface
+ dict-sep
+ (:inherit font-lock-keyword-face)
+ (:weight bold)
+ (:weight bold)
+ "Dict separators.")
+
+(sweeprolog-defface
+ file
+ (:inherit button)
+ (:foreground "blue" :underline t)
+ (:foreground "cyan" :underline t)
+ "File specifiers.")
+
+(sweeprolog-defface
+ file-no-depend
+ (:inherit font-lock-warning-face)
+ (:foreground "blue" :underline t :background "pink")
+ (:foreground "cyan" :underline t :background "pink")
+ "Unused file specifiers.")
+
+(sweeprolog-defface
+ unused-import
+ (:inherit font-lock-warning-face)
+ (:foreground "blue" :background "pink")
+ (:foreground "cyan" :background "pink")
+ "Unused imports.")
+
+(sweeprolog-defface
+ identifier
+ (:inherit font-lock-type-face)
+ (:weight bold)
+ (:weight bold)
+ "Identifiers.")
+
+(sweeprolog-defface
+ hook
+ (:inherit font-lock-preprocessor-face)
+ (:foreground "blue" :underline t)
+ (:foreground "cyan" :underline t)
+ "Hooks.")
+
+(sweeprolog-defface
+ module
+ (:inherit font-lock-type-face)
+ (:foreground "darkslateblue")
+ (:foreground "lightslateblue")
+ "Module names.")
+
+(sweeprolog-defface
+ singleton
+ (:inherit font-lock-warning-face)
+ (:foreground "red4" :weight bold)
+ (:foreground "orangered1" :weight bold)
+ "Singletons.")
+
+(sweeprolog-defface
+ fullstop
+ (:inherit font-lock-negation-char-face)
+ (:inherit font-lock-negation-char-face)
+ (:inherit font-lock-negation-char-face)
+ "Fullstops.")
+
+(sweeprolog-defface
+ nil
+ (:inherit font-lock-keyword-face)
+ (:inherit font-lock-keyword-face)
+ (:inherit font-lock-keyword-face)
+ "The empty list.")
+
+(sweeprolog-defface
+ variable
+ (:inherit font-lock-variable-name-face)
+ (:foreground "red4")
+ (:foreground "orangered1")
+ "Variables.")
+
+(sweeprolog-defface
+ ext-quant
+ (:inherit font-lock-keyword-face)
+ (:inherit font-lock-keyword-face)
+ (:inherit font-lock-keyword-face)
+ "Existential quantifiers.")
+
+(sweeprolog-defface
+ control
+ (:inherit font-lock-keyword-face)
+ (:inherit font-lock-keyword-face)
+ (:inherit font-lock-keyword-face)
+ "Control constructs.")
+
+(sweeprolog-defface
+ atom
+ (:inherit font-lock-constant-face)
+ (:inherit font-lock-constant-face)
+ (:inherit font-lock-constant-face)
+ "Atoms.")
+
+(sweeprolog-defface
+ int
+ (:inherit font-lock-constant-face)
+ (:inherit font-lock-constant-face)
+ (:inherit font-lock-constant-face)
+ "Integers.")
+
+(sweeprolog-defface
+ float
+ (:inherit font-lock-constant-face)
+ (:inherit font-lock-constant-face)
+ (:inherit font-lock-constant-face)
+ "Floats.")
+
+(sweeprolog-defface
+ codes
+ (:inherit font-lock-constant-face)
+ (:inherit font-lock-constant-face)
+ (:inherit font-lock-constant-face)
+ "Codes.")
+
+(sweeprolog-defface
+ error
+ (:inherit font-lock-warning-face)
+ (:background "orange")
+ (:background "orange")
+ "Unspecified errors.")
+
+(sweeprolog-defface
+ type-error
+ (:inherit font-lock-warning-face)
+ (:background "orange")
+ (:background "orange")
+ "Type errors.")
+
+(sweeprolog-defface
+ instantiation-error
+ (:inherit font-lock-warning-face)
+ (:background "orange")
+ (:background "orange")
+ "Instantiation errors.")
+
+(sweeprolog-defface
+ syntax-error
+ (:inherit error)
+ (:background "orange")
+ (:background "orange")
+ "Syntax errors.")
+
+(sweeprolog-defface
+ around-syntax-error
+ (:inherit default)
+ (:inherit default)
+ (:inherit default)
+ "Text around a syntax error.")
+
+(sweeprolog-defface
+ clause
+ (:inherit default)
+ (:inherit default)
+ (:inherit default)
+ "Predicate clauses.")
+
+(sweeprolog-defface
+ grammar-rule
+ (:inherit default)
+ (:inherit default)
+ (:inherit default)
+ "DCG grammar rules.")
+
+(sweeprolog-defface
+ term
+ (:inherit default)
+ (:inherit default)
+ (:inherit default)
+ "Top terms.")
+
+(sweeprolog-defface
+ directive
+ (:inherit default)
+ (:inherit default)
+ (:inherit default)
+ "Directives.")
+
+(sweeprolog-defface
+ structured-comment
+ (:inherit font-lock-doc-face)
+ (:inherit font-lock-doc-face :foreground "darkgreen")
+ (:inherit font-lock-doc-face :foreground "green")
+ "Structured comments.")
+
+(defun sweeprolog--colour-term-to-face (arg)
+ (pcase arg
+ (`("comment" . "structured")
+ ;; (remove-list-of-text-properties beg end '(font-lock-face))
+ (sweeprolog-structured-comment-face))
+ (`("comment" . ,_)
+ ;; (remove-list-of-text-properties beg end '(font-lock-face))
+ (sweeprolog-comment-face))
+ (`("head" "unreferenced" . ,_) (sweeprolog-head-unreferenced-face))
+ (`("head" "meta" . ,_) (sweeprolog-head-meta-face))
+ (`("head" "exported" . ,_) (sweeprolog-head-exported-face))
+ (`("head" "hook" . ,_) (sweeprolog-head-hook-face))
+ (`("head" "built_in" . ,_) (sweeprolog-head-built-in-face))
+ (`("head" ,(rx "extern(") . ,_) (sweeprolog-head-extern-face))
+ (`("head" ,(rx "public(") . ,_) (sweeprolog-head-public-face))
+ (`("head" ,(rx "local(") . ,_) (sweeprolog-head-local-face))
+ (`("goal" "recursion" . ,_) (sweeprolog-recursion-face))
+ (`("goal" "meta" . ,_) (sweeprolog-meta-face))
+ (`("goal" "built_in" . ,_) (sweeprolog-built-in-face))
+ (`("goal" "undefined" . ,_) (sweeprolog-undefined-face))
+ (`("goal" "global" . ,_) (sweeprolog-global-face))
+ (`("goal",(rx "dynamic ") . ,_) (sweeprolog-dynamic-face))
+ (`("goal",(rx "multifile ") . ,_) (sweeprolog-multifile-face))
+ (`("goal",(rx "thread_local ") . ,_) (sweeprolog-thread-local-face))
+ (`("goal",(rx "extern(") . ,_) (sweeprolog-extern-face))
+ (`("goal",(rx "autoload(") . ,_) (sweeprolog-autoload-face))
+ (`("goal",(rx "imported(") . ,_) (sweeprolog-imported-face))
+ (`("goal",(rx "global(") . ,_) (sweeprolog-global-face))
+ (`("goal",(rx "local(") . ,_) (sweeprolog-local-face))
+ (`("syntax_error" ,_message ,eb ,ee)
+ (with-silent-modifications
+ (put-text-property eb ee 'font-lock-face
+ (sweeprolog-around-syntax-error-face)))
+ (sweeprolog-syntax-error-face))
+ ("unused_import" (sweeprolog-unused-import-face))
+ ("undefined_import" (sweeprolog-undefined-import-face))
+ ("html_attribute" (sweeprolog-html-attribute-face))
+ ("html_call" (sweeprolog-html-call-face))
+ ("dict_tag" (sweeprolog-dict-tag-face))
+ ("dict_key" (sweeprolog-dict-key-face))
+ ("dict_sep" (sweeprolog-dict-sep-face))
+ ("meta" (sweeprolog-meta-spec-face))
+ ("flag_name" (sweeprolog-flag-name-face))
+ ("no_flag_name" (sweeprolog-flag-name-face))
+ ("ext_quant" (sweeprolog-ext-quant-face))
+ ("atom" (sweeprolog-atom-face))
+ ("float" (sweeprolog-float-face))
+ ("int" (sweeprolog-int-face))
+ ("singleton" (sweeprolog-singleton-face))
+ ("option_name" (sweeprolog-option-name-face))
+ ("no_option_name" (sweeprolog-no-option-name-face))
+ ("control" (sweeprolog-control-face))
+ ("var" (sweeprolog-variable-face))
+ ("fullstop" (sweeprolog-fullstop-face))
+ ("functor" (sweeprolog-functor-face))
+ ("arity" (sweeprolog-arity-face))
+ ("predicate_indicator" (sweeprolog-predicate-indicator-face))
+ ("string" (sweeprolog-string-face))
+ ("module" (sweeprolog-module-face))
+ ("neck" (sweeprolog-neck-face))
+ ("hook" (sweeprolog-hook-face))
+ ("qq_type" (sweeprolog-qq-type-face))
+ ("qq_sep" (sweeprolog-qq-sep-face))
+ ("qq_open" (sweeprolog-qq-open-face))
+ ("qq_close" (sweeprolog-qq-close-face))
+ ("identifier" (sweeprolog-identifier-face))
+ ("file" (sweeprolog-file-face))
+ ("file_no_depend" (sweeprolog-file-no-depend-face))
+ ("nofile" (sweeprolog-no-file-face))
+ ("op_type" (sweeprolog-op-type-face))
+ ("directive"
+ ;; (with-silent-modifications
+ ;; (remove-list-of-text-properties beg end '(font-lock-face)))
+ (sweeprolog-directive-face))
+ ("clause"
+ ;; (with-silent-modifications
+ ;; (remove-list-of-text-properties beg end '(font-lock-face)))
+ (sweeprolog-clause-face))
+ ("term"
+ ;; (with-silent-modifications
+ ;; (remove-list-of-text-properties beg end '(font-lock-face)))
+ (sweeprolog-term-face))
+ ("grammar_rule"
+ ;; (with-silent-modifications
+ ;; (remove-list-of-text-properties beg end '(font-lock-face)))
+ (sweeprolog-grammar-rule-face))
+ ("method" (sweeprolog-method-face))
+ ("class" (sweeprolog-class-face))))
+
+(defun sweeprolog--colourise (args)
+ "ARGS is a list of the form (BEG LEN . SEM)."
+ (when-let ((beg (max (point-min) (car args)))
+ (end (min (point-max) (+ beg (cadr args))))
+ (arg (cddr args))
+ (flf (sweeprolog--colour-term-to-face arg)))
+ (with-silent-modifications
+ (font-lock--add-text-property beg end 'font-lock-face flf (current-buffer) nil))))
+
+(defun sweeprolog-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))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_colourise_buffer"
+ (cons contents (buffer-file-name)))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ sol))))
+
+(defun sweeprolog-colourise-some-terms (beg0 end0 &optional _verbose)
+ (let* ((beg (save-mark-and-excursion
+ (goto-char beg0)
+ (sweeprolog-beginning-of-top-term)
+ (max (1- (point)) (point-min))))
+ (end (save-mark-and-excursion
+ (goto-char end0)
+ (sweeprolog-end-of-top-term)
+ (point)))
+ (contents (buffer-substring-no-properties beg end)))
+ (with-silent-modifications
+ (font-lock-unfontify-region beg end))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_colourise_some_terms"
+ (list contents
+ (buffer-file-name)
+ beg))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ `(jit-lock-bounds ,beg . ,end)))))
+
+(defun sweeprolog-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))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_colourise_query"
+ (cons query (marker-position beg)))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ sol)))))
+
+(defun sweeprolog-load-buffer (buffer)
+ "Load the Prolog buffer BUFFER into the embedded SWI-Prolog runtime.
+
+Interactively, if the major mode of the current buffer is
+`sweeprolog-mode' and the command is called without a prefix argument,
+load the current buffer. Otherwise, prompt for a `sweeprolog-mode'
+buffer to load."
+ (interactive (list
+ (if (and (not current-prefix-arg)
+ (eq major-mode 'sweeprolog-mode))
+ (current-buffer)
+ (read-buffer "Load buffer: "
+ (when (eq major-mode 'sweeprolog-mode)
+ (buffer-name))
+ t
+ (lambda (b)
+ (let ((n (or (and (consp b) (car b)) b)))
+ (with-current-buffer n
+ (eq major-mode 'sweeprolog-mode))))))))
+ (with-current-buffer buffer
+ (let* ((beg (point-min))
+ (end (point-max))
+ (contents (buffer-substring-no-properties beg end)))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_load_buffer"
+ (cons contents (buffer-file-name)))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (if (sweeprolog-true-p sol)
+ (message "Loaded %s." (buffer-name))
+ (user-error "Loading %s failed!" (buffer-name)))))))
+
+;;;###autoload
+(defun sweeprolog-top-level (&optional buffer)
+ "Run a Prolog top-level in BUFFER.
+If BUFFER is nil, a buffer called \"*sweeprolog-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 'sweeprolog-top-level-mode)
+ (null (get-buffer-process
+ (current-buffer))))
+ (buffer-name)
+ (generate-new-buffer-name "*sweeprolog-top-level*"))))))
+ (list buffer)))
+ (let ((buf (get-buffer-create (or buffer "*sweeprolog-top-level*"))))
+ (with-current-buffer buf
+ (unless (eq major-mode 'sweeprolog-top-level-mode)
+ (sweeprolog-top-level-mode)))
+ (make-comint-in-buffer "sweeprolog-top-level"
+ buf
+ (cons "localhost"
+ sweeprolog-prolog-server-port))
+ (pop-to-buffer buf sweeprolog-top-level-display-action)))
+
+(defun sweeprolog-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 sweeprolog-top-level-timer nil "Buffer-local timer.")
+
+;;;###autoload
+(define-derived-mode sweeprolog-top-level-mode comint-mode "sweep Top-level"
+ "Major mode for interacting with an inferior Prolog interpreter."
+ :group 'sweeprolog-top-level
+ (setq-local comint-prompt-regexp (rx line-start "?- ")
+ comint-input-ignoredups t
+ comint-prompt-read-only t
+ comint-input-filter (lambda (s)
+ (< sweeprolog-top-level-min-history-length
+ (length s)))
+ comint-delimiter-argument-list '(?,)
+ comment-start "%")
+ (add-hook 'post-self-insert-hook #'sweeprolog-top-level--post-self-insert-function nil t)
+ (setq sweeprolog-buffer-module "user")
+ (add-hook 'completion-at-point-functions #'sweeprolog-completion-at-point-function nil t)
+ (setq sweeprolog-top-level-timer (run-with-idle-timer 0.2 t #'sweeprolog-colourise-query (current-buffer)))
+ (add-hook 'kill-buffer-hook
+ (lambda ()
+ (when (timerp sweeprolog-top-level-timer)
+ (cancel-timer sweeprolog-top-level-timer)))))
+
+(sweeprolog--ensure-module)
+(when sweeprolog-init-on-load (sweeprolog-init))
+
+;;;###autoload
+(defvar sweeprolog-prefix-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "m" #'sweeprolog-find-module)
+ (define-key map "p" #'sweeprolog-find-predicate)
+ (define-key map "t" #'sweeprolog-top-level)
+ (define-key map "l" #'sweeprolog-load-buffer)
+ (define-key map "P" #'sweeprolog-pack-install)
+ (define-key map "F" #'sweeprolog-set-prolog-flag)
+ (define-key map "e" #'sweeprolog-view-messages)
+ map)
+ "Keymap for `sweeprolog' global commands.")
+
+;;;###autoload
+(defun sweeprolog-file-name-handler (operation &rest args)
+ (cond ((eq operation 'expand-file-name)
+ (let ((fn (car args))
+ (dn (cadr args)))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_expand_file_name"
+ (cons fn dn))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (if (sweeprolog-true-p sol)
+ (cdr sol)
+ (let ((inhibit-file-name-handlers
+ (cons 'sweeprolog-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 'sweeprolog-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) "(")
+ #'sweeprolog-file-name-handler))
+
+(defun sweeprolog-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))))
+ (sweeprolog-beginning-of-next-top-term (- times)))))
+
+(defun sweeprolog-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 sweeprolog-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 sweeprolog-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 sweeprolog-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-c C-l") #'sweeprolog-load-buffer)
+ (define-key map (kbd "C-c C-c") #'sweeprolog-colourise-buffer)
+ (define-key map (kbd "C-c C-t") #'sweeprolog-top-level)
+ (define-key map (kbd "C-c C-o") #'sweeprolog-find-file-at-point)
+ (define-key map (kbd "C-M-^") #'kill-backward-up-list)
+ map)
+ "Keymap for `sweeprolog-mode'.")
+
+(defun sweeprolog-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 sweeprolog-next-token-boundaries (&optional pos)
+ (let ((point (or pos (point))))
+ (save-excursion
+ (goto-char point)
+ (while (forward-comment 1))
+ (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 sweeprolog-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 sweeprolog--forward-term (pre)
+ (pcase (sweeprolog-next-token-boundaries)
+ ('nil
+ (signal 'scan-error
+ (list "Cannot scan beyond end of buffer."
+ (point-max)
+ (point-max))))
+ (`(close ,lbeg ,lend)
+ (signal 'scan-error
+ (list "Cannot scan beyond closing parenthesis or bracket."
+ lbeg
+ lend)))
+ (`(open ,obeg ,_)
+ (goto-char obeg)
+ (goto-char (scan-lists (point) 1 0))
+ (sweeprolog--forward-term pre))
+ (`(functor ,_ ,oend)
+ (goto-char (1- oend))
+ (goto-char (scan-lists (point) 1 0))
+ (sweeprolog--forward-term pre))
+ (`(operator ,obeg ,oend)
+ (if (and (string= "." (buffer-substring-no-properties obeg oend))
+ (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
+ (signal 'scan-error
+ (list "Cannot scan beyond fullstop."
+ obeg
+ (1+ obeg)))
+ (if-let ((opre (sweeprolog-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan beyond infix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char oend)
+ (sweeprolog--forward-term pre))
+ (if-let ((ppre (sweeprolog-op-suffix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan beyond suffix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char oend)
+ (sweeprolog--forward-term pre))
+ (goto-char oend)
+ (sweeprolog--forward-term pre)))))
+ (`(symbol ,obeg ,oend)
+ (if-let ((opre (sweeprolog-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan backwards infix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char oend)
+ (sweeprolog--forward-term pre))
+ (if-let ((ppre (sweeprolog-op-prefix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char oend)
+ (sweeprolog--forward-term pre))
+ (goto-char oend)
+ (sweeprolog--forward-term pre))))
+ (`(,_ ,_ ,oend)
+ (goto-char oend)
+ (sweeprolog--forward-term pre))))
+
+(defun sweeprolog-forward-term (pre)
+ (condition-case _
+ (sweeprolog--forward-term pre)
+ (scan-error nil)))
+
+(defun sweeprolog--backward-term (pre)
+ (pcase (sweeprolog-last-token-boundaries)
+ ('nil
+ (signal 'scan-error
+ (list "Cannot scan backwards beyond beginning of buffer."
+ (point-min)
+ (point-min))))
+ (`(open ,obeg ,oend)
+ (signal 'scan-error
+ (list "Cannot scan backwards beyond opening parenthesis or bracket."
+ obeg
+ oend)))
+ (`(functor ,obeg ,oend)
+ (signal 'scan-error
+ (list "Cannot scan backwards beyond functor."
+ obeg
+ oend)))
+ (`(operator ,obeg ,oend)
+ (if (and (string= "." (buffer-substring-no-properties obeg oend))
+ (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
+ (signal 'scan-error
+ (list "Cannot scan backwards beyond fullstop."
+ obeg
+ (1+ obeg)))
+ (if-let ((opre (sweeprolog-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan backwards beyond infix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char obeg)
+ (sweeprolog--backward-term pre))
+ (if-let ((ppre (sweeprolog-op-prefix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char obeg)
+ (sweeprolog--backward-term pre))
+ (goto-char obeg)
+ (sweeprolog--backward-term pre)))))
+ (`(symbol ,obeg ,oend)
+ (if-let ((opre (sweeprolog-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan backwards beyond infix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char obeg)
+ (sweeprolog--backward-term pre))
+ (if-let ((ppre (sweeprolog-op-prefix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char obeg)
+ (sweeprolog--backward-term pre))
+ (goto-char obeg)
+ (sweeprolog--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_"))
+ (sweeprolog--backward-term pre))
+ (`(,_ ,lbeg ,_)
+ (goto-char lbeg)
+ (sweeprolog--backward-term pre))))
+
+(defun sweeprolog-backward-term (pre)
+ (condition-case _
+ (sweeprolog--backward-term pre)
+ (scan-error nil)))
+
+(defvar-local sweeprolog--forward-sexp-first-call t)
+
+(defun sweeprolog--backward-sexp ()
+ (let ((point (point))
+ (prec (pcase (sweeprolog-last-token-boundaries)
+ (`(operator ,obeg ,oend)
+ (unless (and nil
+ (string= "." (buffer-substring-no-properties obeg oend))
+ (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
+ (if-let ((pprec
+ (sweeprolog-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (progn (goto-char obeg) (1- pprec))
+ 0)))
+ (_ 0))))
+ (condition-case error
+ (sweeprolog--backward-term prec)
+ (scan-error (when (= point (point))
+ (signal 'scan-error (cdr error)))))))
+
+(defun sweeprolog--forward-sexp ()
+ (let ((point (point))
+ (prec (pcase (sweeprolog-next-token-boundaries)
+ (`(operator ,obeg ,oend)
+ (unless (and nil
+ (string= "." (buffer-substring-no-properties obeg oend))
+ (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
+ (if-let ((pprec
+ (sweeprolog-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (progn (goto-char oend) (1- pprec))
+ 0)))
+ (_ 0))))
+ (condition-case error
+ (sweeprolog--forward-term prec)
+ (scan-error (when (= point (point))
+ (signal 'scan-error (cdr error)))))))
+
+(defun sweeprolog-forward-sexp-function (arg)
+ (let* ((times (abs arg))
+ (func (or (and (not (= arg 0))
+ (< 0 (/ times arg))
+ #'sweeprolog--forward-sexp)
+ #'sweeprolog--backward-sexp)))
+ (while (< 0 times)
+ (funcall func)
+ (setq times (1- times)))))
+
+(defun sweeprolog-op-suffix-precedence (token)
+ (sweeprolog-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+ (let ((res nil) (go t))
+ (while go
+ (if-let ((sol (sweeprolog-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)))
+ (sweeprolog-close-query)
+ res))
+
+(defun sweeprolog-op-prefix-precedence (token)
+ (sweeprolog-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+ (let ((res nil) (go t))
+ (while go
+ (if-let ((sol (sweeprolog-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)))
+ (sweeprolog-close-query)
+ res))
+
+(defun sweeprolog-op-infix-precedence (token)
+ (sweeprolog-open-query "user" "sweep" "sweep_op_info" (cons token (buffer-file-name)))
+ (let ((res nil) (go t))
+ (while go
+ (if-let ((sol (sweeprolog-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)))
+ (sweeprolog-close-query)
+ res))
+
+(defun sweeprolog-indent-line-after-functor (fbeg _fend)
+ (save-excursion
+ (goto-char fbeg)
+ (+ (current-column) sweeprolog-indent-offset)))
+
+(defun sweeprolog-indent-line-after-open (fbeg _fend)
+ (save-excursion
+ (goto-char fbeg)
+ (+ (current-column) sweeprolog-indent-offset)))
+
+(defun sweeprolog-indent-line-after-prefix (fbeg _fend _pre)
+ (save-excursion
+ (goto-char fbeg)
+ (+ (current-column) 4)))
+
+(defun sweeprolog-indent-line-after-term ()
+ (if-let ((open (nth 1 (syntax-ppss))))
+ (save-excursion
+ (goto-char open)
+ (current-column))
+ 'noindent))
+
+(defun sweeprolog-indent-line-after-neck (fbeg _fend)
+ (save-excursion
+ (goto-char fbeg)
+ (sweeprolog-backward-term 1200)
+ (+ (current-column) sweeprolog-indent-offset)))
+
+(defun sweeprolog-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))
+ (sweeprolog-backward-term pre)
+ (when (< (point) lim)
+ (goto-char cur))
+ (when (= (point) cur)
+ (setq go nil))))
+ (current-column)))
+
+(defun sweeprolog-indent-line ()
+ "Indent the current line in a `sweeprolog-mode' buffer."
+ (interactive)
+ (let ((pos (- (point-max) (point))))
+ (back-to-indentation)
+ (let ((indent (if (nth 8 (syntax-ppss))
+ 'noindent
+ (if-let ((open (and (not (eobp))
+ (= (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 (sweeprolog-last-token-boundaries)
+ ('nil 'noindent)
+ (`(functor ,lbeg ,lend)
+ (sweeprolog-indent-line-after-functor lbeg lend))
+ (`(open ,lbeg ,lend)
+ (sweeprolog-indent-line-after-open lbeg lend))
+ (`(symbol ,lbeg ,lend)
+ (let ((sym (buffer-substring-no-properties lbeg lend)))
+ (cond
+ ((pcase (sweeprolog-op-prefix-precedence sym)
+ ('nil (sweeprolog-indent-line-after-term))
+ (pre (sweeprolog-indent-line-after-prefix lbeg lend pre)))))))
+ (`(operator ,lbeg ,lend)
+ (let ((op (buffer-substring-no-properties lbeg lend)))
+ (cond
+ ((string= op ".") 'noindent)
+ ((pcase (sweeprolog-op-infix-precedence op)
+ ('nil nil)
+ (1200 (sweeprolog-indent-line-after-neck lbeg lend))
+ (pre (sweeprolog-indent-line-after-infix lbeg lend pre))))
+ ((pcase (sweeprolog-op-prefix-precedence op)
+ ('nil nil)
+ (pre (sweeprolog-indent-line-after-prefix lbeg lend pre)))))))
+ (`(,_ltyp ,_lbeg ,_lend)
+ (sweeprolog-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 sweeprolog-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 sweeprolog-at-beginning-of-top-term-p ()
+ (and (looking-at-p (rx bol graph))
+ (not (nth 8 (syntax-ppss)))))
+
+(defun sweeprolog-file-at-point (&optional point)
+ (let* ((p (or point (point)))
+ (beg (save-mark-and-excursion
+ (goto-char p)
+ (unless (sweeprolog-at-beginning-of-top-term-p)
+ (sweeprolog-beginning-of-top-term))
+ (max (1- (point)) (point-min))))
+ (end (save-mark-and-excursion
+ (goto-char p)
+ (sweeprolog-end-of-top-term)
+ (point)))
+ (contents (buffer-substring-no-properties beg end)))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_file_at_point"
+ (list contents
+ (buffer-file-name)
+ (- p beg)))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol)))))
+
+(defun sweeprolog-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" sweeprolog-mode)
+ (if-let ((file (sweeprolog-file-at-point point)))
+ (find-file file)
+ (user-error "No file specification found at point!")))
+
+(defun sweeprolog-identifier-at-point (&optional point)
+ (let* ((p (or point (point)))
+ (beg (save-mark-and-excursion
+ (goto-char p)
+ (unless (sweeprolog-at-beginning-of-top-term-p)
+ (sweeprolog-beginning-of-top-term))
+ (max (1- (point)) (point-min))))
+ (end (save-mark-and-excursion
+ (goto-char p)
+ (sweeprolog-end-of-top-term)
+ (point)))
+ (contents (buffer-substring-no-properties beg end)))
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_identifier_at_point"
+ (list contents
+ (buffer-file-name)
+ (- p beg)))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (cdr sol)))))
+
+(defun sweeprolog--xref-backend ()
+ "Hook for `xref-backend-functions'."
+ 'sweeprolog)
+
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql sweeprolog)))
+ (sweeprolog-identifier-at-point))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql sweeprolog)))
+ (completion-table-with-cache #'sweeprolog-predicates-collection))
+
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql sweeprolog)))
+ "Case is always significant for Prolog identifiers, so return nil."
+ nil)
+
+(cl-defmethod xref-backend-definitions ((_backend (eql sweeprolog)) mfn)
+ (when-let ((loc (sweeprolog-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 sweeprolog)) mfn)
+ (let ((refs (sweeprolog-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 sweeprolog)) pattern)
+ (let ((matches (sweeprolog-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)))
+
+(defun sweeprolog-create-index-function ()
+ (sweeprolog-open-query "user"
+ "sweep"
+ "sweep_imenu_index"
+ (buffer-file-name))
+ (let ((sol (sweeprolog-next-solution)))
+ (sweeprolog-close-query)
+ (when (sweeprolog-true-p sol)
+ (seq-map (lambda (entry)
+ (let ((car (car entry))
+ (line (cdr entry)))
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (cons car (line-beginning-position))))
+ (cdr sol)))))
+
+(defvar-local sweeprolog--timer nil)
+(defvar-local sweeprolog--colourise-buffer-duration 0.2)
+
+;;;###autoload
+(define-derived-mode sweeprolog-mode prog-mode "sweep"
+ "Major mode for reading and editing Prolog code."
+ :group 'sweeprolog
+ (setq-local comment-start "%")
+ (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)")
+ (setq-local parens-require-spaces nil)
+ (setq-local imenu-create-index-function #'sweeprolog-create-index-function)
+ (setq-local beginning-of-defun-function #'sweeprolog-beginning-of-top-term)
+ (setq-local end-of-defun-function #'sweeprolog-end-of-top-term)
+ (setq-local forward-sexp-function #'sweeprolog-forward-sexp-function)
+ (setq-local syntax-propertize-function #'sweeprolog-syntax-propertize)
+ (setq-local indent-line-function #'sweeprolog-indent-line)
+ (setq-local font-lock-defaults
+ '(nil
+ nil
+ nil
+ nil
+ nil
+ (font-lock-fontify-region-function . sweeprolog-colourise-some-terms)))
+ (let ((time (current-time)))
+ (sweeprolog-colourise-buffer)
+ (setq sweeprolog--colourise-buffer-duration (float-time (time-since time))))
+ (sweeprolog--set-buffer-module)
+ (add-hook 'xref-backend-functions #'sweeprolog--xref-backend nil t)
+ (add-hook 'file-name-at-point-functions #'sweeprolog-file-at-point nil t)
+ (add-hook 'completion-at-point-functions #'sweeprolog-completion-at-point-function nil t)
+ (when sweeprolog-colourise-buffer-on-idle
+ (setq sweeprolog--timer (run-with-idle-timer (max sweeprolog-colourise-buffer-min-interval
+ (* 10 sweeprolog--colourise-buffer-duration))
+ t
+ (let ((buffer (current-buffer)))
+ (lambda ()
+ (unless (< sweeprolog-colourise-buffer-max-size
+ (buffer-size buffer))
+ (sweeprolog-colourise-buffer buffer))))))
+ (add-hook 'kill-buffer-hook
+ (lambda ()
+ (when (timerp sweeprolog--timer)
+ (cancel-timer sweeprolog--timer))))))
+
+;;;; Testing:
+
+;; (add-to-list 'load-path (file-name-directory (buffer-file-name)))
+;; (require 'sweeprolog)
+
+(provide 'sweeprolog)
+
+;;; sweeprolog.el ends here
projects / sweep.git / commitdiff