Commit | Line | Data |
---|---|---|
eb89dc14 | 1 | ;;; prolog.el --- major mode for Prolog (and Mercury) -*- lexical-binding:t -*- |
6594deb0 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2014 Free |
ab422c4d | 4 | ;; Software Foundation, Inc. |
9750e079 | 5 | |
c38e0c97 | 6 | ;; Authors: Emil Åström <emil_astrom(at)hotmail(dot)com> |
e2019526 | 7 | ;; Milan Zamazal <pdm(at)freesoft(dot)cz> |
df70a04b | 8 | ;; Stefan Bruda <stefan(at)bruda(dot)ca> |
e2019526 | 9 | ;; * See below for more details |
df70a04b | 10 | ;; Maintainer: Stefan Bruda <stefan(at)bruda(dot)ca> |
e2019526 | 11 | ;; Keywords: prolog major mode sicstus swi mercury |
e5167999 | 12 | |
e2019526 | 13 | (defvar prolog-mode-version "1.22" |
04380ff1 | 14 | "Prolog mode version number.") |
d8025917 | 15 | |
04380ff1 SM |
16 | ;; This file is part of GNU Emacs. |
17 | ||
18 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
d8025917 | 19 | ;; it under the terms of the GNU General Public License as published by |
04380ff1 SM |
20 | ;; the Free Software Foundation, either version 3 of the License, or |
21 | ;; (at your option) any later version. | |
d8025917 | 22 | |
04380ff1 | 23 | ;; GNU Emacs is distributed in the hope that it will be useful, |
d8025917 | 24 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
25 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
26 | ;; GNU General Public License for more details. | |
27 | ||
28 | ;; You should have received a copy of the GNU General Public License | |
04380ff1 | 29 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
e2019526 SB |
30 | |
31 | ;; Original author: Masanobu UMEDA <umerin(at)mse(dot)kyutech(dot)ac(dot)jp> | |
32 | ;; Parts of this file was taken from a modified version of the original | |
33 | ;; by Johan Andersson, Peter Olin, Mats Carlsson, Johan Bevemyr, Stefan | |
c38e0c97 | 34 | ;; Andersson, and Per Danielsson (all SICS people), and Henrik Båkman |
e2019526 SB |
35 | ;; at Uppsala University, Sweden. |
36 | ;; | |
37 | ;; Some ideas and also a few lines of code have been borrowed (not stolen ;-) | |
38 | ;; from Oz.el, the Emacs major mode for the Oz programming language, | |
39 | ;; Copyright (C) 1993 DFKI GmbH, Germany, with permission. | |
b4d8d5e6 GM |
40 | ;; Authored by Ralf Scheidhauer and Michael Mehl |
41 | ;; ([scheidhr|mehl](at)dfki(dot)uni-sb(dot)de) | |
e2019526 SB |
42 | ;; |
43 | ;; More ideas and code have been taken from the SICStus debugger mode | |
44 | ;; (http://www.csd.uu.se/~perm/source_debug/index.shtml -- broken link | |
45 | ;; as of Mon May 5 08:23:48 EDT 2003) by Per Mildner. | |
46 | ;; | |
47 | ;; Additions for ECLiPSe and other helpful suggestions: Stephan Heuel | |
48 | ;; <heuel(at)ipb(dot)uni-bonn(dot)de> | |
d8025917 | 49 | |
edbd2f74 | 50 | ;;; Commentary: |
e2019526 SB |
51 | ;; |
52 | ;; This package provides a major mode for editing Prolog code, with | |
53 | ;; all the bells and whistles one would expect, including syntax | |
54 | ;; highlighting and auto indentation. It can also send regions to an | |
55 | ;; inferior Prolog process. | |
56 | ;; | |
57 | ;; The code requires the comint, easymenu, info, imenu, and font-lock | |
04380ff1 | 58 | ;; libraries. These are normally distributed with GNU Emacs and |
e2019526 SB |
59 | ;; XEmacs. |
60 | ||
61 | ;;; Installation: | |
62 | ;; | |
865fe16f | 63 | ;; Insert the following lines in your init file: |
e2019526 SB |
64 | ;; |
65 | ;; (setq load-path (cons "/usr/lib/xemacs/site-lisp" load-path)) | |
66 | ;; (autoload 'run-prolog "prolog" "Start a Prolog sub-process." t) | |
67 | ;; (autoload 'prolog-mode "prolog" "Major mode for editing Prolog programs." t) | |
68 | ;; (autoload 'mercury-mode "prolog" "Major mode for editing Mercury programs." t) | |
69 | ;; (setq prolog-system 'swi) ; optional, the system you are using; | |
70 | ;; ; see `prolog-system' below for possible values | |
71 | ;; (setq auto-mode-alist (append '(("\\.pl$" . prolog-mode) | |
72 | ;; ("\\.m$" . mercury-mode)) | |
73 | ;; auto-mode-alist)) | |
74 | ;; | |
75 | ;; where the path in the first line is the file system path to this file. | |
dbed16aa | 76 | ;; MSDOS paths can be written like "d:/programs/emacs-19.34/site-lisp". |
e2019526 SB |
77 | ;; Note: In XEmacs, either `/usr/lib/xemacs/site-lisp' (RPM default in |
78 | ;; Red Hat-based distributions) or `/usr/local/lib/xemacs/site-lisp' | |
79 | ;; (default when compiling from sources) are automatically added to | |
80 | ;; `load-path', so the first line is not necessary provided that you | |
81 | ;; put this file in the appropriate place. | |
82 | ;; | |
83 | ;; The last s-expression above makes sure that files ending with .pl | |
84 | ;; are assumed to be Prolog files and not Perl, which is the default | |
04380ff1 | 85 | ;; Emacs setting. If this is not wanted, remove this line. It is then |
e2019526 SB |
86 | ;; necessary to either |
87 | ;; | |
88 | ;; o insert in your Prolog files the following comment as the first line: | |
89 | ;; | |
90 | ;; % -*- Mode: Prolog -*- | |
91 | ;; | |
dbed16aa | 92 | ;; and then the file will be open in Prolog mode no matter its |
e2019526 SB |
93 | ;; extension, or |
94 | ;; | |
dbed16aa | 95 | ;; o manually switch to prolog mode after opening a Prolog file, by typing |
e2019526 SB |
96 | ;; M-x prolog-mode. |
97 | ;; | |
98 | ;; If the command to start the prolog process ('sicstus', 'pl' or | |
99 | ;; 'swipl' for SWI prolog, etc.) is not available in the default path, | |
100 | ;; then it is necessary to set the value of the environment variable | |
101 | ;; EPROLOG to a shell command to invoke the prolog process. In XEmacs | |
102 | ;; and Emacs 20+ you can also customize the variable | |
103 | ;; `prolog-program-name' (in the group `prolog-inferior') and provide | |
104 | ;; a full path for your Prolog system (swi, scitus, etc.). | |
105 | ;; | |
106 | ;; Note: I (Stefan, the current maintainer) work under XEmacs. Future | |
107 | ;; developments will thus be biased towards XEmacs (OK, I admit it, | |
108 | ;; I am biased towards XEmacs in general), though I will do my best | |
109 | ;; to keep the GNU Emacs compatibility. So if you work under Emacs | |
110 | ;; and see something that does not work do drop me a line, as I have | |
111 | ;; a smaller chance to notice this kind of bugs otherwise. | |
edbd2f74 | 112 | |
e2019526 | 113 | ;; Changelog: |
edbd2f74 | 114 | |
e2019526 SB |
115 | ;; Version 1.22: |
116 | ;; o Allowed both 'swipl' and 'pl' as names for the SWI Prolog | |
117 | ;; interpreter. | |
da6062e6 | 118 | ;; o Atoms that start a line are not blindly colored as |
e2019526 SB |
119 | ;; predicates. Instead we check that they are followed by ( or |
120 | ;; :- first. Patch suggested by Guy Wiener. | |
121 | ;; Version 1.21: | |
122 | ;; o Cleaned up the code that defines faces. The missing face | |
123 | ;; warnings on some Emacsen should disappear. | |
124 | ;; Version 1.20: | |
125 | ;; o Improved the handling of clause start detection and multi-line | |
126 | ;; comments: `prolog-clause-start' no longer finds non-predicate | |
127 | ;; (e.g., capitalized strings) beginning of clauses. | |
128 | ;; `prolog-tokenize' recognizes when the end point is within a | |
129 | ;; multi-line comment. | |
130 | ;; Version 1.19: | |
131 | ;; o Minimal changes for Aquamacs inclusion and in general for | |
132 | ;; better coping with finding the Prolog executable. Patch | |
dbed16aa | 133 | ;; provided by David Reitter |
e2019526 SB |
134 | ;; Version 1.18: |
135 | ;; o Fixed syntax highlighting for clause heads that do not begin at | |
136 | ;; the beginning of the line. | |
137 | ;; o Fixed compilation warnings under Emacs. | |
138 | ;; o Updated the email address of the current maintainer. | |
139 | ;; Version 1.17: | |
140 | ;; o Minor indentation fix (patch by Markus Triska) | |
141 | ;; o `prolog-underscore-wordchar-flag' defaults now to nil (more | |
142 | ;; consistent to other Emacs modes) | |
143 | ;; Version 1.16: | |
144 | ;; o Eliminated a possible compilation warning. | |
145 | ;; Version 1.15: | |
146 | ;; o Introduced three new customizable variables: electric colon | |
147 | ;; (`prolog-electric-colon-flag', default nil), electric dash | |
148 | ;; (`prolog-electric-dash-flag', default nil), and a possibility | |
301b181a | 149 | ;; to prevent the predicate template insertion from adding commas |
e2019526 | 150 | ;; (`prolog-electric-dot-full-predicate-template', defaults to t |
301b181a | 151 | ;; since it seems quicker to me to just type those commas). A |
e2019526 | 152 | ;; trivial adaptation of a patch by Markus Triska. |
91af3942 | 153 | ;; o Improved the behavior of electric if-then-else to only skip |
e2019526 SB |
154 | ;; forward if the parenthesis/semicolon is preceded by |
155 | ;; whitespace. Once more a trivial adaptation of a patch by | |
156 | ;; Markus Triska. | |
157 | ;; Version 1.14: | |
04380ff1 | 158 | ;; o Cleaned up align code. `prolog-align-flag' is eliminated (since |
e2019526 SB |
159 | ;; on a second thought it does not do anything useful). Added key |
160 | ;; binding (C-c C-a) and menu entry for alignment. | |
161 | ;; o Condensed regular expressions for lower and upper case | |
162 | ;; characters (GNU Emacs seems to go over the regexp length limit | |
163 | ;; with the original form). My code on the matter was improved | |
164 | ;; considerably by Markus Triska. | |
165 | ;; o Fixed `prolog-insert-spaces-after-paren' (which used an | |
ee7683eb | 166 | ;; uninitialized variable). |
e2019526 SB |
167 | ;; o Minor changes to clean up the code and avoid some implicit |
168 | ;; package requirements. | |
169 | ;; Version 1.13: | |
170 | ;; o Removed the use of `map-char-table' in `prolog-build-case-strings' | |
e1dbe924 | 171 | ;; which appears to cause problems in (at least) Emacs 23.0.0.1. |
e2019526 SB |
172 | ;; o Added if-then-else indentation + corresponding electric |
173 | ;; characters. New customization: `prolog-electric-if-then-else-flag' | |
174 | ;; o Align support (requires `align'). New customization: | |
175 | ;; `prolog-align-flag'. | |
176 | ;; o Temporary consult files have now the same name throughout the | |
177 | ;; session. This prevents issues with reconsulting a buffer | |
178 | ;; (this event is no longer passed to Prolog as a request to | |
179 | ;; consult a new file). | |
180 | ;; o Adaptive fill mode is now turned on. Comment indentation is | |
181 | ;; still worse than it could be though, I am working on it. | |
182 | ;; o Improved filling and auto-filling capabilities. Now block | |
183 | ;; comments should be [auto-]filled correctly most of the time; | |
184 | ;; the following pattern in particular is worth noting as being | |
185 | ;; filled correctly: | |
186 | ;; <some code here> % some comment here that goes beyond the | |
187 | ;; % rightmost column, possibly combined with | |
188 | ;; % subsequent comment lines | |
189 | ;; o `prolog-char-quote-workaround' now defaults to nil. | |
190 | ;; o Note: Many of the above improvements have been suggested by | |
191 | ;; Markus Triska, who also provided useful patches on the matter | |
192 | ;; when he realized that I was slow in responding. Many thanks. | |
193 | ;; Version 1.11 / 1.12 | |
194 | ;; o GNU Emacs compatibility fix for paragraph filling (fixed | |
195 | ;; incorrectly in 1.11, fix fixed in 1.12). | |
196 | ;; Version 1.10 | |
197 | ;; o Added paragraph filling in comment blocks and also correct auto | |
198 | ;; filling for comments. | |
199 | ;; o Fixed the possible "Regular expression too big" error in | |
200 | ;; `prolog-electric-dot'. | |
201 | ;; Version 1.9 | |
202 | ;; o Parenthesis expressions are now indented by default so that | |
203 | ;; components go one underneath the other, just as for compound | |
204 | ;; terms. You can use the old style (the second and subsequent | |
205 | ;; lines being indented to the right in a parenthesis expression) | |
206 | ;; by setting the customizable variable `prolog-paren-indent-p' | |
207 | ;; (group "Prolog Indentation") to t. | |
208 | ;; o (Somehow awkward) handling of the 0' character escape | |
04380ff1 | 209 | ;; sequence. I am looking into a better way of doing it but |
e2019526 SB |
210 | ;; prospects look bleak. If this breaks things for you please let |
211 | ;; me know and also set the `prolog-char-quote-workaround' (group | |
212 | ;; "Prolog Other") to nil. | |
213 | ;; Version 1.8 | |
214 | ;; o Key binding fix. | |
215 | ;; Version 1.7 | |
216 | ;; o Fixed a number of issues with the syntax of single quotes, | |
217 | ;; including Debian bug #324520. | |
218 | ;; Version 1.6 | |
219 | ;; o Fixed mercury mode menu initialization (Debian bug #226121). | |
220 | ;; o Fixed (i.e., eliminated) Delete remapping (Debian bug #229636). | |
221 | ;; o Corrected indentation for clauses defining quoted atoms. | |
222 | ;; Version 1.5: | |
223 | ;; o Keywords fontifying should work in console mode so this is | |
224 | ;; enabled everywhere. | |
225 | ;; Version 1.4: | |
226 | ;; o Now supports GNU Prolog--minor adaptation of a patch by Stefan | |
227 | ;; Moeding. | |
228 | ;; Version 1.3: | |
229 | ;; o Info-follow-nearest-node now called correctly under Emacs too | |
230 | ;; (thanks to Nicolas Pelletier). Should be implemented more | |
231 | ;; elegantly (i.e., without compilation warnings) in the future. | |
232 | ;; Version 1.2: | |
233 | ;; o Another prompt fix, still in SWI mode (people seem to have | |
234 | ;; changed the prompt of SWI Prolog). | |
235 | ;; Version 1.1: | |
236 | ;; o Fixed dots in the end of line comments causing indentation | |
237 | ;; problems. The following code is now correctly indented (note | |
238 | ;; the dot terminating the comment): | |
dbed16aa | 239 | ;; a(X) :- b(X), |
e2019526 SB |
240 | ;; c(X). % comment here. |
241 | ;; a(X). | |
242 | ;; and so is this (and variants): | |
dbed16aa | 243 | ;; a(X) :- b(X), |
04380ff1 | 244 | ;; c(X). /* comment here. */ |
e2019526 SB |
245 | ;; a(X). |
246 | ;; Version 1.0: | |
247 | ;; o Revamped the menu system. | |
248 | ;; o Yet another prompt recognition fix (SWI mode). | |
249 | ;; o This is more of a renumbering than a new edition. I promoted | |
250 | ;; the mode to version 1.0 to emphasize the fact that it is now | |
251 | ;; mature and stable enough to be considered production (in my | |
252 | ;; opinion anyway). | |
253 | ;; Version 0.1.41: | |
254 | ;; o GNU Emacs compatibility fixes. | |
255 | ;; Version 0.1.40: | |
256 | ;; o prolog-get-predspec is now suitable to be called as | |
257 | ;; imenu-extract-index-name-function. The predicate index works. | |
258 | ;; o Since imenu works now as advertised, prolog-imenu-flag is t | |
259 | ;; by default. | |
260 | ;; o Eliminated prolog-create-predicate-index since the imenu | |
261 | ;; utilities now work well. Actually, this function is also | |
262 | ;; buggy, and I see no reason to fix it since we do not need it | |
263 | ;; anyway. | |
264 | ;; o Fixed prolog-pred-start, prolog-clause-start, prolog-clause-info. | |
265 | ;; o Fix for prolog-build-case-strings; now prolog-upper-case-string | |
dbed16aa | 266 | ;; and prolog-lower-case-string are correctly initialized, |
e2019526 SB |
267 | ;; o Various font-lock changes; most importantly, block comments (/* |
268 | ;; ... */) are now correctly fontified in XEmacs even when they | |
269 | ;; extend on multiple lines. | |
dbed16aa | 270 | ;; Version 0.1.36: |
e2019526 | 271 | ;; o The debug prompt of SWI Prolog is now correctly recognized. |
dbed16aa | 272 | ;; Version 0.1.35: |
e2019526 SB |
273 | ;; o Minor font-lock bug fixes. |
274 | ||
dbed16aa SM |
275 | ;;; TODO: |
276 | ||
277 | ;; Replace ":type 'sexp" with more precise Custom types. | |
e2019526 | 278 | \f |
e5167999 ER |
279 | ;;; Code: |
280 | ||
f440830d GM |
281 | (require 'comint) |
282 | ||
e2019526 | 283 | (eval-when-compile |
e2019526 SB |
284 | (require 'font-lock) |
285 | ;; We need imenu everywhere because of the predicate index! | |
286 | (require 'imenu) | |
287 | ;) | |
e2019526 SB |
288 | (require 'shell) |
289 | ) | |
290 | ||
e2019526 SB |
291 | (require 'easymenu) |
292 | (require 'align) | |
293 | ||
4e186ad5 | 294 | |
c5292bc8 | 295 | (defgroup prolog nil |
cf20dee0 | 296 | "Editing and running Prolog and Mercury files." |
c5292bc8 RS |
297 | :group 'languages) |
298 | ||
e2019526 SB |
299 | (defgroup prolog-faces nil |
300 | "Prolog mode specific faces." | |
301 | :group 'font-lock) | |
f614a1ae | 302 | |
e2019526 SB |
303 | (defgroup prolog-indentation nil |
304 | "Prolog mode indentation configuration." | |
c5292bc8 | 305 | :group 'prolog) |
d8025917 | 306 | |
e2019526 SB |
307 | (defgroup prolog-font-lock nil |
308 | "Prolog mode font locking patterns." | |
c5292bc8 | 309 | :group 'prolog) |
d8025917 | 310 | |
e2019526 SB |
311 | (defgroup prolog-keyboard nil |
312 | "Prolog mode keyboard flags." | |
c5292bc8 | 313 | :group 'prolog) |
d8025917 | 314 | |
e2019526 SB |
315 | (defgroup prolog-inferior nil |
316 | "Inferior Prolog mode options." | |
317 | :group 'prolog) | |
318 | ||
319 | (defgroup prolog-other nil | |
320 | "Other Prolog mode options." | |
c5292bc8 | 321 | :group 'prolog) |
d8025917 | 322 | |
e2019526 SB |
323 | \f |
324 | ;;------------------------------------------------------------------- | |
325 | ;; User configurable variables | |
326 | ;;------------------------------------------------------------------- | |
327 | ||
328 | ;; General configuration | |
329 | ||
330 | (defcustom prolog-system nil | |
3e0d2fa7 | 331 | "Prolog interpreter/compiler used. |
e2019526 SB |
332 | The value of this variable is nil or a symbol. |
333 | If it is a symbol, it determines default values of other configuration | |
334 | variables with respect to properties of the specified Prolog | |
335 | interpreter/compiler. | |
336 | ||
337 | Currently recognized symbol values are: | |
338 | eclipse - Eclipse Prolog | |
339 | mercury - Mercury | |
340 | sicstus - SICStus Prolog | |
341 | swi - SWI Prolog | |
342 | gnu - GNU Prolog" | |
2bed3f04 | 343 | :version "24.1" |
e2019526 SB |
344 | :group 'prolog |
345 | :type '(choice (const :tag "SICStus" :value sicstus) | |
346 | (const :tag "SWI Prolog" :value swi) | |
01c63f4c SM |
347 | (const :tag "GNU Prolog" :value gnu) |
348 | (const :tag "ECLiPSe Prolog" :value eclipse) | |
349 | ;; Mercury shouldn't be needed since we have a separate | |
350 | ;; major mode for it. | |
e2019526 SB |
351 | (const :tag "Default" :value nil))) |
352 | (make-variable-buffer-local 'prolog-system) | |
353 | ||
354 | ;; NB: This alist can not be processed in prolog-mode-variables to | |
355 | ;; create a prolog-system-version-i variable since it is needed | |
356 | ;; prior to the call to prolog-mode-variables. | |
357 | (defcustom prolog-system-version | |
358 | '((sicstus (3 . 6)) | |
359 | (swi (0 . 0)) | |
360 | (mercury (0 . 0)) | |
361 | (eclipse (3 . 7)) | |
362 | (gnu (0 . 0))) | |
01c63f4c | 363 | ;; FIXME: This should be auto-detected instead of user-provided. |
3e0d2fa7 | 364 | "Alist of Prolog system versions. |
e2019526 | 365 | The version numbers are of the format (Major . Minor)." |
2bed3f04 | 366 | :version "24.1" |
3e0d2fa7 GM |
367 | :type '(repeat (list (symbol :tag "System") |
368 | (cons :tag "Version numbers" (integer :tag "Major") | |
369 | (integer :tag "Minor")))) | |
c5292bc8 | 370 | :group 'prolog) |
d8025917 | 371 | |
e2019526 SB |
372 | ;; Indentation |
373 | ||
04380ff1 | 374 | (defcustom prolog-indent-width 4 |
3e0d2fa7 | 375 | "The indentation width used by the editing buffer." |
e2019526 | 376 | :group 'prolog-indentation |
dbed16aa | 377 | :type 'integer) |
e2019526 | 378 | |
e2019526 | 379 | (defcustom prolog-left-indent-regexp "\\(;\\|\\*?->\\)" |
eb89dc14 | 380 | "Regexp for `prolog-electric-if-then-else-flag'." |
2bed3f04 | 381 | :version "24.1" |
e2019526 SB |
382 | :group 'prolog-indentation |
383 | :type 'regexp) | |
384 | ||
385 | (defcustom prolog-paren-indent-p nil | |
3e0d2fa7 | 386 | "If non-nil, increase indentation for parenthesis expressions. |
e2019526 SB |
387 | The second and subsequent line in a parenthesis expression other than |
388 | a compound term can either be indented `prolog-paren-indent' to the | |
389 | right (if this variable is non-nil) or in the same way as for compound | |
390 | terms (if this variable is nil, default)." | |
2bed3f04 | 391 | :version "24.1" |
e2019526 SB |
392 | :group 'prolog-indentation |
393 | :type 'boolean) | |
394 | ||
395 | (defcustom prolog-paren-indent 4 | |
3e0d2fa7 | 396 | "The indentation increase for parenthesis expressions. |
e2019526 | 397 | Only used in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions." |
2bed3f04 | 398 | :version "24.1" |
e2019526 SB |
399 | :group 'prolog-indentation |
400 | :type 'integer) | |
401 | ||
402 | (defcustom prolog-parse-mode 'beg-of-clause | |
3e0d2fa7 | 403 | "The parse mode used (decides from which point parsing is done). |
e2019526 SB |
404 | Legal values: |
405 | 'beg-of-line - starts parsing at the beginning of a line, unless the | |
04380ff1 | 406 | previous line ends with a backslash. Fast, but has |
e2019526 SB |
407 | problems detecting multiline /* */ comments. |
408 | 'beg-of-clause - starts parsing at the beginning of the current clause. | |
409 | Slow, but copes better with /* */ comments." | |
2bed3f04 | 410 | :version "24.1" |
e2019526 SB |
411 | :group 'prolog-indentation |
412 | :type '(choice (const :value beg-of-line) | |
413 | (const :value beg-of-clause))) | |
414 | ||
415 | ;; Font locking | |
416 | ||
417 | (defcustom prolog-keywords | |
418 | '((eclipse | |
419 | ("use_module" "begin_module" "module_interface" "dynamic" | |
420 | "external" "export" "dbgcomp" "nodbgcomp" "compile")) | |
421 | (mercury | |
422 | ("all" "else" "end_module" "equality" "external" "fail" "func" "if" | |
423 | "implementation" "import_module" "include_module" "inst" "instance" | |
424 | "interface" "mode" "module" "not" "pragma" "pred" "some" "then" "true" | |
425 | "type" "typeclass" "use_module" "where")) | |
426 | (sicstus | |
427 | ("block" "dynamic" "mode" "module" "multifile" "meta_predicate" | |
428 | "parallel" "public" "sequential" "volatile")) | |
429 | (swi | |
430 | ("discontiguous" "dynamic" "ensure_loaded" "export" "export_list" "import" | |
431 | "meta_predicate" "module" "module_transparent" "multifile" "require" | |
432 | "use_module" "volatile")) | |
433 | (gnu | |
434 | ("built_in" "char_conversion" "discontiguous" "dynamic" "ensure_linked" | |
435 | "ensure_loaded" "foreign" "include" "initialization" "multifile" "op" | |
436 | "public" "set_prolog_flag")) | |
437 | (t | |
dbed16aa | 438 | ;; FIXME: Shouldn't we just use the union of all the above here? |
e2019526 | 439 | ("dynamic" "module"))) |
3e0d2fa7 | 440 | "Alist of Prolog keywords which is used for font locking of directives." |
2bed3f04 | 441 | :version "24.1" |
e2019526 SB |
442 | :group 'prolog-font-lock |
443 | :type 'sexp) | |
444 | ||
445 | (defcustom prolog-types | |
446 | '((mercury | |
447 | ("char" "float" "int" "io__state" "string" "univ")) | |
448 | (t nil)) | |
3e0d2fa7 | 449 | "Alist of Prolog types used by font locking." |
2bed3f04 | 450 | :version "24.1" |
e2019526 SB |
451 | :group 'prolog-font-lock |
452 | :type 'sexp) | |
453 | ||
454 | (defcustom prolog-mode-specificators | |
455 | '((mercury | |
456 | ("bound" "di" "free" "ground" "in" "mdi" "mui" "muo" "out" "ui" "uo")) | |
457 | (t nil)) | |
3e0d2fa7 | 458 | "Alist of Prolog mode specificators used by font locking." |
2bed3f04 | 459 | :version "24.1" |
e2019526 SB |
460 | :group 'prolog-font-lock |
461 | :type 'sexp) | |
462 | ||
463 | (defcustom prolog-determinism-specificators | |
464 | '((mercury | |
465 | ("cc_multi" "cc_nondet" "det" "erroneous" "failure" "multi" "nondet" | |
466 | "semidet")) | |
467 | (t nil)) | |
3e0d2fa7 | 468 | "Alist of Prolog determinism specificators used by font locking." |
2bed3f04 | 469 | :version "24.1" |
e2019526 SB |
470 | :group 'prolog-font-lock |
471 | :type 'sexp) | |
472 | ||
473 | (defcustom prolog-directives | |
474 | '((mercury | |
475 | ("^#[0-9]+")) | |
476 | (t nil)) | |
3e0d2fa7 | 477 | "Alist of Prolog source code directives used by font locking." |
2bed3f04 | 478 | :version "24.1" |
e2019526 SB |
479 | :group 'prolog-font-lock |
480 | :type 'sexp) | |
481 | ||
482 | ||
483 | ;; Keyboard | |
484 | ||
e2019526 | 485 | (defcustom prolog-hungry-delete-key-flag nil |
3e0d2fa7 | 486 | "Non-nil means delete key consumes all preceding spaces." |
2bed3f04 | 487 | :version "24.1" |
e2019526 SB |
488 | :group 'prolog-keyboard |
489 | :type 'boolean) | |
490 | ||
491 | (defcustom prolog-electric-dot-flag nil | |
3e0d2fa7 | 492 | "Non-nil means make dot key electric. |
e2019526 SB |
493 | Electric dot appends newline or inserts head of a new clause. |
494 | If dot is pressed at the end of a line where at least one white space | |
495 | precedes the point, it inserts a recursive call to the current predicate. | |
496 | If dot is pressed at the beginning of an empty line, it inserts the head | |
04380ff1 | 497 | of a new clause for the current predicate. It does not apply in strings |
dbed16aa | 498 | and comments. |
e2019526 | 499 | It does not apply in strings and comments." |
2bed3f04 | 500 | :version "24.1" |
e2019526 SB |
501 | :group 'prolog-keyboard |
502 | :type 'boolean) | |
503 | ||
504 | (defcustom prolog-electric-dot-full-predicate-template nil | |
3e0d2fa7 | 505 | "If nil, electric dot inserts only the current predicate's name and `(' |
dbed16aa | 506 | for recursive calls or new clause heads. Non-nil means to also |
301b181a | 507 | insert enough commas to cover the predicate's arity and `)', |
e2019526 | 508 | and dot and newline for recursive calls." |
2bed3f04 | 509 | :version "24.1" |
e2019526 SB |
510 | :group 'prolog-keyboard |
511 | :type 'boolean) | |
512 | ||
513 | (defcustom prolog-electric-underscore-flag nil | |
3e0d2fa7 | 514 | "Non-nil means make underscore key electric. |
e2019526 SB |
515 | Electric underscore replaces the current variable with underscore. |
516 | If underscore is pressed not on a variable then it behaves as usual." | |
2bed3f04 | 517 | :version "24.1" |
e2019526 SB |
518 | :group 'prolog-keyboard |
519 | :type 'boolean) | |
520 | ||
e2019526 | 521 | (defcustom prolog-electric-if-then-else-flag nil |
3e0d2fa7 | 522 | "Non-nil makes `(', `>' and `;' electric |
e2019526 | 523 | to automatically indent if-then-else constructs." |
2bed3f04 | 524 | :version "24.1" |
e2019526 SB |
525 | :group 'prolog-keyboard |
526 | :type 'boolean) | |
dbed16aa | 527 | |
e2019526 | 528 | (defcustom prolog-electric-colon-flag nil |
3e0d2fa7 | 529 | "Makes `:' electric (inserts `:-' on a new line). |
dbed16aa | 530 | If non-nil, pressing `:' at the end of a line that starts in |
e2019526 | 531 | the first column (i.e., clause heads) inserts ` :-' and newline." |
2bed3f04 | 532 | :version "24.1" |
e2019526 SB |
533 | :group 'prolog-keyboard |
534 | :type 'boolean) | |
535 | ||
536 | (defcustom prolog-electric-dash-flag nil | |
3e0d2fa7 | 537 | "Makes `-' electric (inserts a `-->' on a new line). |
e2019526 SB |
538 | If non-nil, pressing `-' at the end of a line that starts in |
539 | the first column (i.e., DCG heads) inserts ` -->' and newline." | |
2bed3f04 | 540 | :version "24.1" |
e2019526 SB |
541 | :group 'prolog-keyboard |
542 | :type 'boolean) | |
543 | ||
544 | (defcustom prolog-old-sicstus-keys-flag nil | |
3e0d2fa7 | 545 | "Non-nil means old SICStus Prolog mode keybindings are used." |
2bed3f04 | 546 | :version "24.1" |
e2019526 SB |
547 | :group 'prolog-keyboard |
548 | :type 'boolean) | |
549 | ||
550 | ;; Inferior mode | |
551 | ||
552 | (defcustom prolog-program-name | |
553 | `(((getenv "EPROLOG") (eval (getenv "EPROLOG"))) | |
554 | (eclipse "eclipse") | |
555 | (mercury nil) | |
556 | (sicstus "sicstus") | |
557 | (swi ,(if (not (executable-find "swipl")) "pl" "swipl")) | |
558 | (gnu "gprolog") | |
559 | (t ,(let ((names '("prolog" "gprolog" "swipl" "pl"))) | |
560 | (while (and names | |
561 | (not (executable-find (car names)))) | |
562 | (setq names (cdr names))) | |
563 | (or (car names) "prolog")))) | |
3e0d2fa7 | 564 | "Alist of program names for invoking an inferior Prolog with `run-prolog'." |
e2019526 SB |
565 | :group 'prolog-inferior |
566 | :type 'sexp) | |
01c63f4c SM |
567 | (defun prolog-program-name () |
568 | (prolog-find-value-by-system prolog-program-name)) | |
e2019526 SB |
569 | |
570 | (defcustom prolog-program-switches | |
571 | '((sicstus ("-i")) | |
572 | (t nil)) | |
3e0d2fa7 | 573 | "Alist of switches given to inferior Prolog run with `run-prolog'." |
2bed3f04 | 574 | :version "24.1" |
e2019526 SB |
575 | :group 'prolog-inferior |
576 | :type 'sexp) | |
01c63f4c SM |
577 | (defun prolog-program-switches () |
578 | (prolog-find-value-by-system prolog-program-switches)) | |
e2019526 SB |
579 | |
580 | (defcustom prolog-consult-string | |
581 | '((eclipse "[%f].") | |
582 | (mercury nil) | |
583 | (sicstus (eval (if (prolog-atleast-version '(3 . 7)) | |
584 | "prolog:zap_file(%m,%b,consult,%l)." | |
585 | "prolog:zap_file(%m,%b,consult)."))) | |
586 | (swi "[%f].") | |
587 | (gnu "[%f].") | |
588 | (t "reconsult(%f).")) | |
3e0d2fa7 | 589 | "Alist of strings defining predicate for reconsulting. |
e2019526 SB |
590 | |
591 | Some parts of the string are replaced: | |
592 | `%f' by the name of the consulted file (can be a temporary file) | |
593 | `%b' by the file name of the buffer to consult | |
594 | `%m' by the module name and name of the consulted file separated by colon | |
04380ff1 | 595 | `%l' by the line offset into the file. This is 0 unless consulting a |
e2019526 SB |
596 | region of a buffer, in which case it is the number of lines before |
597 | the region." | |
598 | :group 'prolog-inferior | |
599 | :type 'sexp) | |
01c63f4c SM |
600 | (defun prolog-consult-string () |
601 | (prolog-find-value-by-system prolog-consult-string)) | |
e2019526 SB |
602 | |
603 | (defcustom prolog-compile-string | |
604 | '((eclipse "[%f].") | |
605 | (mercury "mmake ") | |
606 | (sicstus (eval (if (prolog-atleast-version '(3 . 7)) | |
607 | "prolog:zap_file(%m,%b,compile,%l)." | |
608 | "prolog:zap_file(%m,%b,compile)."))) | |
609 | (swi "[%f].") | |
610 | (t "compile(%f).")) | |
3e0d2fa7 | 611 | "Alist of strings and lists defining predicate for recompilation. |
e2019526 SB |
612 | |
613 | Some parts of the string are replaced: | |
614 | `%f' by the name of the compiled file (can be a temporary file) | |
615 | `%b' by the file name of the buffer to compile | |
616 | `%m' by the module name and name of the compiled file separated by colon | |
04380ff1 | 617 | `%l' by the line offset into the file. This is 0 unless compiling a |
e2019526 SB |
618 | region of a buffer, in which case it is the number of lines before |
619 | the region. | |
620 | ||
621 | If `prolog-program-name' is non-nil, it is a string sent to a Prolog process. | |
622 | If `prolog-program-name' is nil, it is an argument to the `compile' function." | |
623 | :group 'prolog-inferior | |
624 | :type 'sexp) | |
01c63f4c SM |
625 | (defun prolog-compile-string () |
626 | (prolog-find-value-by-system prolog-compile-string)) | |
e2019526 SB |
627 | |
628 | (defcustom prolog-eof-string "end_of_file.\n" | |
3e0d2fa7 | 629 | "Alist of strings that represent end of file for prolog. |
e2019526 SB |
630 | nil means send actual operating system end of file." |
631 | :group 'prolog-inferior | |
632 | :type 'sexp) | |
633 | ||
634 | (defcustom prolog-prompt-regexp | |
635 | '((eclipse "^[a-zA-Z0-9()]* *\\?- \\|^\\[[a-zA-Z]* [0-9]*\\]:") | |
636 | (sicstus "| [ ?][- ] *") | |
637 | (swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +") | |
01c63f4c SM |
638 | (gnu "^| \\?-") |
639 | (t "^|? *\\?-")) | |
3e0d2fa7 | 640 | "Alist of prompts of the prolog system command line." |
2bed3f04 | 641 | :version "24.1" |
e2019526 SB |
642 | :group 'prolog-inferior |
643 | :type 'sexp) | |
01c63f4c SM |
644 | (defun prolog-prompt-regexp () |
645 | (prolog-find-value-by-system prolog-prompt-regexp)) | |
e2019526 | 646 | |
01c63f4c SM |
647 | ;; (defcustom prolog-continued-prompt-regexp |
648 | ;; '((sicstus "^\\(| +\\| +\\)") | |
649 | ;; (t "^|: +")) | |
3e0d2fa7 | 650 | ;; "Alist of regexps matching the prompt when consulting `user'." |
01c63f4c SM |
651 | ;; :group 'prolog-inferior |
652 | ;; :type 'sexp) | |
e2019526 SB |
653 | |
654 | (defcustom prolog-debug-on-string "debug.\n" | |
3e0d2fa7 | 655 | "Predicate for enabling debug mode." |
2bed3f04 | 656 | :version "24.1" |
e2019526 SB |
657 | :group 'prolog-inferior |
658 | :type 'string) | |
659 | ||
660 | (defcustom prolog-debug-off-string "nodebug.\n" | |
3e0d2fa7 | 661 | "Predicate for disabling debug mode." |
2bed3f04 | 662 | :version "24.1" |
e2019526 SB |
663 | :group 'prolog-inferior |
664 | :type 'string) | |
665 | ||
666 | (defcustom prolog-trace-on-string "trace.\n" | |
3e0d2fa7 | 667 | "Predicate for enabling tracing." |
2bed3f04 | 668 | :version "24.1" |
e2019526 SB |
669 | :group 'prolog-inferior |
670 | :type 'string) | |
671 | ||
672 | (defcustom prolog-trace-off-string "notrace.\n" | |
3e0d2fa7 | 673 | "Predicate for disabling tracing." |
2bed3f04 | 674 | :version "24.1" |
e2019526 SB |
675 | :group 'prolog-inferior |
676 | :type 'string) | |
677 | ||
678 | (defcustom prolog-zip-on-string "zip.\n" | |
3e0d2fa7 | 679 | "Predicate for enabling zip mode for SICStus." |
2bed3f04 | 680 | :version "24.1" |
e2019526 SB |
681 | :group 'prolog-inferior |
682 | :type 'string) | |
683 | ||
684 | (defcustom prolog-zip-off-string "nozip.\n" | |
3e0d2fa7 | 685 | "Predicate for disabling zip mode for SICStus." |
2bed3f04 | 686 | :version "24.1" |
e2019526 SB |
687 | :group 'prolog-inferior |
688 | :type 'string) | |
689 | ||
690 | (defcustom prolog-use-standard-consult-compile-method-flag t | |
3e0d2fa7 | 691 | "Non-nil means use the standard compilation method. |
04380ff1 | 692 | Otherwise the new compilation method will be used. This |
ee7683eb | 693 | utilizes a special compilation buffer with the associated |
e2019526 SB |
694 | features such as parsing of error messages and automatically |
695 | jumping to the source code responsible for the error. | |
696 | ||
697 | Warning: the new method is so far only experimental and | |
04380ff1 | 698 | does contain bugs. The recommended setting for the novice user |
e2019526 | 699 | is non-nil for this variable." |
2bed3f04 | 700 | :version "24.1" |
e2019526 SB |
701 | :group 'prolog-inferior |
702 | :type 'boolean) | |
703 | ||
704 | ||
705 | ;; Miscellaneous | |
706 | ||
e2019526 | 707 | (defcustom prolog-imenu-flag t |
3e0d2fa7 | 708 | "Non-nil means add a clause index menu for all prolog files." |
2bed3f04 | 709 | :version "24.1" |
e2019526 SB |
710 | :group 'prolog-other |
711 | :type 'boolean) | |
712 | ||
713 | (defcustom prolog-imenu-max-lines 3000 | |
3e0d2fa7 | 714 | "The maximum number of lines of the file for imenu to be enabled. |
e2019526 | 715 | Relevant only when `prolog-imenu-flag' is non-nil." |
2bed3f04 | 716 | :version "24.1" |
e2019526 SB |
717 | :group 'prolog-other |
718 | :type 'integer) | |
719 | ||
720 | (defcustom prolog-info-predicate-index | |
721 | "(sicstus)Predicate Index" | |
3e0d2fa7 | 722 | "The info node for the SICStus predicate index." |
2bed3f04 | 723 | :version "24.1" |
e2019526 SB |
724 | :group 'prolog-other |
725 | :type 'string) | |
726 | ||
727 | (defcustom prolog-underscore-wordchar-flag nil | |
3e0d2fa7 | 728 | "Non-nil means underscore (_) is a word-constituent character." |
2bed3f04 | 729 | :version "24.1" |
e2019526 SB |
730 | :group 'prolog-other |
731 | :type 'boolean) | |
1d5963cc SM |
732 | (make-obsolete-variable 'prolog-underscore-wordchar-flag |
733 | 'superword-mode "24.4") | |
e2019526 SB |
734 | |
735 | (defcustom prolog-use-sicstus-sd nil | |
3e0d2fa7 | 736 | "If non-nil, use the source level debugger of SICStus 3#7 and later." |
2bed3f04 | 737 | :version "24.1" |
e2019526 SB |
738 | :group 'prolog-other |
739 | :type 'boolean) | |
740 | ||
741 | (defcustom prolog-char-quote-workaround nil | |
3e0d2fa7 | 742 | "If non-nil, declare 0 as a quote character to handle 0'<char>. |
dbed16aa | 743 | This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24." |
2bed3f04 | 744 | :version "24.1" |
e2019526 SB |
745 | :group 'prolog-other |
746 | :type 'boolean) | |
1d5963cc | 747 | (make-obsolete-variable 'prolog-char-quote-workaround nil "24.1") |
e2019526 SB |
748 | |
749 | \f | |
750 | ;;------------------------------------------------------------------- | |
751 | ;; Internal variables | |
752 | ;;------------------------------------------------------------------- | |
753 | ||
04380ff1 | 754 | ;;(defvar prolog-temp-filename "") ; Later set by `prolog-temporary-file' |
e2019526 | 755 | |
04380ff1 | 756 | (defvar prolog-mode-syntax-table |
dbed16aa SM |
757 | ;; The syntax accepted varies depending on the implementation used. |
758 | ;; Here are some of the differences: | |
759 | ;; - SWI-Prolog accepts nested /*..*/ comments. | |
760 | ;; - Edinburgh-style Prologs take <radix>'<number> for non-decimal number, | |
761 | ;; whereas ISO-style Prologs use 0[obx]<number> instead. | |
762 | ;; - In atoms \x<hex> sometimes needs a terminating \ (ISO-style) | |
763 | ;; and sometimes not. | |
04380ff1 | 764 | (let ((table (make-syntax-table))) |
1d5963cc | 765 | (modify-syntax-entry ?_ (if prolog-underscore-wordchar-flag "w" "_") table) |
04380ff1 SM |
766 | (modify-syntax-entry ?+ "." table) |
767 | (modify-syntax-entry ?- "." table) | |
768 | (modify-syntax-entry ?= "." table) | |
769 | (modify-syntax-entry ?< "." table) | |
770 | (modify-syntax-entry ?> "." table) | |
771 | (modify-syntax-entry ?| "." table) | |
772 | (modify-syntax-entry ?\' "\"" table) | |
e2019526 | 773 | |
04380ff1 | 774 | ;; Any better way to handle the 0'<char> construct?!? |
1d5963cc SM |
775 | (when (and prolog-char-quote-workaround |
776 | (not (fboundp 'syntax-propertize-rules))) | |
04380ff1 SM |
777 | (modify-syntax-entry ?0 "\\" table)) |
778 | ||
779 | (modify-syntax-entry ?% "<" table) | |
780 | (modify-syntax-entry ?\n ">" table) | |
781 | (if (featurep 'xemacs) | |
782 | (progn | |
783 | (modify-syntax-entry ?* ". 67" table) | |
784 | (modify-syntax-entry ?/ ". 58" table) | |
785 | ) | |
786 | ;; Emacs wants to see this it seems: | |
787 | (modify-syntax-entry ?* ". 23b" table) | |
788 | (modify-syntax-entry ?/ ". 14" table) | |
789 | ) | |
790 | table)) | |
2171cea5 SM |
791 | |
792 | (defconst prolog-atom-char-regexp | |
eb89dc14 | 793 | "[[:alnum:]_$]" |
2171cea5 SM |
794 | "Regexp specifying characters which constitute atoms without quoting.") |
795 | (defconst prolog-atom-regexp | |
eb89dc14 | 796 | (format "[[:lower:]$]%s*" prolog-atom-char-regexp)) |
e2019526 | 797 | |
01c63f4c | 798 | (defconst prolog-left-paren "[[({]" ;FIXME: Why not \\s(? |
e2019526 | 799 | "The characters used as left parentheses for the indentation code.") |
01c63f4c | 800 | (defconst prolog-right-paren "[])}]" ;FIXME: Why not \\s)? |
e2019526 SB |
801 | "The characters used as right parentheses for the indentation code.") |
802 | ||
803 | (defconst prolog-quoted-atom-regexp | |
804 | "\\(^\\|[^0-9]\\)\\('\\([^\n']\\|\\\\'\\)*'\\)" | |
805 | "Regexp matching a quoted atom.") | |
806 | (defconst prolog-string-regexp | |
807 | "\\(\"\\([^\n\"]\\|\\\\\"\\)*\"\\)" | |
808 | "Regexp matching a string.") | |
809 | (defconst prolog-head-delimiter "\\(:-\\|\\+:\\|-:\\|\\+\\?\\|-\\?\\|-->\\)" | |
810 | "A regexp for matching on the end delimiter of a head (e.g. \":-\").") | |
811 | ||
812 | (defvar prolog-compilation-buffer "*prolog-compilation*" | |
813 | "Name of the output buffer for Prolog compilation/consulting.") | |
814 | ||
815 | (defvar prolog-temporary-file-name nil) | |
816 | (defvar prolog-keywords-i nil) | |
817 | (defvar prolog-types-i nil) | |
818 | (defvar prolog-mode-specificators-i nil) | |
819 | (defvar prolog-determinism-specificators-i nil) | |
820 | (defvar prolog-directives-i nil) | |
e2019526 | 821 | (defvar prolog-eof-string-i nil) |
01c63f4c | 822 | ;; (defvar prolog-continued-prompt-regexp-i nil) |
e2019526 SB |
823 | (defvar prolog-help-function-i nil) |
824 | ||
825 | (defvar prolog-align-rules | |
826 | (eval-when-compile | |
827 | (mapcar | |
828 | (lambda (x) | |
829 | (let ((name (car x)) | |
830 | (sym (cdr x))) | |
831 | `(,(intern (format "prolog-%s" name)) | |
832 | (regexp . ,(format "\\(\\s-*\\)%s\\(\\s-*\\)" sym)) | |
833 | (tab-stop . nil) | |
834 | (modes . '(prolog-mode)) | |
835 | (group . (1 2))))) | |
836 | '(("dcg" . "-->") ("rule" . ":-") ("simplification" . "<=>") | |
837 | ("propagation" . "==>"))))) | |
838 | ||
2171cea5 SM |
839 | ;; SMIE support |
840 | ||
841 | (require 'smie) | |
842 | ||
2171cea5 SM |
843 | (defun prolog-smie-forward-token () |
844 | ;; FIXME: Add support for 0'<char>, if needed after adding it to | |
845 | ;; syntax-propertize-functions. | |
846 | (forward-comment (point-max)) | |
847 | (buffer-substring-no-properties | |
848 | (point) | |
849 | (progn (cond | |
850 | ((looking-at "[!;]") (forward-char 1)) | |
851 | ((not (zerop (skip-chars-forward "#&*+-./:<=>?@\\^`~")))) | |
852 | ((not (zerop (skip-syntax-forward "w_'")))) | |
853 | ;; In case of non-ASCII punctuation. | |
854 | ((not (zerop (skip-syntax-forward "."))))) | |
855 | (point)))) | |
856 | ||
857 | (defun prolog-smie-backward-token () | |
858 | ;; FIXME: Add support for 0'<char>, if needed after adding it to | |
859 | ;; syntax-propertize-functions. | |
860 | (forward-comment (- (point-max))) | |
861 | (buffer-substring-no-properties | |
862 | (point) | |
863 | (progn (cond | |
864 | ((memq (char-before) '(?! ?\;)) (forward-char -1)) | |
865 | ((not (zerop (skip-chars-backward "#&*+-./:<=>?@\\^`~")))) | |
866 | ((not (zerop (skip-syntax-backward "w_'")))) | |
867 | ;; In case of non-ASCII punctuation. | |
868 | ((not (zerop (skip-syntax-backward "."))))) | |
869 | (point)))) | |
870 | ||
871 | (defconst prolog-smie-grammar | |
872 | ;; Rather than construct the operator levels table from the BNF, | |
873 | ;; we directly provide the operator precedences from GNU Prolog's | |
874 | ;; manual (7.14.10 op/3). The only problem is that GNU Prolog's | |
875 | ;; manual uses precedence levels in the opposite sense (higher | |
876 | ;; numbers bind less tightly) than SMIE, so we use negative numbers. | |
877 | '(("." -10000 -10000) | |
878 | (":-" -1200 -1200) | |
879 | ("-->" -1200 -1200) | |
880 | (";" -1100 -1100) | |
881 | ("->" -1050 -1050) | |
882 | ("," -1000 -1000) | |
883 | ("\\+" -900 -900) | |
884 | ("=" -700 -700) | |
885 | ("\\=" -700 -700) | |
886 | ("=.." -700 -700) | |
887 | ("==" -700 -700) | |
888 | ("\\==" -700 -700) | |
889 | ("@<" -700 -700) | |
890 | ("@=<" -700 -700) | |
891 | ("@>" -700 -700) | |
892 | ("@>=" -700 -700) | |
893 | ("is" -700 -700) | |
894 | ("=:=" -700 -700) | |
895 | ("=\\=" -700 -700) | |
896 | ("<" -700 -700) | |
897 | ("=<" -700 -700) | |
898 | (">" -700 -700) | |
899 | (">=" -700 -700) | |
900 | (":" -600 -600) | |
901 | ("+" -500 -500) | |
902 | ("-" -500 -500) | |
903 | ("/\\" -500 -500) | |
904 | ("\\/" -500 -500) | |
905 | ("*" -400 -400) | |
906 | ("/" -400 -400) | |
907 | ("//" -400 -400) | |
908 | ("rem" -400 -400) | |
909 | ("mod" -400 -400) | |
910 | ("<<" -400 -400) | |
911 | (">>" -400 -400) | |
912 | ("**" -200 -200) | |
913 | ("^" -200 -200) | |
914 | ;; Prefix | |
915 | ;; ("+" 200 200) | |
916 | ;; ("-" 200 200) | |
917 | ;; ("\\" 200 200) | |
918 | (:smie-closer-alist (t . ".")) | |
919 | ) | |
920 | "Precedence levels of infix operators.") | |
921 | ||
922 | (defun prolog-smie-rules (kind token) | |
923 | (pcase (cons kind token) | |
924 | (`(:elem . basic) prolog-indent-width) | |
925 | (`(:after . ".") '(column . 0)) ;; To work around smie-closer-alist. | |
eb89dc14 SM |
926 | ;; Allow indentation of if-then-else as: |
927 | ;; ( test | |
928 | ;; -> thenrule | |
929 | ;; ; elserule | |
930 | ;; ) | |
931 | (`(:before . ,(or `"->" `";")) | |
932 | (and (smie-rule-bolp) (smie-rule-parent-p "(") (smie-rule-parent 1))) | |
2171cea5 | 933 | (`(:after . ,(or `":-" `"->" `"-->")) prolog-indent-width))) |
e2019526 SB |
934 | |
935 | \f | |
936 | ;;------------------------------------------------------------------- | |
937 | ;; Prolog mode | |
938 | ;;------------------------------------------------------------------- | |
939 | ||
940 | ;; Example: (prolog-atleast-version '(3 . 6)) | |
941 | (defun prolog-atleast-version (version) | |
942 | "Return t if the version of the current prolog system is VERSION or later. | |
943 | VERSION is of the format (Major . Minor)" | |
944 | ;; Version.major < major or | |
945 | ;; Version.major = major and Version.minor <= minor | |
946 | (let* ((thisversion (prolog-find-value-by-system prolog-system-version)) | |
947 | (thismajor (car thisversion)) | |
948 | (thisminor (cdr thisversion))) | |
949 | (or (< (car version) thismajor) | |
950 | (and (= (car version) thismajor) | |
951 | (<= (cdr version) thisminor))) | |
952 | )) | |
953 | ||
e2019526 SB |
954 | (define-abbrev-table 'prolog-mode-abbrev-table ()) |
955 | ||
956 | (defun prolog-find-value-by-system (alist) | |
957 | "Get value from ALIST according to `prolog-system'." | |
01c63f4c | 958 | (let ((system (or prolog-system |
5c3fe83f SM |
959 | (let ((infbuf (prolog-inferior-buffer 'dont-run))) |
960 | (when infbuf | |
961 | (buffer-local-value 'prolog-system infbuf)))))) | |
01c63f4c SM |
962 | (if (listp alist) |
963 | (let (result | |
964 | id) | |
965 | (while alist | |
966 | (setq id (car (car alist))) | |
967 | (if (or (eq id system) | |
968 | (eq id t) | |
969 | (and (listp id) | |
970 | (eval id))) | |
971 | (progn | |
972 | (setq result (car (cdr (car alist)))) | |
973 | (if (and (listp result) | |
974 | (eq (car result) 'eval)) | |
975 | (setq result (eval (car (cdr result))))) | |
976 | (setq alist nil)) | |
977 | (setq alist (cdr alist)))) | |
978 | result) | |
979 | alist))) | |
5ad4bef5 | 980 | |
dbed16aa SM |
981 | (defconst prolog-syntax-propertize-function |
982 | (when (fboundp 'syntax-propertize-rules) | |
983 | (syntax-propertize-rules | |
984 | ;; GNU Prolog only accepts 0'\' rather than 0'', but the only | |
985 | ;; possible meaning of 0'' is rather clear. | |
986 | ("\\<0\\(''?\\)" | |
987 | (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) | |
988 | (string-to-syntax "_")))) | |
989 | ;; We could check that we're not inside an atom, but I don't think | |
990 | ;; that 'foo 8'z could be a valid syntax anyway, so why bother? | |
991 | ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_")) | |
992 | ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal | |
993 | ;; escape sequences in atoms, so be careful not to let the terminating \ | |
994 | ;; escape a subsequent quote. | |
995 | ("\\\\[x0-7][0-9a-fA-F]*\\(\\\\\\)" (1 "_")) | |
996 | ))) | |
997 | ||
d8025917 | 998 | (defun prolog-mode-variables () |
e2019526 | 999 | "Set some common variables to Prolog code specific values." |
eb89dc14 SM |
1000 | (setq-local local-abbrev-table prolog-mode-abbrev-table) |
1001 | (setq-local paragraph-start (concat "[ \t]*$\\|" page-delimiter)) ;'%%..' | |
1002 | (setq-local paragraph-separate paragraph-start) | |
1003 | (setq-local paragraph-ignore-fill-prefix t) | |
1004 | (setq-local normal-auto-fill-function 'prolog-do-auto-fill) | |
1005 | (setq-local comment-start "%") | |
1006 | (setq-local comment-end "") | |
1007 | (setq-local comment-add 1) | |
1008 | (setq-local comment-start-skip "\\(?:/\\*+ *\\|%%+ *\\)") | |
1009 | (setq-local parens-require-spaces nil) | |
e2019526 | 1010 | ;; Initialize Prolog system specific variables |
dbed16aa SM |
1011 | (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators |
1012 | prolog-determinism-specificators prolog-directives | |
01c63f4c SM |
1013 | prolog-eof-string |
1014 | ;; prolog-continued-prompt-regexp | |
dbed16aa SM |
1015 | prolog-help-function)) |
1016 | (set (intern (concat (symbol-name var) "-i")) | |
1017 | (prolog-find-value-by-system (symbol-value var)))) | |
01c63f4c | 1018 | (when (null (prolog-program-name)) |
eb89dc14 SM |
1019 | (setq-local compile-command (prolog-compile-string))) |
1020 | (setq-local font-lock-defaults | |
1021 | '(prolog-font-lock-keywords nil nil ((?_ . "w")))) | |
1022 | (setq-local syntax-propertize-function prolog-syntax-propertize-function) | |
1023 | ||
1024 | (smie-setup prolog-smie-grammar #'prolog-smie-rules | |
1025 | :forward-token #'prolog-smie-forward-token | |
1026 | :backward-token #'prolog-smie-backward-token)) | |
e2019526 SB |
1027 | |
1028 | (defun prolog-mode-keybindings-common (map) | |
1029 | "Define keybindings common to both Prolog modes in MAP." | |
1030 | (define-key map "\C-c?" 'prolog-help-on-predicate) | |
1031 | (define-key map "\C-c/" 'prolog-help-apropos) | |
1032 | (define-key map "\C-c\C-d" 'prolog-debug-on) | |
1033 | (define-key map "\C-c\C-t" 'prolog-trace-on) | |
01c63f4c | 1034 | (define-key map "\C-c\C-z" 'prolog-zip-on) |
e2019526 SB |
1035 | (define-key map "\C-c\r" 'run-prolog)) |
1036 | ||
1037 | (defun prolog-mode-keybindings-edit (map) | |
1038 | "Define keybindings for Prolog mode in MAP." | |
1039 | (define-key map "\M-a" 'prolog-beginning-of-clause) | |
1040 | (define-key map "\M-e" 'prolog-end-of-clause) | |
1041 | (define-key map "\M-q" 'prolog-fill-paragraph) | |
1042 | (define-key map "\C-c\C-a" 'align) | |
1043 | (define-key map "\C-\M-a" 'prolog-beginning-of-predicate) | |
1044 | (define-key map "\C-\M-e" 'prolog-end-of-predicate) | |
1045 | (define-key map "\M-\C-c" 'prolog-mark-clause) | |
1046 | (define-key map "\M-\C-h" 'prolog-mark-predicate) | |
e2019526 SB |
1047 | (define-key map "\C-c\C-n" 'prolog-insert-predicate-template) |
1048 | (define-key map "\C-c\C-s" 'prolog-insert-predspec) | |
1049 | (define-key map "\M-\r" 'prolog-insert-next-clause) | |
1050 | (define-key map "\C-c\C-va" 'prolog-variables-to-anonymous) | |
1051 | (define-key map "\C-c\C-v\C-s" 'prolog-view-predspec) | |
1052 | ||
e2019526 SB |
1053 | ;; If we're running SICStus, then map C-c C-c e/d to enabling |
1054 | ;; and disabling of the source-level debugging facilities. | |
1055 | ;(if (and (eq prolog-system 'sicstus) | |
1056 | ; (prolog-atleast-version '(3 . 7))) | |
1057 | ; (progn | |
1058 | ; (define-key map "\C-c\C-ce" 'prolog-enable-sicstus-sd) | |
1059 | ; (define-key map "\C-c\C-cd" 'prolog-disable-sicstus-sd) | |
1060 | ; )) | |
1061 | ||
1062 | (if prolog-old-sicstus-keys-flag | |
1063 | (progn | |
1064 | (define-key map "\C-c\C-c" 'prolog-consult-predicate) | |
1065 | (define-key map "\C-cc" 'prolog-consult-region) | |
1066 | (define-key map "\C-cC" 'prolog-consult-buffer) | |
1067 | (define-key map "\C-c\C-k" 'prolog-compile-predicate) | |
1068 | (define-key map "\C-ck" 'prolog-compile-region) | |
1069 | (define-key map "\C-cK" 'prolog-compile-buffer)) | |
1070 | (define-key map "\C-c\C-p" 'prolog-consult-predicate) | |
1071 | (define-key map "\C-c\C-r" 'prolog-consult-region) | |
1072 | (define-key map "\C-c\C-b" 'prolog-consult-buffer) | |
1073 | (define-key map "\C-c\C-f" 'prolog-consult-file) | |
1074 | (define-key map "\C-c\C-cp" 'prolog-compile-predicate) | |
1075 | (define-key map "\C-c\C-cr" 'prolog-compile-region) | |
1076 | (define-key map "\C-c\C-cb" 'prolog-compile-buffer) | |
04380ff1 | 1077 | (define-key map "\C-c\C-cf" 'prolog-compile-file)) |
dbed16aa | 1078 | |
04380ff1 SM |
1079 | ;; Inherited from the old prolog.el. |
1080 | (define-key map "\e\C-x" 'prolog-consult-region) | |
1081 | (define-key map "\C-c\C-l" 'prolog-consult-file) | |
1082 | (define-key map "\C-c\C-z" 'switch-to-prolog)) | |
e2019526 | 1083 | |
e02f48d7 | 1084 | (defun prolog-mode-keybindings-inferior (_map) |
e2019526 SB |
1085 | "Define keybindings for inferior Prolog mode in MAP." |
1086 | ;; No inferior mode specific keybindings now. | |
1087 | ) | |
1088 | ||
04380ff1 SM |
1089 | (defvar prolog-mode-map |
1090 | (let ((map (make-sparse-keymap))) | |
1091 | (prolog-mode-keybindings-common map) | |
1092 | (prolog-mode-keybindings-edit map) | |
1093 | map)) | |
dbed16aa | 1094 | |
e2019526 SB |
1095 | |
1096 | (defvar prolog-mode-hook nil | |
0b381c7e | 1097 | "List of functions to call after the prolog mode has initialized.") |
d8025917 | 1098 | |
f9f9507e | 1099 | ;;;###autoload |
04380ff1 | 1100 | (define-derived-mode prolog-mode prog-mode "Prolog" |
e2019526 SB |
1101 | "Major mode for editing Prolog code. |
1102 | ||
1103 | Blank lines and `%%...' separate paragraphs. `%'s starts a comment | |
1104 | line and comments can also be enclosed in /* ... */. | |
1105 | ||
1106 | If an optional argument SYSTEM is non-nil, set up mode for the given system. | |
1107 | ||
1108 | To find out what version of Prolog mode you are running, enter | |
1109 | `\\[prolog-mode-version]'. | |
1110 | ||
d8025917 | 1111 | Commands: |
ae1f1ce1 | 1112 | \\{prolog-mode-map}" |
e2019526 SB |
1113 | (setq mode-name (concat "Prolog" |
1114 | (cond | |
1115 | ((eq prolog-system 'eclipse) "[ECLiPSe]") | |
e2019526 SB |
1116 | ((eq prolog-system 'sicstus) "[SICStus]") |
1117 | ((eq prolog-system 'swi) "[SWI]") | |
1118 | ((eq prolog-system 'gnu) "[GNU]") | |
1119 | (t "")))) | |
d8025917 | 1120 | (prolog-mode-variables) |
e2019526 | 1121 | (dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar)) |
eb89dc14 | 1122 | (add-hook 'post-self-insert-hook #'prolog-post-self-insert nil t) |
2171cea5 | 1123 | ;; `imenu' entry moved to the appropriate hook for consistency. |
dbed16aa | 1124 | |
e2019526 SB |
1125 | ;; Load SICStus debugger if suitable |
1126 | (if (and (eq prolog-system 'sicstus) | |
1127 | (prolog-atleast-version '(3 . 7)) | |
1128 | prolog-use-sicstus-sd) | |
dbed16aa SM |
1129 | (prolog-enable-sicstus-sd)) |
1130 | ||
1131 | (prolog-menu)) | |
04380ff1 SM |
1132 | |
1133 | (defvar mercury-mode-map | |
1134 | (let ((map (make-sparse-keymap))) | |
1135 | (set-keymap-parent map prolog-mode-map) | |
1136 | map)) | |
e2019526 SB |
1137 | |
1138 | ;;;###autoload | |
04380ff1 | 1139 | (define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]" |
e2019526 SB |
1140 | "Major mode for editing Mercury programs. |
1141 | Actually this is just customized `prolog-mode'." | |
eb89dc14 | 1142 | (setq-local prolog-system 'mercury)) |
e2019526 | 1143 | |
d8025917 | 1144 | \f |
e2019526 SB |
1145 | ;;------------------------------------------------------------------- |
1146 | ;; Inferior prolog mode | |
1147 | ;;------------------------------------------------------------------- | |
1148 | ||
04380ff1 SM |
1149 | (defvar prolog-inferior-mode-map |
1150 | (let ((map (make-sparse-keymap))) | |
1151 | (prolog-mode-keybindings-common map) | |
1152 | (prolog-mode-keybindings-inferior map) | |
01c63f4c SM |
1153 | (define-key map [remap self-insert-command] |
1154 | 'prolog-inferior-self-insert-command) | |
04380ff1 | 1155 | map)) |
dbed16aa | 1156 | |
e2019526 | 1157 | (defvar prolog-inferior-mode-hook nil |
0b381c7e | 1158 | "List of functions to call after the inferior prolog mode has initialized.") |
e2019526 | 1159 | |
01c63f4c SM |
1160 | (defvar prolog-inferior-error-regexp-alist |
1161 | '(;; GNU Prolog used to not follow the GNU standard format. | |
1162 | ;; ("^\\(.*?\\):\\([0-9]+\\) error: .*(char:\\([0-9]+\\)" 1 2 3) | |
1163 | ;; SWI-Prolog. | |
1164 | ("^\\(?:\\?- *\\)?\\(\\(?:ERROR\\|\\(W\\)arning\\): *\\(.*?\\):\\([1-9][0-9]*\\):\\(?:\\([0-9]*\\):\\)?\\)\\(?:$\\| \\)" | |
1165 | 3 4 5 (2 . nil) 1) | |
1166 | ;; GNU-Prolog now uses the GNU standard format. | |
1167 | gnu)) | |
1168 | ||
1169 | (defun prolog-inferior-self-insert-command () | |
1170 | "Insert the char in the buffer or pass it directly to the process." | |
1171 | (interactive) | |
1172 | (let* ((proc (get-buffer-process (current-buffer))) | |
1173 | (pmark (and proc (marker-position (process-mark proc))))) | |
1174 | ;; FIXME: the same treatment would be needed for SWI-Prolog, but I can't | |
1175 | ;; seem to find any way for Emacs to figure out when to use it because | |
1176 | ;; SWI doesn't include a " ? " or some such recognizable marker. | |
1177 | (if (and (eq prolog-system 'gnu) | |
1178 | pmark | |
1179 | (null current-prefix-arg) | |
1180 | (eobp) | |
1181 | (eq (point) pmark) | |
1182 | (save-excursion | |
1183 | (goto-char (- pmark 3)) | |
1184 | ;; FIXME: check this comes from the process's output, maybe? | |
1185 | (looking-at " \\? "))) | |
1186 | ;; This is GNU prolog waiting to know whether you want more answers | |
1187 | ;; or not (or abort, etc...). The answer is a single char, not | |
1188 | ;; a line, so pass this char directly rather than wait for RET to | |
1189 | ;; send a whole line. | |
1190 | (comint-send-string proc (string last-command-event)) | |
1191 | (call-interactively 'self-insert-command)))) | |
1192 | ||
135dee55 GM |
1193 | (declare-function 'compilation-shell-minor-mode "compile" (&optional arg)) |
1194 | (defvar compilation-error-regexp-alist) | |
01c63f4c | 1195 | |
04380ff1 | 1196 | (define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog" |
d8025917 | 1197 | "Major mode for interacting with an inferior Prolog process. |
1198 | ||
1199 | The following commands are available: | |
e2019526 | 1200 | \\{prolog-inferior-mode-map} |
d8025917 | 1201 | |
573f9b32 RS |
1202 | Entry to this mode calls the value of `prolog-mode-hook' with no arguments, |
1203 | if that value is non-nil. Likewise with the value of `comint-mode-hook'. | |
1204 | `prolog-mode-hook' is called after `comint-mode-hook'. | |
d8025917 | 1205 | |
e2019526 SB |
1206 | You can send text to the inferior Prolog from other buffers |
1207 | using the commands `send-region', `send-string' and \\[prolog-consult-region]. | |
d8025917 | 1208 | |
1209 | Commands: | |
1210 | Tab indents for Prolog; with argument, shifts rest | |
1211 | of expression rigidly with the current line. | |
e2019526 | 1212 | Paragraphs are separated only by blank lines and '%%'. '%'s start comments. |
d8025917 | 1213 | |
1214 | Return at end of buffer sends line as input. | |
1215 | Return not at end copies rest of line to end and sends it. | |
e2019526 SB |
1216 | \\[comint-delchar-or-maybe-eof] sends end-of-file as input. |
1217 | \\[comint-kill-input] and \\[backward-kill-word] are kill commands, | |
1218 | imitating normal Unix input editing. | |
d8025917 | 1219 | \\[comint-interrupt-subjob] interrupts the shell or its current subjob if any. |
e2019526 SB |
1220 | \\[comint-stop-subjob] stops, likewise. |
1221 | \\[comint-quit-subjob] sends quit signal, likewise. | |
1222 | ||
1223 | To find out what version of Prolog mode you are running, enter | |
1224 | `\\[prolog-mode-version]'." | |
135dee55 | 1225 | (require 'compile) |
04380ff1 SM |
1226 | (setq comint-input-filter 'prolog-input-filter) |
1227 | (setq mode-line-process '(": %s")) | |
1228 | (prolog-mode-variables) | |
01c63f4c | 1229 | (setq comint-prompt-regexp (prolog-prompt-regexp)) |
eb89dc14 SM |
1230 | (setq-local shell-dirstack-query "pwd.") |
1231 | (setq-local compilation-error-regexp-alist | |
1232 | prolog-inferior-error-regexp-alist) | |
01c63f4c | 1233 | (compilation-shell-minor-mode) |
dbed16aa | 1234 | (prolog-inferior-menu)) |
e2019526 SB |
1235 | |
1236 | (defun prolog-input-filter (str) | |
1237 | (cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace | |
01c63f4c | 1238 | ((not (derived-mode-p 'prolog-inferior-mode)) t) |
e2019526 SB |
1239 | ((= (length str) 1) nil) ;one character |
1240 | ((string-match "\\`[rf] *[0-9]*\\'" str) nil) ;r(edo) or f(ail) | |
1241 | (t t))) | |
23f2d048 | 1242 | |
f9f9507e | 1243 | ;;;###autoload |
e2019526 | 1244 | (defun run-prolog (arg) |
d364dee6 | 1245 | "Run an inferior Prolog process, input and output via buffer *prolog*. |
e2019526 SB |
1246 | With prefix argument ARG, restart the Prolog process if running before." |
1247 | (interactive "P") | |
01c63f4c SM |
1248 | ;; FIXME: It should be possible to interactively specify the command to use |
1249 | ;; to run prolog. | |
e2019526 SB |
1250 | (if (and arg (get-process "prolog")) |
1251 | (progn | |
1252 | (process-send-string "prolog" "halt.\n") | |
1253 | (while (get-process "prolog") (sit-for 0.1)))) | |
1254 | (let ((buff (buffer-name))) | |
1255 | (if (not (string= buff "*prolog*")) | |
1256 | (prolog-goto-prolog-process-buffer)) | |
1257 | ;; Load SICStus debugger if suitable | |
1258 | (if (and (eq prolog-system 'sicstus) | |
1259 | (prolog-atleast-version '(3 . 7)) | |
1260 | prolog-use-sicstus-sd) | |
1261 | (prolog-enable-sicstus-sd)) | |
1262 | (prolog-mode-variables) | |
1263 | (prolog-ensure-process) | |
1264 | )) | |
1265 | ||
01c63f4c | 1266 | (defun prolog-inferior-guess-flavor (&optional ignored) |
eb89dc14 SM |
1267 | (setq-local prolog-system |
1268 | (when (or (numberp prolog-system) (markerp prolog-system)) | |
1269 | (save-excursion | |
1270 | (goto-char (1+ prolog-system)) | |
1271 | (cond | |
1272 | ((looking-at "GNU Prolog") 'gnu) | |
1273 | ((looking-at "Welcome to SWI-Prolog\\|%.*\\<swi_") 'swi) | |
1274 | ((looking-at ".*\n") nil) ;There's at least one line. | |
1275 | (t prolog-system))))) | |
01c63f4c SM |
1276 | (when (symbolp prolog-system) |
1277 | (remove-hook 'comint-output-filter-functions | |
1278 | 'prolog-inferior-guess-flavor t) | |
1279 | (when prolog-system | |
1280 | (setq comint-prompt-regexp (prolog-prompt-regexp)) | |
1281 | (if (eq prolog-system 'gnu) | |
eb89dc14 | 1282 | (setq-local comint-process-echoes t))))) |
01c63f4c | 1283 | |
e2019526 SB |
1284 | (defun prolog-ensure-process (&optional wait) |
1285 | "If Prolog process is not running, run it. | |
1286 | If the optional argument WAIT is non-nil, wait for Prolog prompt specified by | |
1287 | the variable `prolog-prompt-regexp'." | |
01c63f4c | 1288 | (if (null (prolog-program-name)) |
e2019526 SB |
1289 | (error "This Prolog system has defined no interpreter.")) |
1290 | (if (comint-check-proc "*prolog*") | |
1291 | () | |
01c63f4c | 1292 | (with-current-buffer (get-buffer-create "*prolog*") |
e2019526 | 1293 | (prolog-inferior-mode) |
01c63f4c SM |
1294 | (apply 'make-comint-in-buffer "prolog" (current-buffer) |
1295 | (prolog-program-name) nil (prolog-program-switches)) | |
1296 | (unless prolog-system | |
1297 | ;; Setup auto-detection. | |
eb89dc14 SM |
1298 | (setq-local |
1299 | prolog-system | |
1300 | ;; Force re-detection. | |
1301 | (let* ((proc (get-buffer-process (current-buffer))) | |
1302 | (pmark (and proc (marker-position (process-mark proc))))) | |
1303 | (cond | |
1304 | ((null pmark) (1- (point-min))) | |
1305 | ;; The use of insert-before-markers in comint.el together with | |
1306 | ;; the potential use of comint-truncate-buffer in the output | |
1307 | ;; filter, means that it's difficult to reliably keep track of | |
1308 | ;; the buffer position where the process's output started. | |
1309 | ;; If possible we use a marker at "start - 1", so that | |
1310 | ;; insert-before-marker at `start' won't shift it. And if not, | |
1311 | ;; we fall back on using a plain integer. | |
1312 | ((> pmark (point-min)) (copy-marker (1- pmark))) | |
1313 | (t (1- pmark))))) | |
01c63f4c SM |
1314 | (add-hook 'comint-output-filter-functions |
1315 | 'prolog-inferior-guess-flavor nil t)) | |
e2019526 SB |
1316 | (if wait |
1317 | (progn | |
1318 | (goto-char (point-max)) | |
1319 | (while | |
1320 | (save-excursion | |
1321 | (not | |
1322 | (re-search-backward | |
01c63f4c | 1323 | (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=") |
e2019526 SB |
1324 | nil t))) |
1325 | (sit-for 0.1))))))) | |
1326 | ||
01c63f4c SM |
1327 | (defun prolog-inferior-buffer (&optional dont-run) |
1328 | (or (get-buffer "*prolog*") | |
1329 | (unless dont-run | |
1330 | (prolog-ensure-process) | |
1331 | (get-buffer "*prolog*")))) | |
1332 | ||
e2019526 SB |
1333 | (defun prolog-process-insert-string (process string) |
1334 | "Insert STRING into inferior Prolog buffer running PROCESS." | |
1335 | ;; Copied from elisp manual, greek to me | |
04380ff1 SM |
1336 | (with-current-buffer (process-buffer process) |
1337 | ;; FIXME: Use window-point-insertion-type instead. | |
1338 | (let ((moving (= (point) (process-mark process)))) | |
1339 | (save-excursion | |
1340 | ;; Insert the text, moving the process-marker. | |
1341 | (goto-char (process-mark process)) | |
1342 | (insert string) | |
1343 | (set-marker (process-mark process) (point))) | |
1344 | (if moving (goto-char (process-mark process)))))) | |
e2019526 SB |
1345 | \f |
1346 | ;;------------------------------------------------------------ | |
1347 | ;; Old consulting and compiling functions | |
1348 | ;;------------------------------------------------------------ | |
1349 | ||
135dee55 GM |
1350 | (declare-function compilation-forget-errors "compile" ()) |
1351 | (declare-function compilation-fake-loc "compile" | |
1352 | (marker file &optional line col)) | |
1353 | ||
e2019526 SB |
1354 | (defun prolog-old-process-region (compilep start end) |
1355 | "Process the region limited by START and END positions. | |
1356 | If COMPILEP is non-nil then use compilation, otherwise consulting." | |
1357 | (prolog-ensure-process) | |
1358 | ;(let ((tmpfile prolog-temp-filename) | |
01c63f4c | 1359 | (let ((tmpfile (prolog-temporary-file)) |
e2019526 | 1360 | ;(process (get-process "prolog")) |
dbed16aa SM |
1361 | (first-line (1+ (count-lines |
1362 | (point-min) | |
e2019526 SB |
1363 | (save-excursion |
1364 | (goto-char start) | |
1365 | (point)))))) | |
1366 | (write-region start end tmpfile) | |
01c63f4c SM |
1367 | (setq start (copy-marker start)) |
1368 | (with-current-buffer (prolog-inferior-buffer) | |
1369 | (compilation-forget-errors) | |
1370 | (compilation-fake-loc start tmpfile)) | |
e2019526 SB |
1371 | (process-send-string |
1372 | "prolog" (prolog-build-prolog-command | |
1373 | compilep tmpfile (prolog-bsts buffer-file-name) | |
1374 | first-line)) | |
1375 | (prolog-goto-prolog-process-buffer))) | |
1376 | ||
1377 | (defun prolog-old-process-predicate (compilep) | |
1378 | "Process the predicate around point. | |
1379 | If COMPILEP is non-nil then use compilation, otherwise consulting." | |
1380 | (prolog-old-process-region | |
1381 | compilep (prolog-pred-start) (prolog-pred-end))) | |
1382 | ||
1383 | (defun prolog-old-process-buffer (compilep) | |
1384 | "Process the entire buffer. | |
1385 | If COMPILEP is non-nil then use compilation, otherwise consulting." | |
1386 | (prolog-old-process-region compilep (point-min) (point-max))) | |
1387 | ||
1388 | (defun prolog-old-process-file (compilep) | |
1389 | "Process the file of the current buffer. | |
1390 | If COMPILEP is non-nil then use compilation, otherwise consulting." | |
1391 | (save-some-buffers) | |
1392 | (prolog-ensure-process) | |
01c63f4c SM |
1393 | (with-current-buffer (prolog-inferior-buffer) |
1394 | (compilation-forget-errors)) | |
e2019526 | 1395 | (process-send-string |
dbed16aa | 1396 | "prolog" (prolog-build-prolog-command |
01c63f4c SM |
1397 | compilep buffer-file-name |
1398 | (prolog-bsts buffer-file-name))) | |
1399 | (prolog-goto-prolog-process-buffer)) | |
e2019526 SB |
1400 | |
1401 | \f | |
1402 | ;;------------------------------------------------------------ | |
1403 | ;; Consulting and compiling | |
1404 | ;;------------------------------------------------------------ | |
1405 | ||
01c63f4c SM |
1406 | ;; Interactive interface functions, used by both the standard |
1407 | ;; and the experimental consultation and compilation functions | |
e2019526 SB |
1408 | (defun prolog-consult-file () |
1409 | "Consult file of current buffer." | |
1410 | (interactive) | |
1411 | (if prolog-use-standard-consult-compile-method-flag | |
1412 | (prolog-old-process-file nil) | |
1413 | (prolog-consult-compile-file nil))) | |
1414 | ||
1415 | (defun prolog-consult-buffer () | |
1416 | "Consult buffer." | |
1417 | (interactive) | |
1418 | (if prolog-use-standard-consult-compile-method-flag | |
1419 | (prolog-old-process-buffer nil) | |
1420 | (prolog-consult-compile-buffer nil))) | |
1421 | ||
1422 | (defun prolog-consult-region (beg end) | |
1423 | "Consult region between BEG and END." | |
1424 | (interactive "r") | |
1425 | (if prolog-use-standard-consult-compile-method-flag | |
1426 | (prolog-old-process-region nil beg end) | |
1427 | (prolog-consult-compile-region nil beg end))) | |
1428 | ||
1429 | (defun prolog-consult-predicate () | |
1430 | "Consult the predicate around current point." | |
1431 | (interactive) | |
1432 | (if prolog-use-standard-consult-compile-method-flag | |
1433 | (prolog-old-process-predicate nil) | |
1434 | (prolog-consult-compile-predicate nil))) | |
1435 | ||
1436 | (defun prolog-compile-file () | |
1437 | "Compile file of current buffer." | |
1438 | (interactive) | |
1439 | (if prolog-use-standard-consult-compile-method-flag | |
1440 | (prolog-old-process-file t) | |
1441 | (prolog-consult-compile-file t))) | |
1442 | ||
1443 | (defun prolog-compile-buffer () | |
1444 | "Compile buffer." | |
1445 | (interactive) | |
1446 | (if prolog-use-standard-consult-compile-method-flag | |
1447 | (prolog-old-process-buffer t) | |
1448 | (prolog-consult-compile-buffer t))) | |
1449 | ||
1450 | (defun prolog-compile-region (beg end) | |
1451 | "Compile region between BEG and END." | |
1452 | (interactive "r") | |
1453 | (if prolog-use-standard-consult-compile-method-flag | |
1454 | (prolog-old-process-region t beg end) | |
1455 | (prolog-consult-compile-region t beg end))) | |
1456 | ||
1457 | (defun prolog-compile-predicate () | |
1458 | "Compile the predicate around current point." | |
1459 | (interactive) | |
1460 | (if prolog-use-standard-consult-compile-method-flag | |
1461 | (prolog-old-process-predicate t) | |
1462 | (prolog-consult-compile-predicate t))) | |
1463 | ||
1464 | (defun prolog-buffer-module () | |
1465 | "Select Prolog module name appropriate for current buffer. | |
1466 | Bases decision on buffer contents (-*- line)." | |
1467 | ;; Look for -*- ... module: MODULENAME; ... -*- | |
1468 | (let (beg end) | |
1469 | (save-excursion | |
1470 | (goto-char (point-min)) | |
1471 | (skip-chars-forward " \t") | |
dbed16aa | 1472 | (and (search-forward "-*-" (line-end-position) t) |
e2019526 SB |
1473 | (progn |
1474 | (skip-chars-forward " \t") | |
1475 | (setq beg (point)) | |
dbed16aa | 1476 | (search-forward "-*-" (line-end-position) t)) |
e2019526 SB |
1477 | (progn |
1478 | (forward-char -3) | |
1479 | (skip-chars-backward " \t") | |
1480 | (setq end (point)) | |
1481 | (goto-char beg) | |
1482 | (and (let ((case-fold-search t)) | |
1483 | (search-forward "module:" end t)) | |
1484 | (progn | |
1485 | (skip-chars-forward " \t") | |
1486 | (setq beg (point)) | |
1487 | (if (search-forward ";" end t) | |
1488 | (forward-char -1) | |
1489 | (goto-char end)) | |
1490 | (skip-chars-backward " \t") | |
1491 | (buffer-substring beg (point))))))))) | |
1492 | ||
dbed16aa | 1493 | (defun prolog-build-prolog-command (compilep file buffername |
e2019526 SB |
1494 | &optional first-line) |
1495 | "Make Prolog command for FILE compilation/consulting. | |
1496 | If COMPILEP is non-nil, consider compilation, otherwise consulting." | |
1497 | (let* ((compile-string | |
01c63f4c SM |
1498 | ;; FIXME: If the process is not running yet, the auto-detection of |
1499 | ;; prolog-system won't help here, so we should make sure | |
1500 | ;; we first run Prolog and then build the command. | |
1501 | (if compilep (prolog-compile-string) (prolog-consult-string))) | |
e2019526 | 1502 | (module (prolog-buffer-module)) |
01c63f4c | 1503 | (file-name (concat "'" (prolog-bsts file) "'")) |
e2019526 SB |
1504 | (module-name (if module (concat "'" module "'"))) |
1505 | (module-file (if module | |
1506 | (concat module-name ":" file-name) | |
1507 | file-name)) | |
1508 | strbeg strend | |
1509 | (lineoffset (if first-line | |
1510 | (- first-line 1) | |
1511 | 0))) | |
1512 | ||
1513 | ;; Assure that there is a buffer name | |
1514 | (if (not buffername) | |
1515 | (error "The buffer is not saved")) | |
1516 | ||
dbed16aa | 1517 | (if (not (string-match "\\`'.*'\\'" buffername)) ; Add quotes |
e2019526 SB |
1518 | (setq buffername (concat "'" buffername "'"))) |
1519 | (while (string-match "%m" compile-string) | |
1520 | (setq strbeg (substring compile-string 0 (match-beginning 0))) | |
1521 | (setq strend (substring compile-string (match-end 0))) | |
1522 | (setq compile-string (concat strbeg module-file strend))) | |
dbed16aa SM |
1523 | ;; FIXME: The code below will %-expand any %[fbl] that appears in |
1524 | ;; module-file. | |
e2019526 SB |
1525 | (while (string-match "%f" compile-string) |
1526 | (setq strbeg (substring compile-string 0 (match-beginning 0))) | |
1527 | (setq strend (substring compile-string (match-end 0))) | |
1528 | (setq compile-string (concat strbeg file-name strend))) | |
1529 | (while (string-match "%b" compile-string) | |
1530 | (setq strbeg (substring compile-string 0 (match-beginning 0))) | |
1531 | (setq strend (substring compile-string (match-end 0))) | |
1532 | (setq compile-string (concat strbeg buffername strend))) | |
1533 | (while (string-match "%l" compile-string) | |
1534 | (setq strbeg (substring compile-string 0 (match-beginning 0))) | |
1535 | (setq strend (substring compile-string (match-end 0))) | |
1536 | (setq compile-string (concat strbeg (format "%d" lineoffset) strend))) | |
1537 | (concat compile-string "\n"))) | |
1538 | ||
01c63f4c | 1539 | ;; The rest of this page is experimental code! |
e2019526 SB |
1540 | |
1541 | ;; Global variables for process filter function | |
1542 | (defvar prolog-process-flag nil | |
dbed16aa | 1543 | "Non-nil means that a prolog task (i.e. a consultation or compilation job) |
e2019526 SB |
1544 | is running.") |
1545 | (defvar prolog-consult-compile-output "" | |
1546 | "Hold the unprocessed output from the current prolog task.") | |
1547 | (defvar prolog-consult-compile-first-line 1 | |
1548 | "The number of the first line of the file to consult/compile. | |
1549 | Used for temporary files.") | |
1550 | (defvar prolog-consult-compile-file nil | |
1551 | "The file to compile/consult (can be a temporary file).") | |
1552 | (defvar prolog-consult-compile-real-file nil | |
1553 | "The file name of the buffer to compile/consult.") | |
1554 | ||
135dee55 GM |
1555 | (defvar compilation-parse-errors-function) |
1556 | ||
e2019526 SB |
1557 | (defun prolog-consult-compile (compilep file &optional first-line) |
1558 | "Consult/compile FILE. | |
1559 | If COMPILEP is non-nil, perform compilation, otherwise perform CONSULTING. | |
1560 | COMMAND is a string described by the variables `prolog-consult-string' | |
1561 | and `prolog-compile-string'. | |
1562 | Optional argument FIRST-LINE is the number of the first line in the compiled | |
1563 | region. | |
1564 | ||
1565 | This function must be called from the source code buffer." | |
1566 | (if prolog-process-flag | |
1567 | (error "Another Prolog task is running.")) | |
1568 | (prolog-ensure-process t) | |
1569 | (let* ((buffer (get-buffer-create prolog-compilation-buffer)) | |
1570 | (real-file buffer-file-name) | |
dbed16aa | 1571 | (command-string (prolog-build-prolog-command compilep file |
e2019526 | 1572 | real-file first-line)) |
e3eb1bb7 | 1573 | (process (get-process "prolog"))) |
04380ff1 | 1574 | (with-current-buffer buffer |
e2019526 | 1575 | (delete-region (point-min) (point-max)) |
01c63f4c | 1576 | ;; FIXME: Wasn't this supposed to use prolog-inferior-mode? |
e2019526 | 1577 | (compilation-mode) |
01c63f4c | 1578 | ;; FIXME: This doesn't seem to cooperate well with new(ish) compile.el. |
e2019526 | 1579 | ;; Setting up font-locking for this buffer |
eb89dc14 SM |
1580 | (setq-local font-lock-defaults |
1581 | '(prolog-font-lock-keywords nil nil ((?_ . "w")))) | |
e2019526 | 1582 | (if (eq prolog-system 'sicstus) |
01c63f4c SM |
1583 | ;; FIXME: This looks really problematic: not only is this using |
1584 | ;; the old compilation-parse-errors-function, but | |
1585 | ;; prolog-parse-sicstus-compilation-errors only accepts one argument | |
1586 | ;; whereas compile.el calls it with 2 (and did so at least since | |
1587 | ;; Emacs-20). | |
eb89dc14 SM |
1588 | (setq-local compilation-parse-errors-function |
1589 | 'prolog-parse-sicstus-compilation-errors)) | |
5c3fe83f | 1590 | (setq buffer-read-only nil) |
e2019526 | 1591 | (insert command-string "\n")) |
e3eb1bb7 | 1592 | (display-buffer buffer) |
e2019526 SB |
1593 | (setq prolog-process-flag t |
1594 | prolog-consult-compile-output "" | |
1595 | prolog-consult-compile-first-line (if first-line (1- first-line) 0) | |
1596 | prolog-consult-compile-file file | |
dbed16aa | 1597 | prolog-consult-compile-real-file (if (string= |
e2019526 SB |
1598 | file buffer-file-name) |
1599 | nil | |
1600 | real-file)) | |
04380ff1 | 1601 | (with-current-buffer buffer |
e2019526 | 1602 | (goto-char (point-max)) |
bcd7a0a4 SM |
1603 | (add-function :override (process-filter process) |
1604 | #'prolog-consult-compile-filter) | |
e2019526 SB |
1605 | (process-send-string "prolog" command-string) |
1606 | ;; (prolog-build-prolog-command compilep file real-file first-line)) | |
1607 | (while (and prolog-process-flag | |
1608 | (accept-process-output process 10)) ; 10 secs is ok? | |
1609 | (sit-for 0.1) | |
1610 | (unless (get-process "prolog") | |
dbed16aa | 1611 | (setq prolog-process-flag nil))) |
e2019526 SB |
1612 | (insert (if compilep |
1613 | "\nCompilation finished.\n" | |
1614 | "\nConsulted.\n")) | |
bcd7a0a4 SM |
1615 | (remove-function (process-filter process) |
1616 | #'prolog-consult-compile-filter)))) | |
e2019526 | 1617 | |
135dee55 GM |
1618 | (defvar compilation-error-list) |
1619 | ||
e2019526 SB |
1620 | (defun prolog-parse-sicstus-compilation-errors (limit) |
1621 | "Parse the prolog compilation buffer for errors. | |
1622 | Argument LIMIT is a buffer position limiting searching. | |
1623 | For use with the `compilation-parse-errors-function' variable." | |
1624 | (setq compilation-error-list nil) | |
1625 | (message "Parsing SICStus error messages...") | |
1626 | (let (filepath dir file errorline) | |
dbed16aa | 1627 | (while |
e2019526 SB |
1628 | (re-search-backward |
1629 | "{\\([a-zA-Z ]* ERROR\\|Warning\\):.* in line[s ]*\\([0-9]+\\)" | |
1630 | limit t) | |
1631 | (setq errorline (string-to-number (match-string 2))) | |
1632 | (save-excursion | |
1633 | (re-search-backward | |
1634 | "{\\(consulting\\|compiling\\|processing\\) \\(.*\\)\\.\\.\\.}" | |
1635 | limit t) | |
1636 | (setq filepath (match-string 2))) | |
1637 | ||
2171cea5 SM |
1638 | ;; ###### Does this work with SICStus under Windows |
1639 | ;; (i.e. backslashes and stuff?) | |
e2019526 SB |
1640 | (if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath) |
1641 | (progn | |
1642 | (setq dir (match-string 1 filepath)) | |
1643 | (setq file (match-string 2 filepath)))) | |
1644 | ||
1645 | (setq compilation-error-list | |
1646 | (cons | |
1647 | (cons (save-excursion | |
1648 | (beginning-of-line) | |
1649 | (point-marker)) | |
1650 | (list (list file dir) errorline)) | |
1651 | compilation-error-list) | |
1652 | )) | |
1653 | )) | |
1654 | ||
1655 | (defun prolog-consult-compile-filter (process output) | |
1656 | "Filter function for Prolog compilation PROCESS. | |
1657 | Argument OUTPUT is a name of the output file." | |
1658 | ;;(message "start") | |
1659 | (setq prolog-consult-compile-output | |
1660 | (concat prolog-consult-compile-output output)) | |
1661 | ;;(message "pccf1: %s" prolog-consult-compile-output) | |
1662 | ;; Iterate through the lines of prolog-consult-compile-output | |
1663 | (let (outputtype) | |
1664 | (while (and prolog-process-flag | |
1665 | (or | |
1666 | ;; Trace question | |
dbed16aa | 1667 | (progn |
e2019526 SB |
1668 | (setq outputtype 'trace) |
1669 | (and (eq prolog-system 'sicstus) | |
1670 | (string-match | |
1671 | "^[ \t]*[0-9]+[ \t]*[0-9]+[ \t]*Call:.*? " | |
1672 | prolog-consult-compile-output))) | |
dbed16aa | 1673 | |
e2019526 | 1674 | ;; Match anything |
dbed16aa | 1675 | (progn |
e2019526 SB |
1676 | (setq outputtype 'normal) |
1677 | (string-match "^.*\n" prolog-consult-compile-output)) | |
1678 | )) | |
1679 | ;;(message "outputtype: %s" outputtype) | |
1680 | ||
1681 | (setq output (match-string 0 prolog-consult-compile-output)) | |
1682 | ;; remove the text in output from prolog-consult-compile-output | |
1683 | (setq prolog-consult-compile-output | |
1684 | (substring prolog-consult-compile-output (length output))) | |
1685 | ;;(message "pccf2: %s" prolog-consult-compile-output) | |
dbed16aa | 1686 | |
e2019526 SB |
1687 | ;; If temporary files were used, then we change the error |
1688 | ;; messages to point to the original source file. | |
01c63f4c | 1689 | ;; FIXME: Use compilation-fake-loc instead. |
e2019526 SB |
1690 | (cond |
1691 | ||
1692 | ;; If the prolog process was in trace mode then it requires | |
1693 | ;; user input | |
dbed16aa | 1694 | ((and (eq prolog-system 'sicstus) |
e2019526 | 1695 | (eq outputtype 'trace)) |
dbed16aa | 1696 | (let ((input (concat (read-string output) "\n"))) |
04380ff1 | 1697 | (process-send-string process input) |
e2019526 SB |
1698 | (setq output (concat output input)))) |
1699 | ||
1700 | ((eq prolog-system 'sicstus) | |
1701 | (if (and prolog-consult-compile-real-file | |
1702 | (string-match | |
1703 | "\\({.*:.* in line[s ]*\\)\\([0-9]+\\)-\\([0-9]+\\)" output)) | |
1704 | (setq output (replace-match | |
dbed16aa | 1705 | ;; Adds a {processing ...} line so that |
e2019526 SB |
1706 | ;; `prolog-parse-sicstus-compilation-errors' |
1707 | ;; finds the real file instead of the temporary one. | |
1708 | ;; Also fixes the line numbers. | |
1709 | (format "Added by Emacs: {processing %s...}\n%s%d-%d" | |
1710 | prolog-consult-compile-real-file | |
1711 | (match-string 1 output) | |
1712 | (+ prolog-consult-compile-first-line | |
1713 | (string-to-number | |
1714 | (match-string 2 output))) | |
1715 | (+ prolog-consult-compile-first-line | |
1716 | (string-to-number | |
1717 | (match-string 3 output)))) | |
1718 | t t output))) | |
1719 | ) | |
dbed16aa | 1720 | |
e2019526 SB |
1721 | ((eq prolog-system 'swi) |
1722 | (if (and prolog-consult-compile-real-file | |
1723 | (string-match (format | |
1724 | "%s\\([ \t]*:[ \t]*\\)\\([0-9]+\\)" | |
1725 | prolog-consult-compile-file) | |
1726 | output)) | |
1727 | (setq output (replace-match | |
1728 | ;; Real filename + text + fixed linenum | |
1729 | (format "%s%s%d" | |
1730 | prolog-consult-compile-real-file | |
1731 | (match-string 1 output) | |
1732 | (+ prolog-consult-compile-first-line | |
1733 | (string-to-number | |
1734 | (match-string 2 output)))) | |
1735 | t t output))) | |
1736 | ) | |
dbed16aa | 1737 | |
e2019526 SB |
1738 | (t ()) |
1739 | ) | |
1740 | ;; Write the output in the *prolog-compilation* buffer | |
1741 | (insert output))) | |
1742 | ||
1743 | ;; If the prompt is visible, then the task is finished | |
01c63f4c | 1744 | (if (string-match (prolog-prompt-regexp) prolog-consult-compile-output) |
e2019526 SB |
1745 | (setq prolog-process-flag nil))) |
1746 | ||
1747 | (defun prolog-consult-compile-file (compilep) | |
1748 | "Consult/compile file of current buffer. | |
1749 | If COMPILEP is non-nil, compile, otherwise consult." | |
1750 | (let ((file buffer-file-name)) | |
1751 | (if file | |
1752 | (progn | |
1753 | (save-some-buffers) | |
1754 | (prolog-consult-compile compilep file)) | |
1755 | (prolog-consult-compile-region compilep (point-min) (point-max))))) | |
1756 | ||
1757 | (defun prolog-consult-compile-buffer (compilep) | |
1758 | "Consult/compile current buffer. | |
1759 | If COMPILEP is non-nil, compile, otherwise consult." | |
1760 | (prolog-consult-compile-region compilep (point-min) (point-max))) | |
1761 | ||
1762 | (defun prolog-consult-compile-region (compilep beg end) | |
1763 | "Consult/compile region between BEG and END. | |
1764 | If COMPILEP is non-nil, compile, otherwise consult." | |
1765 | ;(let ((file prolog-temp-filename) | |
1766 | (let ((file (prolog-bsts (prolog-temporary-file))) | |
1767 | (lines (count-lines 1 beg))) | |
1768 | (write-region beg end file nil 'no-message) | |
1769 | (write-region "\n" nil file t 'no-message) | |
1770 | (prolog-consult-compile compilep file | |
01c63f4c | 1771 | (if (bolp) (1+ lines) lines)) |
e2019526 SB |
1772 | (delete-file file))) |
1773 | ||
1774 | (defun prolog-consult-compile-predicate (compilep) | |
1775 | "Consult/compile the predicate around current point. | |
1776 | If COMPILEP is non-nil, compile, otherwise consult." | |
1777 | (prolog-consult-compile-region | |
1778 | compilep (prolog-pred-start) (prolog-pred-end))) | |
1779 | ||
1780 | \f | |
1781 | ;;------------------------------------------------------------------- | |
1782 | ;; Font-lock stuff | |
1783 | ;;------------------------------------------------------------------- | |
1784 | ||
01c35094 | 1785 | ;; Auxiliary functions |
e2019526 SB |
1786 | |
1787 | (defun prolog-font-lock-object-matcher (bound) | |
1788 | "Find SICStus objects method name for font lock. | |
1789 | Argument BOUND is a buffer position limiting searching." | |
1790 | (let (point | |
dbed16aa | 1791 | (case-fold-search nil)) |
e2019526 SB |
1792 | (while (and (not point) |
1793 | (re-search-forward "\\(::[ \t\n]*{\\|&\\)[ \t]*" | |
1794 | bound t)) | |
1795 | (while (or (re-search-forward "\\=\n[ \t]*" bound t) | |
dbed16aa SM |
1796 | (re-search-forward "\\=%.*" bound t) |
1797 | (and (re-search-forward "\\=/\\*" bound t) | |
1798 | (re-search-forward "\\*/[ \t]*" bound t)))) | |
e2019526 SB |
1799 | (setq point (re-search-forward |
1800 | (format "\\=\\(%s\\)" prolog-atom-regexp) | |
1801 | bound t))) | |
1802 | point)) | |
1803 | ||
1804 | (defsubst prolog-face-name-p (facename) | |
1805 | ;; Return t if FACENAME is the name of a face. This method is | |
1806 | ;; necessary since facep in XEmacs only returns t for the actual | |
1807 | ;; face objects (while it's only their names that are used just | |
1808 | ;; about anywhere else) without providing a predicate that tests | |
1809 | ;; face names. This function (including the above commentary) is | |
1810 | ;; borrowed from cc-mode. | |
1811 | (memq facename (face-list))) | |
1812 | ||
1813 | ;; Set everything up | |
1814 | (defun prolog-font-lock-keywords () | |
1815 | "Set up font lock keywords for the current Prolog system." | |
eb89dc14 SM |
1816 | ;;(when window-system |
1817 | (require 'font-lock) | |
1818 | ||
1819 | ;; Define Prolog faces | |
1820 | (defface prolog-redo-face | |
1821 | '((((class grayscale)) (:italic t)) | |
1822 | (((class color)) (:foreground "darkorchid")) | |
1823 | (t (:italic t))) | |
1824 | "Prolog mode face for highlighting redo trace lines." | |
1825 | :group 'prolog-faces) | |
1826 | (defface prolog-exit-face | |
1827 | '((((class grayscale)) (:underline t)) | |
1828 | (((class color) (background dark)) (:foreground "green")) | |
1829 | (((class color) (background light)) (:foreground "ForestGreen")) | |
1830 | (t (:underline t))) | |
1831 | "Prolog mode face for highlighting exit trace lines." | |
1832 | :group 'prolog-faces) | |
1833 | (defface prolog-exception-face | |
1834 | '((((class grayscale)) (:bold t :italic t :underline t)) | |
1835 | (((class color)) (:bold t :foreground "black" :background "Khaki")) | |
1836 | (t (:bold t :italic t :underline t))) | |
1837 | "Prolog mode face for highlighting exception trace lines." | |
1838 | :group 'prolog-faces) | |
1839 | (defface prolog-warning-face | |
1840 | '((((class grayscale)) (:underline t)) | |
1841 | (((class color) (background dark)) (:foreground "blue")) | |
1842 | (((class color) (background light)) (:foreground "MidnightBlue")) | |
1843 | (t (:underline t))) | |
1844 | "Face name to use for compiler warnings." | |
1845 | :group 'prolog-faces) | |
1846 | (defface prolog-builtin-face | |
1847 | '((((class color) (background light)) (:foreground "Purple")) | |
1848 | (((class color) (background dark)) (:foreground "Cyan")) | |
1849 | (((class grayscale) (background light)) | |
1850 | :foreground "LightGray" :bold t) | |
1851 | (((class grayscale) (background dark)) (:foreground "DimGray" :bold t)) | |
1852 | (t (:bold t))) | |
1853 | "Face name to use for compiler warnings." | |
1854 | :group 'prolog-faces) | |
1855 | (defvar prolog-warning-face | |
1856 | (if (prolog-face-name-p 'font-lock-warning-face) | |
1857 | 'font-lock-warning-face | |
1858 | 'prolog-warning-face) | |
1859 | "Face name to use for built in predicates.") | |
1860 | (defvar prolog-builtin-face | |
1861 | (if (prolog-face-name-p 'font-lock-builtin-face) | |
1862 | 'font-lock-builtin-face | |
1863 | 'prolog-builtin-face) | |
1864 | "Face name to use for built in predicates.") | |
1865 | (defvar prolog-redo-face 'prolog-redo-face | |
1866 | "Face name to use for redo trace lines.") | |
1867 | (defvar prolog-exit-face 'prolog-exit-face | |
1868 | "Face name to use for exit trace lines.") | |
1869 | (defvar prolog-exception-face 'prolog-exception-face | |
1870 | "Face name to use for exception trace lines.") | |
1871 | ||
1872 | ;; Font Lock Patterns | |
1873 | (let ( | |
1874 | ;; "Native" Prolog patterns | |
1875 | (head-predicates | |
1876 | (list (format "^\\(%s\\)\\((\\|[ \t]*:-\\)" prolog-atom-regexp) | |
e2019526 | 1877 | 1 font-lock-function-name-face)) |
eb89dc14 SM |
1878 | ;(list (format "^%s" prolog-atom-regexp) |
1879 | ; 0 font-lock-function-name-face)) | |
1880 | (head-predicates-1 | |
1881 | (list (format "\\.[ \t]*\\(%s\\)" prolog-atom-regexp) | |
1882 | 1 font-lock-function-name-face) ) | |
1883 | (variables | |
1884 | '("\\<\\([_A-Z][a-zA-Z0-9_]*\\)" | |
1885 | 1 font-lock-variable-name-face)) | |
1886 | (important-elements | |
1887 | (list (if (eq prolog-system 'mercury) | |
1888 | "[][}{;|]\\|\\\\[+=]\\|<?=>?" | |
1889 | "[][}{!;|]\\|\\*->") | |
1890 | 0 'font-lock-keyword-face)) | |
1891 | (important-elements-1 | |
1892 | '("[^-*]\\(->\\)" 1 font-lock-keyword-face)) | |
1893 | (predspecs ; module:predicate/cardinality | |
1894 | (list (format "\\<\\(%s:\\|\\)%s/[0-9]+" | |
1895 | prolog-atom-regexp prolog-atom-regexp) | |
1896 | 0 font-lock-function-name-face 'prepend)) | |
1897 | (keywords ; directives (queries) | |
e2019526 | 1898 | (list |
eb89dc14 SM |
1899 | (if (eq prolog-system 'mercury) |
1900 | (concat | |
1901 | "\\<\\(" | |
1902 | (regexp-opt prolog-keywords-i) | |
1903 | "\\|" | |
1904 | (regexp-opt | |
1905 | prolog-determinism-specificators-i) | |
1906 | "\\)\\>") | |
1907 | (concat | |
1908 | "^[?:]- *\\(" | |
1909 | (regexp-opt prolog-keywords-i) | |
1910 | "\\)\\>")) | |
1911 | 1 prolog-builtin-face)) | |
1912 | ;; SICStus specific patterns | |
1913 | (sicstus-object-methods | |
1914 | (if (eq prolog-system 'sicstus) | |
1915 | '(prolog-font-lock-object-matcher | |
1916 | 1 font-lock-function-name-face))) | |
1917 | ;; Mercury specific patterns | |
1918 | (types | |
1919 | (if (eq prolog-system 'mercury) | |
1920 | (list | |
1921 | (regexp-opt prolog-types-i 'words) | |
1922 | 0 'font-lock-type-face))) | |
1923 | (modes | |
1924 | (if (eq prolog-system 'mercury) | |
1925 | (list | |
1926 | (regexp-opt prolog-mode-specificators-i 'words) | |
1927 | 0 'font-lock-constant-face))) | |
1928 | (directives | |
1929 | (if (eq prolog-system 'mercury) | |
1930 | (list | |
1931 | (regexp-opt prolog-directives-i 'words) | |
1932 | 0 'prolog-warning-face))) | |
1933 | ;; Inferior mode specific patterns | |
1934 | (prompt | |
1935 | ;; FIXME: Should be handled by comint already. | |
1936 | (list (prolog-prompt-regexp) 0 'font-lock-keyword-face)) | |
1937 | (trace-exit | |
1938 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
1939 | (cond | |
1940 | ((eq prolog-system 'sicstus) | |
1941 | '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):" | |
1942 | 1 prolog-exit-face)) | |
1943 | ((eq prolog-system 'swi) | |
1944 | '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face)) | |
1945 | (t nil))) | |
1946 | (trace-fail | |
1947 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
1948 | (cond | |
1949 | ((eq prolog-system 'sicstus) | |
1950 | '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):" | |
1951 | 1 prolog-warning-face)) | |
1952 | ((eq prolog-system 'swi) | |
1953 | '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face)) | |
1954 | (t nil))) | |
1955 | (trace-redo | |
1956 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
1957 | (cond | |
1958 | ((eq prolog-system 'sicstus) | |
1959 | '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):" | |
1960 | 1 prolog-redo-face)) | |
1961 | ((eq prolog-system 'swi) | |
1962 | '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face)) | |
1963 | (t nil))) | |
1964 | (trace-call | |
1965 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
1966 | (cond | |
1967 | ((eq prolog-system 'sicstus) | |
1968 | '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):" | |
1969 | 1 font-lock-function-name-face)) | |
1970 | ((eq prolog-system 'swi) | |
1971 | '("[ \t]*\\(Call\\):[ \t]*([ \t0-9]*)" | |
1972 | 1 font-lock-function-name-face)) | |
1973 | (t nil))) | |
1974 | (trace-exception | |
1975 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
1976 | (cond | |
1977 | ((eq prolog-system 'sicstus) | |
1978 | '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):" | |
1979 | 1 prolog-exception-face)) | |
1980 | ((eq prolog-system 'swi) | |
1981 | '("[ \t]*\\(Exception\\):[ \t]*([ \t0-9]*)" | |
1982 | 1 prolog-exception-face)) | |
1983 | (t nil))) | |
1984 | (error-message-identifier | |
1985 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
1986 | (cond | |
1987 | ((eq prolog-system 'sicstus) | |
1988 | '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend)) | |
1989 | ((eq prolog-system 'swi) | |
1990 | '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend)) | |
1991 | (t nil))) | |
1992 | (error-whole-messages | |
1993 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
1994 | (cond | |
1995 | ((eq prolog-system 'sicstus) | |
1996 | '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$" | |
1997 | 1 font-lock-comment-face append)) | |
1998 | ((eq prolog-system 'swi) | |
1999 | '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append)) | |
2000 | (t nil))) | |
2001 | (error-warning-messages | |
2002 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
2003 | ;; Mostly errors that SICStus asks the user about how to solve, | |
2004 | ;; such as "NAME CLASH:" for example. | |
2005 | (cond | |
2006 | ((eq prolog-system 'sicstus) | |
2007 | '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face)) | |
2008 | (t nil))) | |
2009 | (warning-messages | |
2010 | ;; FIXME: Add to compilation-error-regexp-alist instead. | |
2011 | (cond | |
2012 | ((eq prolog-system 'sicstus) | |
2013 | '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$" | |
2014 | 2 prolog-warning-face prepend)) | |
2015 | (t nil)))) | |
2016 | ||
2017 | ;; Make font lock list | |
2018 | (delq | |
2019 | nil | |
2020 | (cond | |
2021 | ((eq major-mode 'prolog-mode) | |
2022 | (list | |
2023 | head-predicates | |
2024 | head-predicates-1 | |
2025 | variables | |
2026 | important-elements | |
2027 | important-elements-1 | |
2028 | predspecs | |
2029 | keywords | |
2030 | sicstus-object-methods | |
2031 | types | |
2032 | modes | |
2033 | directives)) | |
2034 | ((eq major-mode 'prolog-inferior-mode) | |
2035 | (list | |
2036 | prompt | |
2037 | error-message-identifier | |
2038 | error-whole-messages | |
2039 | error-warning-messages | |
2040 | warning-messages | |
2041 | predspecs | |
2042 | trace-exit | |
2043 | trace-fail | |
2044 | trace-redo | |
2045 | trace-call | |
2046 | trace-exception)) | |
2047 | ((eq major-mode 'compilation-mode) | |
2048 | (list | |
2049 | error-message-identifier | |
2050 | error-whole-messages | |
2051 | error-warning-messages | |
2052 | warning-messages | |
2053 | predspecs)))) | |
e2019526 SB |
2054 | )) |
2055 | ||
eb89dc14 | 2056 | \f |
e2019526 | 2057 | |
eb89dc14 SM |
2058 | (defun prolog-find-unmatched-paren () |
2059 | "Return the column of the last unmatched left parenthesis." | |
e2019526 | 2060 | (save-excursion |
eb89dc14 | 2061 | (goto-char (or (car (nth 9 (syntax-ppss))) (point-min))) |
e2019526 SB |
2062 | (current-column))) |
2063 | ||
e2019526 SB |
2064 | |
2065 | (defun prolog-paren-balance () | |
2066 | "Return the parenthesis balance of the current line. | |
eb89dc14 | 2067 | A return value of N means N more left parentheses than right ones." |
e2019526 | 2068 | (save-excursion |
eb89dc14 SM |
2069 | (car (parse-partial-sexp (line-beginning-position) |
2070 | (line-end-position))))) | |
e2019526 | 2071 | |
eb89dc14 | 2072 | (defun prolog-electric--if-then-else () |
e2019526 SB |
2073 | "Insert spaces after the opening parenthesis, \"then\" (->) and \"else\" (;) branches. |
2074 | Spaces are inserted if all preceding objects on the line are | |
2075 | whitespace characters, parentheses, or then/else branches." | |
eb89dc14 SM |
2076 | (when prolog-electric-if-then-else-flag |
2077 | (save-excursion | |
2078 | (let ((regexp (concat "(\\|" prolog-left-indent-regexp)) | |
2079 | level) | |
2080 | (beginning-of-line) | |
2081 | (skip-chars-forward " \t") | |
e2019526 | 2082 | ;; Treat "( If -> " lines specially. |
dbed16aa SM |
2083 | ;;(setq incr (if (looking-at "(.*->") |
2084 | ;; 2 | |
2085 | ;; prolog-paren-indent)) | |
e2019526 SB |
2086 | |
2087 | ;; work on all subsequent "->", "(", ";" | |
2088 | (while (looking-at regexp) | |
2089 | (goto-char (match-end 0)) | |
2090 | (setq level (+ (prolog-find-unmatched-paren) prolog-paren-indent)) | |
2091 | ||
2092 | ;; Remove old white space | |
2093 | (let ((start (point))) | |
2094 | (skip-chars-forward " \t") | |
2095 | (delete-region start (point))) | |
2096 | (indent-to level) | |
2097 | (skip-chars-forward " \t")) | |
eb89dc14 SM |
2098 | )) |
2099 | (when (save-excursion | |
2100 | (backward-char 2) | |
2101 | (looking-at "\\s ;\\|\\s (\\|->")) ; (looking-at "\\s \\((\\|;\\)")) | |
2102 | (skip-chars-forward " \t")) | |
2103 | )) | |
e2019526 SB |
2104 | |
2105 | ;;;; Comment filling | |
2106 | ||
2107 | (defun prolog-comment-limits () | |
04380ff1 | 2108 | "Return the current comment limits plus the comment type (block or line). |
e2019526 SB |
2109 | The comment limits are the range of a block comment or the range that |
2110 | contains all adjacent line comments (i.e. all comments that starts in | |
2111 | the same column with no empty lines or non-whitespace characters | |
2112 | between them)." | |
04380ff1 SM |
2113 | (let ((here (point)) |
2114 | lit-limits-b lit-limits-e lit-type beg end | |
2115 | ) | |
2116 | (save-restriction | |
2117 | ;; Widen to catch comment limits correctly. | |
2118 | (widen) | |
dbed16aa SM |
2119 | (setq end (line-end-position) |
2120 | beg (line-beginning-position)) | |
04380ff1 SM |
2121 | (save-excursion |
2122 | (beginning-of-line) | |
2123 | (setq lit-type (if (search-forward-regexp "%" end t) 'line 'block)) | |
2124 | ; (setq lit-type 'line) | |
2125 | ;(if (search-forward-regexp "^[ \t]*%" end t) | |
2126 | ; (setq lit-type 'line) | |
2127 | ; (if (not (search-forward-regexp "%" end t)) | |
2128 | ; (setq lit-type 'block) | |
2129 | ; (if (not (= (forward-line 1) 0)) | |
2130 | ; (setq lit-type 'block) | |
2131 | ; (setq done t | |
2132 | ; ret (prolog-comment-limits))) | |
2133 | ; )) | |
2134 | (if (eq lit-type 'block) | |
2135 | (progn | |
2136 | (goto-char here) | |
2137 | (when (looking-at "/\\*") (forward-char 2)) | |
dbed16aa | 2138 | (when (and (looking-at "\\*") (> (point) (point-min)) |
04380ff1 SM |
2139 | (forward-char -1) (looking-at "/")) |
2140 | (forward-char 1)) | |
2141 | (when (save-excursion (search-backward "/*" nil t)) | |
2142 | (list (save-excursion (search-backward "/*") (point)) | |
2143 | (or (search-forward "*/" nil t) (point-max)) lit-type))) | |
2144 | ;; line comment | |
dbed16aa | 2145 | (setq lit-limits-b (- (point) 1) |
04380ff1 SM |
2146 | lit-limits-e end) |
2147 | (condition-case nil | |
2148 | (if (progn (goto-char lit-limits-b) | |
2149 | (looking-at "%")) | |
2150 | (let ((col (current-column)) done) | |
2151 | (setq beg (point) | |
2152 | end lit-limits-e) | |
2153 | ;; Always at the beginning of the comment | |
2154 | ;; Go backward now | |
2155 | (beginning-of-line) | |
2156 | (while (and (zerop (setq done (forward-line -1))) | |
dbed16aa SM |
2157 | (search-forward-regexp "^[ \t]*%" |
2158 | (line-end-position) t) | |
04380ff1 SM |
2159 | (= (+ 1 col) (current-column))) |
2160 | (setq beg (- (point) 1))) | |
2161 | (when (= done 0) | |
2162 | (forward-line 1)) | |
2163 | ;; We may have a line with code above... | |
2164 | (when (and (zerop (setq done (forward-line -1))) | |
dbed16aa | 2165 | (search-forward "%" (line-end-position) t) |
04380ff1 SM |
2166 | (= (+ 1 col) (current-column))) |
2167 | (setq beg (- (point) 1))) | |
2168 | (when (= done 0) | |
2169 | (forward-line 1)) | |
2170 | ;; Go forward | |
2171 | (goto-char lit-limits-b) | |
2172 | (beginning-of-line) | |
2173 | (while (and (zerop (forward-line 1)) | |
dbed16aa SM |
2174 | (search-forward-regexp "^[ \t]*%" |
2175 | (line-end-position) t) | |
04380ff1 | 2176 | (= (+ 1 col) (current-column))) |
dbed16aa | 2177 | (setq end (line-end-position))) |
04380ff1 SM |
2178 | (list beg end lit-type)) |
2179 | (list lit-limits-b lit-limits-e lit-type) | |
2180 | ) | |
2181 | (error (list lit-limits-b lit-limits-e lit-type)))) | |
2182 | )))) | |
e2019526 SB |
2183 | |
2184 | (defun prolog-guess-fill-prefix () | |
2185 | ;; fill 'txt entities? | |
2186 | (when (save-excursion | |
2187 | (end-of-line) | |
eb89dc14 | 2188 | (nth 4 (syntax-ppss))) |
e2019526 SB |
2189 | (let* ((bounds (prolog-comment-limits)) |
2190 | (cbeg (car bounds)) | |
2191 | (type (nth 2 bounds)) | |
04380ff1 | 2192 | beg end) |
e2019526 SB |
2193 | (save-excursion |
2194 | (end-of-line) | |
2195 | (setq end (point)) | |
2196 | (beginning-of-line) | |
2197 | (setq beg (point)) | |
2198 | (if (and (eq type 'line) | |
2199 | (> cbeg beg) | |
04380ff1 SM |
2200 | (save-excursion (not (search-forward-regexp "^[ \t]*%" |
2201 | cbeg t)))) | |
e2019526 SB |
2202 | (progn |
2203 | (goto-char cbeg) | |
2204 | (search-forward-regexp "%+[ \t]*" end t) | |
04380ff1 SM |
2205 | (prolog-replace-in-string (buffer-substring beg (point)) |
2206 | "[^ \t%]" " ")) | |
e2019526 | 2207 | ;(goto-char beg) |
04380ff1 SM |
2208 | (if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*" |
2209 | end t) | |
2210 | (prolog-replace-in-string (buffer-substring beg (point)) "/" " ") | |
e2019526 SB |
2211 | (beginning-of-line) |
2212 | (when (search-forward-regexp "^[ \t]+" end t) | |
04380ff1 | 2213 | (buffer-substring beg (point))))))))) |
e2019526 SB |
2214 | |
2215 | (defun prolog-fill-paragraph () | |
2216 | "Fill paragraph comment at or after point." | |
2217 | (interactive) | |
2218 | (let* ((bounds (prolog-comment-limits)) | |
2219 | (type (nth 2 bounds))) | |
2220 | (if (eq type 'line) | |
2221 | (let ((fill-prefix (prolog-guess-fill-prefix))) | |
2222 | (fill-paragraph nil)) | |
2223 | (save-excursion | |
2224 | (save-restriction | |
2225 | ;; exclude surrounding lines that delimit a multiline comment | |
2226 | ;; and don't contain alphabetic characters, like "/*******", | |
2227 | ;; "- - - */" etc. | |
2228 | (save-excursion | |
2229 | (backward-paragraph) | |
2230 | (unless (bobp) (forward-line)) | |
2231 | (if (string-match "^/\\*[^a-zA-Z]*$" (thing-at-point 'line)) | |
2232 | (narrow-to-region (point-at-eol) (point-max)))) | |
2233 | (save-excursion | |
2234 | (forward-paragraph) | |
2235 | (forward-line -1) | |
2236 | (if (string-match "^[^a-zA-Z]*\\*/$" (thing-at-point 'line)) | |
2237 | (narrow-to-region (point-min) (point-at-bol)))) | |
2238 | (let ((fill-prefix (prolog-guess-fill-prefix))) | |
2239 | (fill-paragraph nil)))) | |
2240 | ))) | |
2241 | ||
2242 | (defun prolog-do-auto-fill () | |
2243 | "Carry out Auto Fill for Prolog mode. | |
04380ff1 | 2244 | In effect it sets the `fill-prefix' when inside comments and then calls |
e2019526 SB |
2245 | `do-auto-fill'." |
2246 | (let ((fill-prefix (prolog-guess-fill-prefix))) | |
2247 | (do-auto-fill) | |
2248 | )) | |
2249 | ||
04380ff1 SM |
2250 | (defalias 'prolog-replace-in-string |
2251 | (if (fboundp 'replace-in-string) | |
2252 | #'replace-in-string | |
2253 | (lambda (str regexp newtext &optional literal) | |
2254 | (replace-regexp-in-string regexp newtext str nil literal)))) | |
e2019526 | 2255 | \f |
e2019526 SB |
2256 | ;;------------------------------------------------------------------- |
2257 | ;; Online help | |
2258 | ;;------------------------------------------------------------------- | |
2259 | ||
2260 | (defvar prolog-help-function | |
2261 | '((mercury nil) | |
2262 | (eclipse prolog-help-online) | |
2263 | ;; (sicstus prolog-help-info) | |
2264 | (sicstus prolog-find-documentation) | |
2265 | (swi prolog-help-online) | |
2266 | (t prolog-help-online)) | |
2267 | "Alist for the name of the function for finding help on a predicate.") | |
2268 | ||
2269 | (defun prolog-help-on-predicate () | |
2270 | "Invoke online help on the atom under cursor." | |
2271 | (interactive) | |
2272 | ||
2273 | (cond | |
2274 | ;; Redirect help for SICStus to `prolog-find-documentation'. | |
2275 | ((eq prolog-help-function-i 'prolog-find-documentation) | |
2276 | (prolog-find-documentation)) | |
2277 | ||
2278 | ;; Otherwise, ask for the predicate name and then call the function | |
2279 | ;; in prolog-help-function-i | |
2280 | (t | |
dbed16aa SM |
2281 | (let* ((word (prolog-atom-under-point)) |
2282 | (predicate (read-string | |
e2019526 SB |
2283 | (format "Help on predicate%s: " |
2284 | (if word | |
2285 | (concat " (default " word ")") | |
dbed16aa SM |
2286 | "")) |
2287 | nil nil word)) | |
2288 | ;;point | |
2289 | ) | |
e2019526 SB |
2290 | (if prolog-help-function-i |
2291 | (funcall prolog-help-function-i predicate) | |
2292 | (error "Sorry, no help method defined for this Prolog system.")))) | |
2293 | )) | |
2294 | ||
f440830d GM |
2295 | |
2296 | (autoload 'Info-goto-node "info" nil t) | |
2297 | (declare-function Info-follow-nearest-node "info" (&optional FORK)) | |
2298 | ||
e2019526 SB |
2299 | (defun prolog-help-info (predicate) |
2300 | (let ((buffer (current-buffer)) | |
2301 | oldp | |
2302 | (str (concat "^\\* " (regexp-quote predicate) " */"))) | |
e2019526 SB |
2303 | (pop-to-buffer nil) |
2304 | (Info-goto-node prolog-info-predicate-index) | |
2305 | (if (not (re-search-forward str nil t)) | |
2306 | (error (format "Help on predicate `%s' not found." predicate))) | |
2307 | ||
2308 | (setq oldp (point)) | |
2309 | (if (re-search-forward str nil t) | |
2310 | ;; Multiple matches, ask user | |
2311 | (let ((max 2) | |
2312 | n) | |
2313 | ;; Count matches | |
2314 | (while (re-search-forward str nil t) | |
2315 | (setq max (1+ max))) | |
2316 | ||
2317 | (goto-char oldp) | |
2318 | (re-search-backward "[^ /]" nil t) | |
2319 | (recenter 0) | |
2320 | (setq n (read-string ;; was read-input, which is obsolete | |
2321 | (format "Several matches, choose (1-%d): " max) "1")) | |
2322 | (forward-line (- (string-to-number n) 1))) | |
2323 | ;; Single match | |
2324 | (re-search-backward "[^ /]" nil t)) | |
2325 | ||
2326 | ;; (Info-follow-nearest-node (point)) | |
2327 | (prolog-Info-follow-nearest-node) | |
2328 | (re-search-forward (concat "^`" (regexp-quote predicate)) nil t) | |
2329 | (beginning-of-line) | |
2330 | (recenter 0) | |
2331 | (pop-to-buffer buffer))) | |
2332 | ||
2333 | (defun prolog-Info-follow-nearest-node () | |
04380ff1 SM |
2334 | (if (featurep 'xemacs) |
2335 | (Info-follow-nearest-node (point)) | |
2336 | (Info-follow-nearest-node))) | |
e2019526 SB |
2337 | |
2338 | (defun prolog-help-online (predicate) | |
2339 | (prolog-ensure-process) | |
2340 | (process-send-string "prolog" (concat "help(" predicate ").\n")) | |
2341 | (display-buffer "*prolog*")) | |
2342 | ||
2343 | (defun prolog-help-apropos (string) | |
2344 | "Find Prolog apropos on given STRING. | |
2345 | This function is only available when `prolog-system' is set to `swi'." | |
2346 | (interactive "sApropos: ") | |
2347 | (cond | |
2348 | ((eq prolog-system 'swi) | |
2349 | (prolog-ensure-process) | |
2350 | (process-send-string "prolog" (concat "apropos(" string ").\n")) | |
2351 | (display-buffer "*prolog*")) | |
2352 | (t | |
2353 | (error "Sorry, no Prolog apropos available for this Prolog system.")))) | |
2354 | ||
2355 | (defun prolog-atom-under-point () | |
2356 | "Return the atom under or left to the point." | |
2357 | (save-excursion | |
2358 | (let ((nonatom_chars "[](){},\. \t\n") | |
2359 | start) | |
2360 | (skip-chars-forward (concat "^" nonatom_chars)) | |
2361 | (skip-chars-backward nonatom_chars) | |
2362 | (skip-chars-backward (concat "^" nonatom_chars)) | |
2363 | (setq start (point)) | |
2364 | (skip-chars-forward (concat "^" nonatom_chars)) | |
2365 | (buffer-substring-no-properties start (point)) | |
2366 | ))) | |
2367 | ||
2368 | \f | |
2369 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
2370 | ;; Help function with completion | |
2371 | ;; Stolen from Per Mildner's SICStus debugger mode and modified | |
2372 | ||
2373 | (defun prolog-find-documentation () | |
2374 | "Go to the Info node for a predicate in the SICStus Info manual." | |
2375 | (interactive) | |
2376 | (let ((pred (prolog-read-predicate))) | |
2377 | (prolog-goto-predicate-info pred))) | |
2378 | ||
dbed16aa | 2379 | (defvar prolog-info-alist nil |
e2019526 SB |
2380 | "Alist with all builtin predicates. |
2381 | Only for internal use by `prolog-find-documentation'") | |
2382 | ||
2383 | ;; Very similar to prolog-help-info except that that function cannot | |
2384 | ;; cope with arity and that it asks the user if there are several | |
2385 | ;; functors with different arity. This function also uses | |
2386 | ;; prolog-info-alist for finding the info node, rather than parsing | |
2387 | ;; the predicate index. | |
2388 | (defun prolog-goto-predicate-info (predicate) | |
2389 | "Go to the info page for PREDICATE, which is a PredSpec." | |
2390 | (interactive) | |
e2019526 SB |
2391 | (string-match "\\(.*\\)/\\([0-9]+\\).*$" predicate) |
2392 | (let ((buffer (current-buffer)) | |
2393 | (name (match-string 1 predicate)) | |
dbed16aa | 2394 | (arity (string-to-number (match-string 2 predicate))) |
e2019526 SB |
2395 | ;oldp |
2396 | ;(str (regexp-quote predicate)) | |
2397 | ) | |
e2019526 SB |
2398 | (pop-to-buffer nil) |
2399 | ||
dbed16aa | 2400 | (Info-goto-node |
e2019526 SB |
2401 | prolog-info-predicate-index) ;; We must be in the SICStus pages |
2402 | (Info-goto-node (car (cdr (assoc predicate prolog-info-alist)))) | |
2403 | ||
2404 | (prolog-find-term (regexp-quote name) arity "^`") | |
2405 | ||
2406 | (recenter 0) | |
2407 | (pop-to-buffer buffer)) | |
2408 | ) | |
2409 | ||
2410 | (defun prolog-read-predicate () | |
2411 | "Read a PredSpec from the user. | |
2412 | Returned value is a string \"FUNCTOR/ARITY\". | |
2413 | Interaction supports completion." | |
dbed16aa SM |
2414 | (let ((default (prolog-atom-under-point))) |
2415 | ;; If the predicate index is not yet built, do it now | |
2416 | (if (not prolog-info-alist) | |
e2019526 | 2417 | (prolog-build-info-alist)) |
dbed16aa | 2418 | ;; Test if the default string could be the base for completion. |
e2019526 | 2419 | ;; Discard it if not. |
dbed16aa SM |
2420 | (if (eq (try-completion default prolog-info-alist) nil) |
2421 | (setq default nil)) | |
e2019526 | 2422 | ;; Read the PredSpec from the user |
dbed16aa SM |
2423 | (completing-read |
2424 | (if (zerop (length default)) | |
2425 | "Help on predicate: " | |
2426 | (concat "Help on predicate (default " default "): ")) | |
2427 | prolog-info-alist nil t nil nil default))) | |
e2019526 SB |
2428 | |
2429 | (defun prolog-build-info-alist (&optional verbose) | |
dbed16aa | 2430 | "Build an alist of all builtins and library predicates. |
e2019526 SB |
2431 | Each element is of the form (\"NAME/ARITY\" . (INFO-NODE1 INFO-NODE2 ...)). |
2432 | Typically there is just one Info node associated with each name | |
2433 | If an optional argument VERBOSE is non-nil, print messages at the beginning | |
2434 | and end of list building." | |
2435 | (if verbose | |
2436 | (message "Building info alist...")) | |
2437 | (setq prolog-info-alist | |
2438 | (let ((l ()) | |
2439 | (last-entry (cons "" ()))) | |
2440 | (save-excursion | |
2441 | (save-window-excursion | |
2442 | ;; select any window but the minibuffer (as we cannot switch | |
2443 | ;; buffers in minibuffer window. | |
2444 | ;; I am not sure this is the right/best way | |
2445 | (if (active-minibuffer-window) ; nil if none active | |
2446 | (select-window (next-window))) | |
2447 | ;; Do this after going away from minibuffer window | |
2448 | (save-window-excursion | |
2449 | (info)) | |
2450 | (Info-goto-node prolog-info-predicate-index) | |
2451 | (goto-char (point-min)) | |
2452 | (while (re-search-forward | |
2453 | "^\\* \\(.+\\)/\\([0-9]+\\)\\([^\n:*]*\\):" nil t) | |
2454 | (let* ((name (match-string 1)) | |
2455 | (arity (string-to-number (match-string 2))) | |
2456 | (comment (match-string 3)) | |
2457 | (fa (format "%s/%d%s" name arity comment)) | |
2458 | info-node) | |
2459 | (beginning-of-line) | |
2460 | ;; Extract the info node name | |
dbed16aa | 2461 | (setq info-node (progn |
e2019526 SB |
2462 | (re-search-forward ":[ \t]*\\([^:]+\\).$") |
2463 | (match-string 1) | |
2464 | )) | |
2465 | ;; ###### Easier? (from Milan version 0.1.28) | |
2466 | ;; (setq info-node (Info-extract-menu-node-name)) | |
2467 | (if (equal fa (car last-entry)) | |
2468 | (setcdr last-entry (cons info-node (cdr last-entry))) | |
2469 | (setq last-entry (cons fa (list info-node)) | |
2470 | l (cons last-entry l))))) | |
2471 | (nreverse l) | |
2472 | )))) | |
2473 | (if verbose | |
2474 | (message "Building info alist... done."))) | |
2475 | ||
2476 | \f | |
2477 | ;;------------------------------------------------------------------- | |
2478 | ;; Miscellaneous functions | |
2479 | ;;------------------------------------------------------------------- | |
2480 | ||
2481 | ;; For Windows. Change backslash to slash. SICStus handles either | |
2482 | ;; path separator but backslash must be doubled, therefore use slash. | |
2483 | (defun prolog-bsts (string) | |
2484 | "Change backslashes to slashes in STRING." | |
2485 | (let ((str1 (copy-sequence string)) | |
2486 | (len (length string)) | |
2487 | (i 0)) | |
2488 | (while (< i len) | |
2489 | (if (char-equal (aref str1 i) ?\\) | |
2490 | (aset str1 i ?/)) | |
2491 | (setq i (1+ i))) | |
2492 | str1)) | |
2493 | ||
dbed16aa SM |
2494 | ;;(defun prolog-temporary-file () |
2495 | ;; "Make temporary file name for compilation." | |
2496 | ;; (make-temp-name | |
2497 | ;; (concat | |
2498 | ;; (or | |
2499 | ;; (getenv "TMPDIR") | |
2500 | ;; (getenv "TEMP") | |
2501 | ;; (getenv "TMP") | |
2502 | ;; (getenv "SYSTEMP") | |
2503 | ;; "/tmp") | |
2504 | ;; "/prolcomp"))) | |
2505 | ;;(setq prolog-temp-filename (prolog-bsts (prolog-temporary-file))) | |
e2019526 SB |
2506 | |
2507 | (defun prolog-temporary-file () | |
2508 | "Make temporary file name for compilation." | |
2509 | (if prolog-temporary-file-name | |
2510 | ;; We already have a file, erase content and continue | |
2511 | (progn | |
2512 | (write-region "" nil prolog-temporary-file-name nil 'silent) | |
2513 | prolog-temporary-file-name) | |
dbed16aa SM |
2514 | ;; Actually create the file and set `prolog-temporary-file-name' |
2515 | ;; accordingly. | |
2516 | (setq prolog-temporary-file-name | |
2517 | (make-temp-file "prolcomp" nil ".pl")))) | |
e2019526 SB |
2518 | |
2519 | (defun prolog-goto-prolog-process-buffer () | |
2520 | "Switch to the prolog process buffer and go to its end." | |
2521 | (switch-to-buffer-other-window "*prolog*") | |
2522 | (goto-char (point-max)) | |
2523 | ) | |
2524 | ||
2525 | (defun prolog-enable-sicstus-sd () | |
2526 | "Enable the source level debugging facilities of SICStus 3.7 and later." | |
2527 | (interactive) | |
04380ff1 | 2528 | (require 'pltrace) ; Load the SICStus debugger code |
e2019526 SB |
2529 | ;; Turn on the source level debugging by default |
2530 | (add-hook 'prolog-inferior-mode-hook 'pltrace-on) | |
2531 | (if (not prolog-use-sicstus-sd) | |
2532 | (progn | |
2533 | ;; If there is a *prolog* buffer, then call pltrace-on | |
2534 | (if (get-buffer "*prolog*") | |
2535 | ;; Avoid compilation warnings by using eval | |
2536 | (eval '(pltrace-on))) | |
2537 | (setq prolog-use-sicstus-sd t) | |
04380ff1 | 2538 | ))) |
e2019526 SB |
2539 | |
2540 | (defun prolog-disable-sicstus-sd () | |
2541 | "Disable the source level debugging facilities of SICStus 3.7 and later." | |
2542 | (interactive) | |
2543 | (setq prolog-use-sicstus-sd nil) | |
2544 | ;; Remove the hook | |
2545 | (remove-hook 'prolog-inferior-mode-hook 'pltrace-on) | |
2546 | ;; If there is a *prolog* buffer, then call pltrace-off | |
2547 | (if (get-buffer "*prolog*") | |
2548 | ;; Avoid compile warnings by using eval | |
2549 | (eval '(pltrace-off)))) | |
2550 | ||
dbed16aa SM |
2551 | (defun prolog-toggle-sicstus-sd () |
2552 | ;; FIXME: Use define-minor-mode. | |
2553 | "Toggle the source level debugging facilities of SICStus 3.7 and later." | |
2554 | (interactive) | |
2555 | (if prolog-use-sicstus-sd | |
2556 | (prolog-disable-sicstus-sd) | |
2557 | (prolog-enable-sicstus-sd))) | |
2558 | ||
e2019526 SB |
2559 | (defun prolog-debug-on (&optional arg) |
2560 | "Enable debugging. | |
2561 | When called with prefix argument ARG, disable debugging instead." | |
2562 | (interactive "P") | |
2563 | (if arg | |
2564 | (prolog-debug-off) | |
2565 | (prolog-process-insert-string (get-process "prolog") | |
2566 | prolog-debug-on-string) | |
2567 | (process-send-string "prolog" prolog-debug-on-string))) | |
2568 | ||
2569 | (defun prolog-debug-off () | |
2570 | "Disable debugging." | |
2571 | (interactive) | |
2572 | (prolog-process-insert-string (get-process "prolog") | |
2573 | prolog-debug-off-string) | |
2574 | (process-send-string "prolog" prolog-debug-off-string)) | |
2575 | ||
2576 | (defun prolog-trace-on (&optional arg) | |
2577 | "Enable tracing. | |
2578 | When called with prefix argument ARG, disable tracing instead." | |
2579 | (interactive "P") | |
2580 | (if arg | |
2581 | (prolog-trace-off) | |
2582 | (prolog-process-insert-string (get-process "prolog") | |
2583 | prolog-trace-on-string) | |
2584 | (process-send-string "prolog" prolog-trace-on-string))) | |
2585 | ||
2586 | (defun prolog-trace-off () | |
2587 | "Disable tracing." | |
2588 | (interactive) | |
2589 | (prolog-process-insert-string (get-process "prolog") | |
2590 | prolog-trace-off-string) | |
2591 | (process-send-string "prolog" prolog-trace-off-string)) | |
2592 | ||
2593 | (defun prolog-zip-on (&optional arg) | |
2594 | "Enable zipping (for SICStus 3.7 and later). | |
2595 | When called with prefix argument ARG, disable zipping instead." | |
2596 | (interactive "P") | |
01c63f4c SM |
2597 | (if (not (and (eq prolog-system 'sicstus) |
2598 | (prolog-atleast-version '(3 . 7)))) | |
2599 | (error "Only works for SICStus 3.7 and later")) | |
e2019526 SB |
2600 | (if arg |
2601 | (prolog-zip-off) | |
2602 | (prolog-process-insert-string (get-process "prolog") | |
2603 | prolog-zip-on-string) | |
2604 | (process-send-string "prolog" prolog-zip-on-string))) | |
2605 | ||
2606 | (defun prolog-zip-off () | |
2607 | "Disable zipping (for SICStus 3.7 and later)." | |
2608 | (interactive) | |
2609 | (prolog-process-insert-string (get-process "prolog") | |
2610 | prolog-zip-off-string) | |
2611 | (process-send-string "prolog" prolog-zip-off-string)) | |
2612 | ||
2613 | ;; (defun prolog-create-predicate-index () | |
2614 | ;; "Create an index for all predicates in the buffer." | |
2615 | ;; (let ((predlist '()) | |
dbed16aa | 2616 | ;; clauseinfo |
e2019526 SB |
2617 | ;; object |
2618 | ;; pos | |
2619 | ;; ) | |
2620 | ;; (goto-char (point-min)) | |
2621 | ;; ;; Replace with prolog-clause-start! | |
2622 | ;; (while (re-search-forward "^.+:-" nil t) | |
2623 | ;; (setq pos (match-beginning 0)) | |
2624 | ;; (setq clauseinfo (prolog-clause-info)) | |
2625 | ;; (setq object (prolog-in-object)) | |
2626 | ;; (setq predlist (append | |
2627 | ;; predlist | |
dbed16aa | 2628 | ;; (list (cons |
e2019526 SB |
2629 | ;; (if (and (eq prolog-system 'sicstus) |
2630 | ;; (prolog-in-object)) | |
dbed16aa | 2631 | ;; (format "%s::%s/%d" |
e2019526 | 2632 | ;; object |
dbed16aa | 2633 | ;; (nth 0 clauseinfo) |
e2019526 SB |
2634 | ;; (nth 1 clauseinfo)) |
2635 | ;; (format "%s/%d" | |
dbed16aa | 2636 | ;; (nth 0 clauseinfo) |
e2019526 SB |
2637 | ;; (nth 1 clauseinfo))) |
2638 | ;; pos | |
2639 | ;; )))) | |
2640 | ;; (prolog-end-of-predicate)) | |
2641 | ;; predlist)) | |
2642 | ||
2643 | (defun prolog-get-predspec () | |
2644 | (save-excursion | |
2645 | (let ((state (prolog-clause-info)) | |
2646 | (object (prolog-in-object))) | |
2171cea5 | 2647 | (if (or (equal (nth 0 state) "") |
eb89dc14 | 2648 | (nth 4 (syntax-ppss))) |
e2019526 SB |
2649 | nil |
2650 | (if (and (eq prolog-system 'sicstus) | |
2651 | object) | |
dbed16aa | 2652 | (format "%s::%s/%d" |
e2019526 | 2653 | object |
dbed16aa | 2654 | (nth 0 state) |
e2019526 SB |
2655 | (nth 1 state)) |
2656 | (format "%s/%d" | |
dbed16aa | 2657 | (nth 0 state) |
e2019526 SB |
2658 | (nth 1 state))) |
2659 | )))) | |
2660 | ||
2661 | ;; For backward compatibility. Stolen from custom.el. | |
2662 | (or (fboundp 'match-string) | |
2663 | ;; Introduced in Emacs 19.29. | |
2664 | (defun match-string (num &optional string) | |
2665 | "Return string of text matched by last search. | |
2666 | NUM specifies which parenthesized expression in the last regexp. | |
2667 | Value is nil if NUMth pair didn't match, or there were less than NUM pairs. | |
2668 | Zero means the entire text matched by the whole regexp or whole string. | |
2669 | STRING should be given if the last search was by `string-match' on STRING." | |
2670 | (if (match-beginning num) | |
2671 | (if string | |
2672 | (substring string (match-beginning num) (match-end num)) | |
2673 | (buffer-substring (match-beginning num) (match-end num)))))) | |
2674 | ||
2675 | (defun prolog-pred-start () | |
2676 | "Return the starting point of the first clause of the current predicate." | |
2171cea5 | 2677 | ;; FIXME: Use SMIE. |
e2019526 SB |
2678 | (save-excursion |
2679 | (goto-char (prolog-clause-start)) | |
2680 | ;; Find first clause, unless it was a directive | |
2681 | (if (and (not (looking-at "[:?]-")) | |
2682 | (not (looking-at "[ \t]*[%/]")) ; Comment | |
dbed16aa | 2683 | |
e2019526 SB |
2684 | ) |
2685 | (let* ((pinfo (prolog-clause-info)) | |
2686 | (predname (nth 0 pinfo)) | |
2687 | (arity (nth 1 pinfo)) | |
2688 | (op (point))) | |
2689 | (while (and (re-search-backward | |
dbed16aa | 2690 | (format "^%s\\([(\\.]\\| *%s\\)" |
e2019526 SB |
2691 | predname prolog-head-delimiter) nil t) |
2692 | (= arity (nth 1 (prolog-clause-info))) | |
2693 | ) | |
2694 | (setq op (point))) | |
2695 | (if (eq prolog-system 'mercury) | |
2696 | ;; Skip to the beginning of declarations of the predicate | |
2697 | (progn | |
2698 | (goto-char (prolog-beginning-of-clause)) | |
2699 | (while (and (not (eq (point) op)) | |
2700 | (looking-at | |
2701 | (format ":-[ \t]*\\(pred\\|mode\\)[ \t]+%s" | |
2702 | predname))) | |
2703 | (setq op (point)) | |
2704 | (goto-char (prolog-beginning-of-clause))))) | |
2705 | op) | |
2706 | (point)))) | |
2707 | ||
2708 | (defun prolog-pred-end () | |
2709 | "Return the position at the end of the last clause of the current predicate." | |
2171cea5 | 2710 | ;; FIXME: Use SMIE. |
e2019526 | 2711 | (save-excursion |
2171cea5 | 2712 | (goto-char (prolog-clause-end)) ; If we are before the first predicate. |
e2019526 SB |
2713 | (goto-char (prolog-clause-start)) |
2714 | (let* ((pinfo (prolog-clause-info)) | |
2715 | (predname (nth 0 pinfo)) | |
2716 | (arity (nth 1 pinfo)) | |
2717 | oldp | |
2718 | (notdone t) | |
2719 | (op (point))) | |
2720 | (if (looking-at "[:?]-") | |
2721 | ;; This was a directive | |
2722 | (progn | |
2723 | (if (and (eq prolog-system 'mercury) | |
2724 | (looking-at | |
2725 | (format ":-[ \t]*\\(pred\\|mode\\)[ \t]+\\(%s+\\)" | |
2726 | prolog-atom-regexp))) | |
2727 | ;; Skip predicate declarations | |
2728 | (progn | |
2729 | (setq predname (buffer-substring-no-properties | |
2730 | (match-beginning 2) (match-end 2))) | |
2731 | (while (re-search-forward | |
2732 | (format | |
2733 | "\n*\\(:-[ \t]*\\(pred\\|mode\\)[ \t]+\\)?%s[( \t]" | |
2734 | predname) | |
2735 | nil t)))) | |
2736 | (goto-char (prolog-clause-end)) | |
2737 | (setq op (point))) | |
2738 | ;; It was not a directive, find the last clause | |
2739 | (while (and notdone | |
2740 | (re-search-forward | |
dbed16aa | 2741 | (format "^%s\\([(\\.]\\| *%s\\)" |
e2019526 SB |
2742 | predname prolog-head-delimiter) nil t) |
2743 | (= arity (nth 1 (prolog-clause-info)))) | |
2744 | (setq oldp (point)) | |
2745 | (setq op (prolog-clause-end)) | |
2746 | (if (>= oldp op) | |
2747 | ;; End of clause not found. | |
2748 | (setq notdone nil) | |
2749 | ;; Continue while loop | |
2750 | (goto-char op)))) | |
2751 | op))) | |
2752 | ||
2753 | (defun prolog-clause-start (&optional not-allow-methods) | |
2754 | "Return the position at the start of the head of the current clause. | |
2755 | If NOTALLOWMETHODS is non-nil then do not match on methods in | |
eb89dc14 | 2756 | objects (relevant only if `prolog-system' is set to `sicstus')." |
e2019526 SB |
2757 | (save-excursion |
2758 | (let ((notdone t) | |
2759 | (retval (point-min))) | |
2760 | (end-of-line) | |
dbed16aa | 2761 | |
e2019526 SB |
2762 | ;; SICStus object? |
2763 | (if (and (not not-allow-methods) | |
2764 | (eq prolog-system 'sicstus) | |
2765 | (prolog-in-object)) | |
dbed16aa SM |
2766 | (while (and |
2767 | notdone | |
e2019526 SB |
2768 | ;; Search for a head or a fact |
2769 | (re-search-backward | |
2770 | ;; If in object, then find method start. | |
dbed16aa | 2771 | ;; "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\|,\\)" |
e2019526 SB |
2772 | "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\)" ; The comma causes |
2773 | ; problems since we cannot assume | |
2774 | ; that the line starts at column 0, | |
2775 | ; thus we don't know if the line | |
2776 | ; is a head or a subgoal | |
2777 | (point-min) t)) | |
2778 | (if (>= (prolog-paren-balance) 0) ; To no match on " a) :-" | |
2779 | ;; Start of method found | |
2780 | (progn | |
2781 | (setq retval (point)) | |
2782 | (setq notdone nil))) | |
2783 | ) ; End of while | |
2784 | ||
2785 | ;; Not in object | |
dbed16aa SM |
2786 | (while (and |
2787 | notdone | |
e2019526 SB |
2788 | ;; Search for a text at beginning of a line |
2789 | ;; ###### | |
2790 | ;; (re-search-backward "^[a-z$']" nil t)) | |
2791 | (let ((case-fold-search nil)) | |
eb89dc14 SM |
2792 | (re-search-backward "^\\([[:lower:]$']\\|[:?]-\\)" |
2793 | nil t))) | |
e2019526 SB |
2794 | (let ((bal (prolog-paren-balance))) |
2795 | (cond | |
2796 | ((> bal 0) | |
2797 | ;; Start of clause found | |
2798 | (progn | |
2799 | (setq retval (point)) | |
2800 | (setq notdone nil))) | |
2801 | ((and (= bal 0) | |
2802 | (looking-at | |
dbed16aa | 2803 | (format ".*\\(\\.\\|%s\\|!,\\)[ \t]*\\(%%.*\\|\\)$" |
e2019526 SB |
2804 | prolog-head-delimiter))) |
2805 | ;; Start of clause found if the line ends with a '.' or | |
2806 | ;; a prolog-head-delimiter | |
2807 | (progn | |
2808 | (setq retval (point)) | |
2809 | (setq notdone nil)) | |
2810 | ) | |
2811 | (t nil) ; Do nothing | |
2812 | )))) | |
dbed16aa | 2813 | |
e2019526 SB |
2814 | retval))) |
2815 | ||
2816 | (defun prolog-clause-end (&optional not-allow-methods) | |
2817 | "Return the position at the end of the current clause. | |
2818 | If NOTALLOWMETHODS is non-nil then do not match on methods in | |
eb89dc14 | 2819 | objects (relevant only if `prolog-system' is set to `sicstus')." |
e2019526 | 2820 | (save-excursion |
dbed16aa SM |
2821 | (beginning-of-line) ; Necessary since we use "^...." for the search. |
2822 | (if (re-search-forward | |
e2019526 SB |
2823 | (if (and (not not-allow-methods) |
2824 | (eq prolog-system 'sicstus) | |
2825 | (prolog-in-object)) | |
2826 | (format | |
2827 | "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*&[ \t]*\\(\\|%%.*\\)$\\|[ \t]*}" | |
2828 | prolog-quoted-atom-regexp prolog-string-regexp) | |
2829 | (format | |
2830 | "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\.[ \t]*\\(\\|%%.*\\)$" | |
2831 | prolog-quoted-atom-regexp prolog-string-regexp)) | |
2832 | nil t) | |
eb89dc14 | 2833 | (if (and (nth 8 (syntax-ppss)) |
e2019526 SB |
2834 | (not (eobp))) |
2835 | (progn | |
2836 | (forward-char) | |
2837 | (prolog-clause-end)) | |
2838 | (point)) | |
2839 | (point)))) | |
2840 | ||
2841 | (defun prolog-clause-info () | |
2842 | "Return a (name arity) list for the current clause." | |
dbed16aa SM |
2843 | (save-excursion |
2844 | (goto-char (prolog-clause-start)) | |
2845 | (let* ((op (point)) | |
2846 | (predname | |
2847 | (if (looking-at prolog-atom-char-regexp) | |
2848 | (progn | |
2849 | (skip-chars-forward "^ (\\.") | |
2850 | (buffer-substring op (point))) | |
2851 | "")) | |
2852 | (arity 0)) | |
2853 | ;; Retrieve the arity. | |
2854 | (if (looking-at prolog-left-paren) | |
2855 | (let ((endp (save-excursion | |
eb89dc14 | 2856 | (forward-list) (point)))) |
dbed16aa SM |
2857 | (setq arity 1) |
2858 | (forward-char 1) ; Skip the opening paren. | |
2859 | (while (progn | |
2860 | (skip-chars-forward "^[({,'\"") | |
2861 | (< (point) endp)) | |
2862 | (if (looking-at ",") | |
2863 | (progn | |
2864 | (setq arity (1+ arity)) | |
2865 | (forward-char 1) ; Skip the comma. | |
2866 | ) | |
2867 | ;; We found a string, list or something else we want | |
eb89dc14 SM |
2868 | ;; to skip over. |
2869 | (forward-sexp 1)) | |
dbed16aa SM |
2870 | ))) |
2871 | (list predname arity)))) | |
e2019526 SB |
2872 | |
2873 | (defun prolog-in-object () | |
2874 | "Return object name if the point is inside a SICStus object definition." | |
2875 | ;; Return object name if the last line that starts with a character | |
2876 | ;; that is neither white space nor a comment start | |
2877 | (save-excursion | |
dbed16aa | 2878 | (if (save-excursion |
e2019526 SB |
2879 | (beginning-of-line) |
2880 | (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{")) | |
2881 | ;; We were in the head of the object | |
2882 | (match-string 1) | |
2883 | ;; We were not in the head | |
2884 | (if (and (re-search-backward "^[a-z$'}]" nil t) | |
2885 | (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{")) | |
2886 | (match-string 1) | |
2887 | nil)))) | |
2888 | ||
e2019526 SB |
2889 | (defun prolog-beginning-of-clause () |
2890 | "Move to the beginning of current clause. | |
2891 | If already at the beginning of clause, move to previous clause." | |
2892 | (interactive) | |
2893 | (let ((point (point)) | |
2894 | (new-point (prolog-clause-start))) | |
2895 | (if (and (>= new-point point) | |
2896 | (> point 1)) | |
2897 | (progn | |
2898 | (goto-char (1- point)) | |
2899 | (goto-char (prolog-clause-start))) | |
2900 | (goto-char new-point) | |
2901 | (skip-chars-forward " \t")))) | |
2902 | ||
2903 | ;; (defun prolog-previous-clause () | |
2904 | ;; "Move to the beginning of the previous clause." | |
2905 | ;; (interactive) | |
2906 | ;; (forward-char -1) | |
2907 | ;; (prolog-beginning-of-clause)) | |
2908 | ||
2909 | (defun prolog-end-of-clause () | |
2910 | "Move to the end of clause. | |
2911 | If already at the end of clause, move to next clause." | |
2912 | (interactive) | |
2913 | (let ((point (point)) | |
2914 | (new-point (prolog-clause-end))) | |
2915 | (if (and (<= new-point point) | |
2916 | (not (eq new-point (point-max)))) | |
2917 | (progn | |
2918 | (goto-char (1+ point)) | |
2919 | (goto-char (prolog-clause-end))) | |
2920 | (goto-char new-point)))) | |
2921 | ||
2922 | ;; (defun prolog-next-clause () | |
2923 | ;; "Move to the beginning of the next clause." | |
2924 | ;; (interactive) | |
2925 | ;; (prolog-end-of-clause) | |
2926 | ;; (forward-char) | |
2927 | ;; (prolog-end-of-clause) | |
2928 | ;; (prolog-beginning-of-clause)) | |
2929 | ||
2930 | (defun prolog-beginning-of-predicate () | |
2931 | "Go to the nearest beginning of predicate before current point. | |
2932 | Return the final point or nil if no such a beginning was found." | |
2171cea5 | 2933 | ;; FIXME: Hook into beginning-of-defun. |
e2019526 SB |
2934 | (interactive) |
2935 | (let ((op (point)) | |
2936 | (pos (prolog-pred-start))) | |
2937 | (if pos | |
2938 | (if (= op pos) | |
2939 | (if (not (bobp)) | |
2940 | (progn | |
2941 | (goto-char pos) | |
2942 | (backward-char 1) | |
2943 | (setq pos (prolog-pred-start)) | |
2944 | (if pos | |
2945 | (progn | |
2946 | (goto-char pos) | |
2947 | (point))))) | |
2948 | (goto-char pos) | |
2949 | (point))))) | |
2950 | ||
2951 | (defun prolog-end-of-predicate () | |
2952 | "Go to the end of the current predicate." | |
2171cea5 | 2953 | ;; FIXME: Hook into end-of-defun. |
e2019526 SB |
2954 | (interactive) |
2955 | (let ((op (point))) | |
2956 | (goto-char (prolog-pred-end)) | |
2957 | (if (= op (point)) | |
2958 | (progn | |
2959 | (forward-line 1) | |
2960 | (prolog-end-of-predicate))))) | |
2961 | ||
2962 | (defun prolog-insert-predspec () | |
2963 | "Insert the predspec for the current predicate." | |
2964 | (interactive) | |
2965 | (let* ((pinfo (prolog-clause-info)) | |
2966 | (predname (nth 0 pinfo)) | |
2967 | (arity (nth 1 pinfo))) | |
2968 | (insert (format "%s/%d" predname arity)))) | |
2969 | ||
2970 | (defun prolog-view-predspec () | |
2971 | "Insert the predspec for the current predicate." | |
2972 | (interactive) | |
2973 | (let* ((pinfo (prolog-clause-info)) | |
2974 | (predname (nth 0 pinfo)) | |
2975 | (arity (nth 1 pinfo))) | |
2976 | (message (format "%s/%d" predname arity)))) | |
2977 | ||
2978 | (defun prolog-insert-predicate-template () | |
2979 | "Insert the template for the current clause." | |
2980 | (interactive) | |
2981 | (let* ((n 1) | |
2982 | oldp | |
2983 | (pinfo (prolog-clause-info)) | |
2984 | (predname (nth 0 pinfo)) | |
2985 | (arity (nth 1 pinfo))) | |
2986 | (insert predname) | |
2987 | (if (> arity 0) | |
2988 | (progn | |
2989 | (insert "(") | |
2990 | (when prolog-electric-dot-full-predicate-template | |
2991 | (setq oldp (point)) | |
2992 | (while (< n arity) | |
2993 | (insert ",") | |
2994 | (setq n (1+ n))) | |
2995 | (insert ")") | |
2996 | (goto-char oldp)) | |
2997 | )) | |
2998 | )) | |
2999 | ||
3000 | (defun prolog-insert-next-clause () | |
3001 | "Insert newline and the name of the current clause." | |
3002 | (interactive) | |
3003 | (insert "\n") | |
3004 | (prolog-insert-predicate-template)) | |
3005 | ||
3006 | (defun prolog-insert-module-modeline () | |
3007 | "Insert a modeline for module specification. | |
3008 | This line should be first in the buffer. | |
3009 | The module name should be written manually just before the semi-colon." | |
3010 | (interactive) | |
3011 | (insert "%%% -*- Module: ; -*-\n") | |
3012 | (backward-char 6)) | |
3013 | ||
04380ff1 SM |
3014 | (defalias 'prolog-uncomment-region |
3015 | (if (fboundp 'uncomment-region) #'uncomment-region | |
3016 | (lambda (beg end) | |
3017 | "Uncomment the region between BEG and END." | |
3018 | (interactive "r") | |
3019 | (comment-region beg end -1)))) | |
e2019526 | 3020 | |
e2019526 | 3021 | (defun prolog-indent-predicate () |
fb7ada5f | 3022 | "Indent the current predicate." |
e2019526 SB |
3023 | (interactive) |
3024 | (indent-region (prolog-pred-start) (prolog-pred-end) nil)) | |
3025 | ||
3026 | (defun prolog-indent-buffer () | |
fb7ada5f | 3027 | "Indent the entire buffer." |
e2019526 SB |
3028 | (interactive) |
3029 | (indent-region (point-min) (point-max) nil)) | |
3030 | ||
3031 | (defun prolog-mark-clause () | |
3032 | "Put mark at the end of this clause and move point to the beginning." | |
3033 | (interactive) | |
3034 | (let ((pos (point))) | |
3035 | (goto-char (prolog-clause-end)) | |
3036 | (forward-line 1) | |
3037 | (beginning-of-line) | |
3038 | (set-mark (point)) | |
3039 | (goto-char pos) | |
3040 | (goto-char (prolog-clause-start)))) | |
3041 | ||
3042 | (defun prolog-mark-predicate () | |
3043 | "Put mark at the end of this predicate and move point to the beginning." | |
3044 | (interactive) | |
dbed16aa SM |
3045 | (goto-char (prolog-pred-end)) |
3046 | (let ((pos (point))) | |
e2019526 SB |
3047 | (forward-line 1) |
3048 | (beginning-of-line) | |
3049 | (set-mark (point)) | |
3050 | (goto-char pos) | |
3051 | (goto-char (prolog-pred-start)))) | |
3052 | ||
eb89dc14 | 3053 | (defun prolog-electric--colon () |
04380ff1 SM |
3054 | "If `prolog-electric-colon-flag' is non-nil, insert the electric `:' construct. |
3055 | That is, insert space (if appropriate), `:-' and newline if colon is pressed | |
eb89dc14 SM |
3056 | at the end of a line that starts in the first column (i.e., clause heads)." |
3057 | (when (and prolog-electric-colon-flag | |
3058 | (eq (char-before) ?:) | |
3059 | (not current-prefix-arg) | |
3060 | (eolp) | |
3061 | (not (memq (char-after (line-beginning-position)) | |
3062 | '(?\s ?\t ?\%)))) | |
3063 | (unless (memq (char-before (1- (point))) '(?\s ?\t)) | |
3064 | (save-excursion (forward-char -1) (insert " "))) | |
3065 | (insert "-\n") | |
3066 | (indent-according-to-mode))) | |
3067 | ||
3068 | (defun prolog-electric--dash () | |
04380ff1 SM |
3069 | "If `prolog-electric-dash-flag' is non-nil, insert the electric `-' construct. |
3070 | that is, insert space (if appropriate), `-->' and newline if dash is pressed | |
eb89dc14 SM |
3071 | at the end of a line that starts in the first column (i.e., DCG heads)." |
3072 | (when (and prolog-electric-dash-flag | |
3073 | (eq (char-before) ?-) | |
3074 | (not current-prefix-arg) | |
3075 | (eolp) | |
3076 | (not (memq (char-after (line-beginning-position)) | |
3077 | '(?\s ?\t ?\%)))) | |
3078 | (unless (memq (char-before (1- (point))) '(?\s ?\t)) | |
3079 | (save-excursion (forward-char -1) (insert " "))) | |
3080 | (insert "->\n") | |
3081 | (indent-according-to-mode))) | |
3082 | ||
3083 | (defun prolog-electric--dot () | |
3084 | "Make dot electric, if `prolog-electric-dot-flag' is non-nil. | |
e2019526 SB |
3085 | When invoked at the end of nonempty line, insert dot and newline. |
3086 | When invoked at the end of an empty line, insert a recursive call to | |
3087 | the current predicate. | |
3088 | When invoked at the beginning of line, insert a head of a new clause | |
eb89dc14 | 3089 | of the current predicate." |
e2019526 SB |
3090 | ;; Check for situations when the electricity should not be active |
3091 | (if (or (not prolog-electric-dot-flag) | |
eb89dc14 SM |
3092 | (not (eq (char-before) ?\.)) |
3093 | current-prefix-arg | |
3094 | (nth 8 (syntax-ppss)) | |
e2019526 | 3095 | ;; Do not be electric in a floating point number or an operator |
dbed16aa | 3096 | (not |
eb89dc14 SM |
3097 | (save-excursion |
3098 | (forward-char -1) | |
3099 | (skip-chars-backward " \t") | |
3100 | (let ((num (> (skip-chars-backward "0-9") 0))) | |
3101 | (or (bolp) | |
3102 | (memq (char-syntax (char-before)) | |
3103 | (if num '(?w ?_) '(?\) ?w ?_))))))) | |
e2019526 | 3104 | ;; Do not be electric if inside a parenthesis pair. |
eb89dc14 | 3105 | (not (= (car (syntax-ppss)) |
e2019526 SB |
3106 | 0)) |
3107 | ) | |
eb89dc14 | 3108 | nil ;;Not electric. |
e2019526 SB |
3109 | (cond |
3110 | ;; Beginning of line | |
eb89dc14 SM |
3111 | ((save-excursion (forward-char -1) (bolp)) |
3112 | (delete-region (1- (point)) (point)) ;Delete the dot that called us. | |
e2019526 SB |
3113 | (prolog-insert-predicate-template)) |
3114 | ;; At an empty line with at least one whitespace | |
3115 | ((save-excursion | |
3116 | (beginning-of-line) | |
eb89dc14 SM |
3117 | (looking-at "[ \t]+\\.$")) |
3118 | (delete-region (1- (point)) (point)) ;Delete the dot that called us. | |
e2019526 SB |
3119 | (prolog-insert-predicate-template) |
3120 | (when prolog-electric-dot-full-predicate-template | |
dbed16aa | 3121 | (save-excursion |
e2019526 | 3122 | (end-of-line) |
dbed16aa | 3123 | (insert ".\n")))) |
e2019526 SB |
3124 | ;; Default |
3125 | (t | |
eb89dc14 | 3126 | (insert "\n")) |
e2019526 SB |
3127 | ))) |
3128 | ||
eb89dc14 | 3129 | (defun prolog-electric--underscore () |
e2019526 SB |
3130 | "Replace variable with an underscore. |
3131 | If `prolog-electric-underscore-flag' is non-nil and the point is | |
3132 | on a variable then replace the variable with underscore and skip | |
eb89dc14 SM |
3133 | the following comma and whitespace, if any." |
3134 | (when prolog-electric-underscore-flag | |
3135 | (let ((case-fold-search nil)) | |
3136 | (when (and (not (nth 8 (syntax-ppss))) | |
3137 | (eq (char-before) ?_) | |
3138 | (save-excursion | |
3139 | (skip-chars-backward "[:alpha:]_") | |
3140 | (looking-at "\\<_[_[:upper:]][[:alnum:]_]*\\_>"))) | |
3141 | (replace-match "_") | |
3142 | (skip-chars-forward ", \t\n"))))) | |
3143 | ||
3144 | (defun prolog-post-self-insert () | |
3145 | (pcase last-command-event | |
3146 | (`?_ (prolog-electric--underscore)) | |
3147 | (`?- (prolog-electric--dash)) | |
3148 | (`?: (prolog-electric--colon)) | |
3149 | ((or `?\( `?\; `?>) (prolog-electric--if-then-else)) | |
3150 | (`?. (prolog-electric--dot)))) | |
e2019526 SB |
3151 | |
3152 | (defun prolog-find-term (functor arity &optional prefix) | |
01c35094 | 3153 | "Go to the position at the start of the next occurrence of a term. |
04380ff1 | 3154 | The term is specified with FUNCTOR and ARITY. The optional argument |
e2019526 SB |
3155 | PREFIX is the prefix of the search regexp." |
3156 | (let* (;; If prefix is not set then use the default "\\<" | |
3157 | (prefix (if (not prefix) | |
3158 | "\\<" | |
3159 | prefix)) | |
3160 | (regexp (concat prefix functor)) | |
3161 | (i 1)) | |
dbed16aa | 3162 | |
e2019526 SB |
3163 | ;; Build regexp for the search if the arity is > 0 |
3164 | (if (= arity 0) | |
3165 | ;; Add that the functor must be at the end of a word. This | |
3166 | ;; does not work if the arity is > 0 since the closing ) | |
3167 | ;; is not a word constituent. | |
3168 | (setq regexp (concat regexp "\\>")) | |
3169 | ;; Arity is > 0, add parens and commas | |
3170 | (setq regexp (concat regexp "(")) | |
3171 | (while (< i arity) | |
3172 | (setq regexp (concat regexp ".+,")) | |
3173 | (setq i (1+ i))) | |
3174 | (setq regexp (concat regexp ".+)"))) | |
dbed16aa | 3175 | |
e2019526 SB |
3176 | ;; Search, and return position |
3177 | (if (re-search-forward regexp nil t) | |
3178 | (goto-char (match-beginning 0)) | |
3179 | (error "Term not found")) | |
3180 | )) | |
3181 | ||
3182 | (defun prolog-variables-to-anonymous (beg end) | |
3183 | "Replace all variables within a region BEG to END by anonymous variables." | |
3184 | (interactive "r") | |
3185 | (save-excursion | |
dbed16aa | 3186 | (let ((case-fold-search nil)) |
e2019526 SB |
3187 | (goto-char end) |
3188 | (while (re-search-backward "\\<[A-Z_][a-zA-Z_0-9]*\\>" beg t) | |
3189 | (progn | |
3190 | (replace-match "_") | |
3191 | (backward-char))) | |
e2019526 SB |
3192 | ))) |
3193 | ||
2171cea5 SM |
3194 | ;;(defun prolog-regexp-dash-continuous-chars (chars) |
3195 | ;; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars))) | |
3196 | ;; (beg 0) | |
3197 | ;; (end 0)) | |
3198 | ;; (if (null ints) | |
3199 | ;; chars | |
3200 | ;; (while (and (< (+ beg 1) (length chars)) | |
3201 | ;; (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints)) | |
3202 | ;; (= (nth beg ints) (nth (+ beg 1) ints))))) | |
3203 | ;; (setq beg (+ beg 1))) | |
3204 | ;; (setq beg (+ beg 1) | |
3205 | ;; end beg) | |
3206 | ;; (while (and (< (+ end 1) (length chars)) | |
3207 | ;; (or (= (+ (nth end ints) 1) (nth (+ end 1) ints)) | |
3208 | ;; (= (nth end ints) (nth (+ end 1) ints)))) | |
3209 | ;; (setq end (+ end 1))) | |
3210 | ;; (if (equal (substring chars end) "") | |
3211 | ;; (substring chars 0 beg) | |
3212 | ;; (concat (substring chars 0 beg) "-" | |
3213 | ;; (prolog-regexp-dash-continuous-chars (substring chars end)))) | |
3214 | ;; ))) | |
3215 | ||
3216 | ;;(defun prolog-condense-character-sets (regexp) | |
3217 | ;; "Condense adjacent characters in character sets of REGEXP." | |
3218 | ;; (let ((next -1)) | |
3219 | ;; (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next))) | |
3220 | ;; (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp)) | |
3221 | ;; t t regexp 1)))) | |
3222 | ;; regexp) | |
e2019526 | 3223 | |
e2019526 SB |
3224 | ;;------------------------------------------------------------------- |
3225 | ;; Menu stuff (both for the editing buffer and for the inferior | |
3226 | ;; prolog buffer) | |
3227 | ;;------------------------------------------------------------------- | |
3228 | ||
3229 | (unless (fboundp 'region-exists-p) | |
3230 | (defun region-exists-p () | |
d136f184 | 3231 | "Non-nil if the mark is set. Lobotomized version for Emacsen that do not provide their own." |
e2019526 SB |
3232 | (mark))) |
3233 | ||
dbed16aa SM |
3234 | |
3235 | ;; GNU Emacs ignores `easy-menu-add' so the order in which the menus | |
3236 | ;; are defined _is_ important! | |
3237 | ||
3238 | (easy-menu-define | |
3239 | prolog-menu-help (list prolog-mode-map prolog-inferior-mode-map) | |
3240 | "Help menu for the Prolog mode." | |
3241 | ;; FIXME: Does it really deserve a whole menu to itself? | |
3242 | `(,(if (featurep 'xemacs) "Help" | |
3243 | ;; Not sure it's worth the trouble. --Stef | |
3244 | ;; (add-to-list 'menu-bar-final-items | |
3245 | ;; (easy-menu-intern "Prolog-Help")) | |
3246 | "Prolog-help") | |
3247 | ["On predicate" prolog-help-on-predicate prolog-help-function-i] | |
3248 | ["Apropos" prolog-help-apropos (eq prolog-system 'swi)] | |
3249 | "---" | |
3250 | ["Describe mode" describe-mode t])) | |
3251 | ||
3252 | (easy-menu-define | |
3253 | prolog-edit-menu-runtime prolog-mode-map | |
3254 | "Runtime Prolog commands available from the editing buffer" | |
3255 | ;; FIXME: Don't use a whole menu for just "Run Mercury". --Stef | |
3256 | `("System" | |
3257 | ;; Runtime menu name. | |
3258 | ,@(unless (featurep 'xemacs) | |
3259 | '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe") | |
3260 | ((eq prolog-system 'mercury) "Mercury") | |
3261 | (t "System")))) | |
3262 | ||
3263 | ;; Consult items, NIL for mercury. | |
3264 | ["Consult file" prolog-consult-file | |
3265 | :included (not (eq prolog-system 'mercury))] | |
3266 | ["Consult buffer" prolog-consult-buffer | |
3267 | :included (not (eq prolog-system 'mercury))] | |
3268 | ["Consult region" prolog-consult-region :active (region-exists-p) | |
3269 | :included (not (eq prolog-system 'mercury))] | |
3270 | ["Consult predicate" prolog-consult-predicate | |
3271 | :included (not (eq prolog-system 'mercury))] | |
3272 | ||
3273 | ;; Compile items, NIL for everything but SICSTUS. | |
3274 | ,(if (featurep 'xemacs) "---" | |
3275 | ["---" nil :included (eq prolog-system 'sicstus)]) | |
3276 | ["Compile file" prolog-compile-file | |
3277 | :included (eq prolog-system 'sicstus)] | |
3278 | ["Compile buffer" prolog-compile-buffer | |
3279 | :included (eq prolog-system 'sicstus)] | |
3280 | ["Compile region" prolog-compile-region :active (region-exists-p) | |
3281 | :included (eq prolog-system 'sicstus)] | |
3282 | ["Compile predicate" prolog-compile-predicate | |
3283 | :included (eq prolog-system 'sicstus)] | |
3284 | ||
3285 | ;; Debug items, NIL for Mercury. | |
3286 | ,(if (featurep 'xemacs) "---" | |
3287 | ["---" nil :included (not (eq prolog-system 'mercury))]) | |
3288 | ;; FIXME: Could we use toggle or radio buttons? --Stef | |
3289 | ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))] | |
3290 | ["Debug off" prolog-debug-off | |
3291 | ;; In SICStus, these are pairwise disjunctive, | |
3292 | ;; so it's enough with a single "off"-command | |
3293 | :included (not (memq prolog-system '(mercury sicstus)))] | |
3294 | ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))] | |
3295 | ["Trace off" prolog-trace-off | |
3296 | :included (not (memq prolog-system '(mercury sicstus)))] | |
3297 | ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus) | |
3298 | (prolog-atleast-version '(3 . 7)))] | |
3299 | ["All debug off" prolog-debug-off | |
3300 | :included (eq prolog-system 'sicstus)] | |
3301 | ["Source level debugging" | |
3302 | prolog-toggle-sicstus-sd | |
3303 | :included (and (eq prolog-system 'sicstus) | |
3304 | (prolog-atleast-version '(3 . 7))) | |
3305 | :style toggle | |
3306 | :selected prolog-use-sicstus-sd] | |
3307 | ||
3308 | "---" | |
3309 | ["Run" run-prolog | |
3310 | :suffix (cond ((eq prolog-system 'eclipse) "ECLiPSe") | |
3311 | ((eq prolog-system 'mercury) "Mercury") | |
3312 | (t "Prolog"))])) | |
3313 | ||
3314 | (easy-menu-define | |
3315 | prolog-edit-menu-insert-move prolog-mode-map | |
3316 | "Commands for Prolog code manipulation." | |
3317 | '("Prolog" | |
3318 | ["Comment region" comment-region (region-exists-p)] | |
3319 | ["Uncomment region" prolog-uncomment-region (region-exists-p)] | |
3320 | ["Add comment/move to comment" indent-for-comment t] | |
3321 | ["Convert variables in region to '_'" prolog-variables-to-anonymous | |
3322 | :active (region-exists-p) :included (not (eq prolog-system 'mercury))] | |
3323 | "---" | |
3324 | ["Insert predicate template" prolog-insert-predicate-template t] | |
3325 | ["Insert next clause head" prolog-insert-next-clause t] | |
3326 | ["Insert predicate spec" prolog-insert-predspec t] | |
3327 | ["Insert module modeline" prolog-insert-module-modeline t] | |
3328 | "---" | |
3329 | ["Beginning of clause" prolog-beginning-of-clause t] | |
3330 | ["End of clause" prolog-end-of-clause t] | |
3331 | ["Beginning of predicate" prolog-beginning-of-predicate t] | |
3332 | ["End of predicate" prolog-end-of-predicate t] | |
3333 | "---" | |
2171cea5 | 3334 | ["Indent line" indent-according-to-mode t] |
dbed16aa SM |
3335 | ["Indent region" indent-region (region-exists-p)] |
3336 | ["Indent predicate" prolog-indent-predicate t] | |
3337 | ["Indent buffer" prolog-indent-buffer t] | |
3338 | ["Align region" align (region-exists-p)] | |
3339 | "---" | |
3340 | ["Mark clause" prolog-mark-clause t] | |
3341 | ["Mark predicate" prolog-mark-predicate t] | |
3342 | ["Mark paragraph" mark-paragraph t] | |
dbed16aa SM |
3343 | )) |
3344 | ||
e2019526 | 3345 | (defun prolog-menu () |
dbed16aa | 3346 | "Add the menus for the Prolog editing buffers." |
e2019526 SB |
3347 | |
3348 | (easy-menu-add prolog-edit-menu-insert-move) | |
3349 | (easy-menu-add prolog-edit-menu-runtime) | |
3350 | ||
3351 | ;; Add predicate index menu | |
eb89dc14 SM |
3352 | (setq-local imenu-create-index-function |
3353 | 'imenu-default-create-index-function) | |
e2019526 | 3354 | ;;Milan (this has problems with object methods...) ###### Does it? (Stefan) |
eb89dc14 SM |
3355 | (setq-local imenu-prev-index-position-function |
3356 | #'prolog-beginning-of-predicate) | |
3357 | (setq-local imenu-extract-index-name-function #'prolog-get-predspec) | |
dbed16aa | 3358 | |
e2019526 SB |
3359 | (if (and prolog-imenu-flag |
3360 | (< (count-lines (point-min) (point-max)) prolog-imenu-max-lines)) | |
3361 | (imenu-add-to-menubar "Predicates")) | |
dbed16aa SM |
3362 | |
3363 | (easy-menu-add prolog-menu-help)) | |
3364 | ||
3365 | (easy-menu-define | |
3366 | prolog-inferior-menu-all prolog-inferior-mode-map | |
3367 | "Menu for the inferior Prolog buffer." | |
3368 | `("Prolog" | |
3369 | ;; Runtime menu name. | |
3370 | ,@(unless (featurep 'xemacs) | |
3371 | '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe") | |
3372 | ((eq prolog-system 'mercury) "Mercury") | |
3373 | (t "Prolog")))) | |
3374 | ||
3375 | ;; Debug items, NIL for Mercury. | |
3376 | ,(if (featurep 'xemacs) "---" | |
3377 | ["---" nil :included (not (eq prolog-system 'mercury))]) | |
3378 | ;; FIXME: Could we use toggle or radio buttons? --Stef | |
3379 | ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))] | |
3380 | ["Debug off" prolog-debug-off | |
3381 | ;; In SICStus, these are pairwise disjunctive, | |
3382 | ;; so it's enough with a single "off"-command | |
3383 | :included (not (memq prolog-system '(mercury sicstus)))] | |
3384 | ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))] | |
3385 | ["Trace off" prolog-trace-off | |
3386 | :included (not (memq prolog-system '(mercury sicstus)))] | |
3387 | ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus) | |
3388 | (prolog-atleast-version '(3 . 7)))] | |
3389 | ["All debug off" prolog-debug-off | |
3390 | :included (eq prolog-system 'sicstus)] | |
3391 | ["Source level debugging" | |
3392 | prolog-toggle-sicstus-sd | |
3393 | :included (and (eq prolog-system 'sicstus) | |
3394 | (prolog-atleast-version '(3 . 7))) | |
3395 | :style toggle | |
3396 | :selected prolog-use-sicstus-sd] | |
3397 | ||
3398 | ;; Runtime. | |
3399 | "---" | |
3400 | ["Interrupt Prolog" comint-interrupt-subjob t] | |
3401 | ["Quit Prolog" comint-quit-subjob t] | |
3402 | ["Kill Prolog" comint-kill-subjob t])) | |
3403 | ||
e2019526 SB |
3404 | |
3405 | (defun prolog-inferior-menu () | |
04380ff1 | 3406 | "Create the menus for the Prolog inferior buffer. |
e2019526 SB |
3407 | This menu is dynamically created because one may change systems during |
3408 | the life of an Emacs session." | |
e2019526 | 3409 | (easy-menu-add prolog-inferior-menu-all) |
dbed16aa | 3410 | (easy-menu-add prolog-menu-help)) |
e2019526 SB |
3411 | |
3412 | (defun prolog-mode-version () | |
3413 | "Echo the current version of Prolog mode in the minibuffer." | |
3414 | (interactive) | |
3415 | (message "Using Prolog mode version %s" prolog-mode-version)) | |
d364dee6 | 3416 | |
896546cd RS |
3417 | (provide 'prolog) |
3418 | ||
6594deb0 | 3419 | ;;; prolog.el ends here |