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