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