lisp/progmodes/prolog.el

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