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