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