code.delx.au - gnu-emacs/blob - 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 . ":-")
 992      (if (bolp)
 993          (save-excursion
 994            (smie-indent-forward-token)
 995            (skip-chars-forward " \t")
 996            (if (eolp)
 997                prolog-indent-width
 998              (min prolog-indent-width (current-column))))
 999        prolog-indent-width))
1000     (`(:after . "-->") prolog-indent-width)))
1001
1002 \f
1003 ;;-------------------------------------------------------------------
1004 ;; Prolog mode
1005 ;;-------------------------------------------------------------------
1006
1007 ;; Example: (prolog-atleast-version '(3 . 6))
1008 (defun prolog-atleast-version (version)
1009   "Return t if the version of the current prolog system is VERSION or later.
1010 VERSION is of the format (Major . Minor)"
1011   ;; Version.major < major or
1012   ;; Version.major = major and Version.minor <= minor
1013   (let* ((thisversion (prolog-find-value-by-system prolog-system-version))
1014          (thismajor (car thisversion))
1015          (thisminor (cdr thisversion)))
1016     (or (< (car version) thismajor)
1017         (and (= (car version) thismajor)
1018              (<= (cdr version) thisminor)))
1019     ))
1020
1021 (define-abbrev-table 'prolog-mode-abbrev-table ())
1022
1023 (defun prolog-find-value-by-system (alist)
1024   "Get value from ALIST according to `prolog-system'."
1025   (let ((system (or prolog-system
1026                     (let ((infbuf (prolog-inferior-buffer 'dont-run)))
1027                       (when infbuf
1028                         (buffer-local-value 'prolog-system infbuf))))))
1029     (if (listp alist)
1030         (let (result
1031               id)
1032           (while alist
1033             (setq id (car (car alist)))
1034             (if (or (eq id system)
1035                     (eq id t)
1036                     (and (listp id)
1037                          (eval id)))
1038                 (progn
1039                   (setq result (car (cdr (car alist))))
1040                   (if (and (listp result)
1041                            (eq (car result) 'eval))
1042                       (setq result (eval (car (cdr result)))))
1043                   (setq alist nil))
1044               (setq alist (cdr alist))))
1045           result)
1046       alist)))
1047
1048 (defconst prolog-syntax-propertize-function
1049   (when (fboundp 'syntax-propertize-rules)
1050     (syntax-propertize-rules
1051      ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
1052      ;; possible meaning of 0'' is rather clear.
1053      ("\\<0\\(''?\\)"
1054       (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
1055            (string-to-syntax "_"))))
1056      ;; We could check that we're not inside an atom, but I don't think
1057      ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
1058      ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
1059      ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
1060      ;; escape sequences in atoms, so be careful not to let the terminating \
1061      ;; escape a subsequent quote.
1062      ("\\\\[x0-7][0-9a-fA-F]*\\(\\\\\\)" (1 "_"))
1063      )))
1064
1065 (defun prolog-mode-variables ()
1066   "Set some common variables to Prolog code specific values."
1067   (setq-local local-abbrev-table prolog-mode-abbrev-table)
1068   (setq-local paragraph-start (concat "[ \t]*$\\|" page-delimiter)) ;'%%..'
1069   (setq-local paragraph-separate paragraph-start)
1070   (setq-local paragraph-ignore-fill-prefix t)
1071   (setq-local normal-auto-fill-function 'prolog-do-auto-fill)
1072   (setq-local comment-start "%")
1073   (setq-local comment-end "")
1074   (setq-local comment-add 1)
1075   (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)")
1076   (setq-local parens-require-spaces nil)
1077   ;; Initialize Prolog system specific variables
1078   (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
1079                  prolog-determinism-specificators prolog-directives
1080                  prolog-eof-string
1081                  ;; prolog-continued-prompt-regexp
1082                  prolog-help-function))
1083     (set (intern (concat (symbol-name var) "-i"))
1084          (prolog-find-value-by-system (symbol-value var))))
1085   (when (null (prolog-program-name))
1086     (setq-local compile-command (prolog-compile-string)))
1087   (setq-local font-lock-defaults
1088               '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
1089   (setq-local syntax-propertize-function prolog-syntax-propertize-function)
1090
1091   (smie-setup prolog-smie-grammar #'prolog-smie-rules
1092               :forward-token #'prolog-smie-forward-token
1093               :backward-token #'prolog-smie-backward-token))
1094
1095 (defun prolog-mode-keybindings-common (map)
1096   "Define keybindings common to both Prolog modes in MAP."
1097   (define-key map "\C-c?" 'prolog-help-on-predicate)
1098   (define-key map "\C-c/" 'prolog-help-apropos)
1099   (define-key map "\C-c\C-d" 'prolog-debug-on)
1100   (define-key map "\C-c\C-t" 'prolog-trace-on)
1101   (define-key map "\C-c\C-z" 'prolog-zip-on)
1102   (define-key map "\C-c\r" 'run-prolog))
1103
1104 (defun prolog-mode-keybindings-edit (map)
1105   "Define keybindings for Prolog mode in MAP."
1106   (define-key map "\M-a" 'prolog-beginning-of-clause)
1107   (define-key map "\M-e" 'prolog-end-of-clause)
1108   (define-key map "\M-q" 'prolog-fill-paragraph)
1109   (define-key map "\C-c\C-a" 'align)
1110   (define-key map "\C-\M-a" 'prolog-beginning-of-predicate)
1111   (define-key map "\C-\M-e" 'prolog-end-of-predicate)
1112   (define-key map "\M-\C-c" 'prolog-mark-clause)
1113   (define-key map "\M-\C-h" 'prolog-mark-predicate)
1114   (define-key map "\C-c\C-n" 'prolog-insert-predicate-template)
1115   (define-key map "\C-c\C-s" 'prolog-insert-predspec)
1116   (define-key map "\M-\r" 'prolog-insert-next-clause)
1117   (define-key map "\C-c\C-va" 'prolog-variables-to-anonymous)
1118   (define-key map "\C-c\C-v\C-s" 'prolog-view-predspec)
1119
1120   ;; If we're running SICStus, then map C-c C-c e/d to enabling
1121   ;; and disabling of the source-level debugging facilities.
1122   ;(if (and (eq prolog-system 'sicstus)
1123   ;         (prolog-atleast-version '(3 . 7)))
1124   ;    (progn
1125   ;      (define-key map "\C-c\C-ce" 'prolog-enable-sicstus-sd)
1126   ;      (define-key map "\C-c\C-cd" 'prolog-disable-sicstus-sd)
1127   ;      ))
1128
1129   (if prolog-old-sicstus-keys-flag
1130       (progn
1131         (define-key map "\C-c\C-c" 'prolog-consult-predicate)
1132         (define-key map "\C-cc" 'prolog-consult-region)
1133         (define-key map "\C-cC" 'prolog-consult-buffer)
1134         (define-key map "\C-c\C-k" 'prolog-compile-predicate)
1135         (define-key map "\C-ck" 'prolog-compile-region)
1136         (define-key map "\C-cK" 'prolog-compile-buffer))
1137     (define-key map "\C-c\C-p" 'prolog-consult-predicate)
1138     (define-key map "\C-c\C-r" 'prolog-consult-region)
1139     (define-key map "\C-c\C-b" 'prolog-consult-buffer)
1140     (define-key map "\C-c\C-f" 'prolog-consult-file)
1141     (define-key map "\C-c\C-cp" 'prolog-compile-predicate)
1142     (define-key map "\C-c\C-cr" 'prolog-compile-region)
1143     (define-key map "\C-c\C-cb" 'prolog-compile-buffer)
1144     (define-key map "\C-c\C-cf" 'prolog-compile-file))
1145
1146   ;; Inherited from the old prolog.el.
1147   (define-key map "\e\C-x" 'prolog-consult-region)
1148   (define-key map "\C-c\C-l" 'prolog-consult-file)
1149   (define-key map "\C-c\C-z" 'run-prolog))
1150
1151 (defun prolog-mode-keybindings-inferior (_map)
1152   "Define keybindings for inferior Prolog mode in MAP."
1153   ;; No inferior mode specific keybindings now.
1154   )
1155
1156 (defvar prolog-mode-map
1157   (let ((map (make-sparse-keymap)))
1158     (prolog-mode-keybindings-common map)
1159     (prolog-mode-keybindings-edit map)
1160     map))
1161
1162
1163 (defvar prolog-mode-hook nil
1164   "List of functions to call after the prolog mode has initialized.")
1165
1166 ;;;###autoload
1167 (define-derived-mode prolog-mode prog-mode "Prolog"
1168   "Major mode for editing Prolog code.
1169
1170 Blank lines and `%%...' separate paragraphs.  `%'s starts a comment
1171 line and comments can also be enclosed in /* ... */.
1172
1173 If an optional argument SYSTEM is non-nil, set up mode for the given system.
1174
1175 To find out what version of Prolog mode you are running, enter
1176 `\\[prolog-mode-version]'.
1177
1178 Commands:
1179 \\{prolog-mode-map}"
1180   (setq mode-name (concat "Prolog"
1181                           (cond
1182                            ((eq prolog-system 'eclipse) "[ECLiPSe]")
1183                            ((eq prolog-system 'sicstus) "[SICStus]")
1184                            ((eq prolog-system 'swi) "[SWI]")
1185                            ((eq prolog-system 'gnu) "[GNU]")
1186                            (t ""))))
1187   (prolog-mode-variables)
1188   (dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar))
1189   (add-hook 'post-self-insert-hook #'prolog-post-self-insert nil t)
1190   ;; `imenu' entry moved to the appropriate hook for consistency.
1191   (when prolog-electric-dot-flag
1192     (setq-local electric-indent-chars
1193                 (cons ?\. electric-indent-chars)))
1194
1195   ;; Load SICStus debugger if suitable
1196   (if (and (eq prolog-system 'sicstus)
1197            (prolog-atleast-version '(3 . 7))
1198            prolog-use-sicstus-sd)
1199       (prolog-enable-sicstus-sd))
1200
1201   (prolog-menu))
1202
1203 (defvar mercury-mode-map
1204   (let ((map (make-sparse-keymap)))
1205     (set-keymap-parent map prolog-mode-map)
1206     map))
1207
1208 ;;;###autoload
1209 (define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]"
1210   "Major mode for editing Mercury programs.
1211 Actually this is just customized `prolog-mode'."
1212   (setq-local prolog-system 'mercury))
1213
1214 \f
1215 ;;-------------------------------------------------------------------
1216 ;; Inferior prolog mode
1217 ;;-------------------------------------------------------------------
1218
1219 (defvar prolog-inferior-mode-map
1220   (let ((map (make-sparse-keymap)))
1221     (prolog-mode-keybindings-common map)
1222     (prolog-mode-keybindings-inferior map)
1223     (define-key map [remap self-insert-command]
1224       'prolog-inferior-self-insert-command)
1225     map))
1226
1227 (defvar prolog-inferior-mode-hook nil
1228   "List of functions to call after the inferior prolog mode has initialized.")
1229
1230 (defvar prolog-inferior-error-regexp-alist
1231   '(;; GNU Prolog used to not follow the GNU standard format.
1232     ;; ("^\\(.*?\\):\\([0-9]+\\) error: .*(char:\\([0-9]+\\)" 1 2 3)
1233     ;; SWI-Prolog.
1234     ("^\\(?:\\?- *\\)?\\(\\(?:ERROR\\|\\(W\\)arning\\): *\\(.*?\\):\\([1-9][0-9]*\\):\\(?:\\([0-9]*\\):\\)?\\)\\(?:$\\| \\)"
1235      3 4 5 (2 . nil) 1)
1236     ;; GNU-Prolog now uses the GNU standard format.
1237     gnu))
1238
1239 (defun prolog-inferior-self-insert-command ()
1240   "Insert the char in the buffer or pass it directly to the process."
1241   (interactive)
1242   (let* ((proc (get-buffer-process (current-buffer)))
1243          (pmark (and proc (marker-position (process-mark proc)))))
1244     ;; FIXME: the same treatment would be needed for SWI-Prolog, but I can't
1245     ;; seem to find any way for Emacs to figure out when to use it because
1246     ;; SWI doesn't include a " ? " or some such recognizable marker.
1247     (if (and (eq prolog-system 'gnu)
1248              pmark
1249              (null current-prefix-arg)
1250              (eobp)
1251              (eq (point) pmark)
1252              (save-excursion
1253                (goto-char (- pmark 3))
1254                ;; FIXME: check this comes from the process's output, maybe?
1255                (looking-at " \\? ")))
1256         ;; This is GNU prolog waiting to know whether you want more answers
1257         ;; or not (or abort, etc...).  The answer is a single char, not
1258         ;; a line, so pass this char directly rather than wait for RET to
1259         ;; send a whole line.
1260         (comint-send-string proc (string last-command-event))
1261       (call-interactively 'self-insert-command))))
1262
1263 (declare-function 'compilation-shell-minor-mode "compile" (&optional arg))
1264 (defvar compilation-error-regexp-alist)
1265
1266 (define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog"
1267   "Major mode for interacting with an inferior Prolog process.
1268
1269 The following commands are available:
1270 \\{prolog-inferior-mode-map}
1271
1272 Entry to this mode calls the value of `prolog-mode-hook' with no arguments,
1273 if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
1274 `prolog-mode-hook' is called after `comint-mode-hook'.
1275
1276 You can send text to the inferior Prolog from other buffers
1277 using the commands `send-region', `send-string' and \\[prolog-consult-region].
1278
1279 Commands:
1280 Tab indents for Prolog; with argument, shifts rest
1281  of expression rigidly with the current line.
1282 Paragraphs are separated only by blank lines and `%%'. `%'s start comments.
1283
1284 Return at end of buffer sends line as input.
1285 Return not at end copies rest of line to end and sends it.
1286 \\[comint-delchar-or-maybe-eof] sends end-of-file as input.
1287 \\[comint-kill-input] and \\[backward-kill-word] are kill commands,
1288 imitating normal Unix input editing.
1289 \\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
1290 \\[comint-stop-subjob] stops, likewise.
1291 \\[comint-quit-subjob] sends quit signal, likewise.
1292
1293 To find out what version of Prolog mode you are running, enter
1294 `\\[prolog-mode-version]'."
1295   (require 'compile)
1296   (setq comint-input-filter 'prolog-input-filter)
1297   (setq mode-line-process '(": %s"))
1298   (prolog-mode-variables)
1299   (setq comint-prompt-regexp (prolog-prompt-regexp))
1300   (setq-local shell-dirstack-query "pwd.")
1301   (setq-local compilation-error-regexp-alist
1302               prolog-inferior-error-regexp-alist)
1303   (compilation-shell-minor-mode)
1304   (prolog-inferior-menu))
1305
1306 (defun prolog-input-filter (str)
1307   (cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace
1308         ((not (derived-mode-p 'prolog-inferior-mode)) t)
1309         ((= (length str) 1) nil)        ;one character
1310         ((string-match "\\`[rf] *[0-9]*\\'" str) nil) ;r(edo) or f(ail)
1311         (t t)))
1312
1313 ;; This statement was missing in Emacs 24.1, 24.2, 24.3.
1314 (define-obsolete-function-alias 'switch-to-prolog 'run-prolog "24.1")
1315 ;;;###autoload
1316 (defun run-prolog (arg)
1317   "Run an inferior Prolog process, input and output via buffer *prolog*.
1318 With prefix argument ARG, restart the Prolog process if running before."
1319   (interactive "P")
1320   ;; FIXME: It should be possible to interactively specify the command to use
1321   ;; to run prolog.
1322   (if (and arg (get-process "prolog"))
1323       (progn
1324         (process-send-string "prolog" "halt.\n")
1325         (while (get-process "prolog") (sit-for 0.1))))
1326   (let ((buff (buffer-name)))
1327     (if (not (string= buff "*prolog*"))
1328         (prolog-goto-prolog-process-buffer))
1329     ;; Load SICStus debugger if suitable
1330     (if (and (eq prolog-system 'sicstus)
1331              (prolog-atleast-version '(3 . 7))
1332              prolog-use-sicstus-sd)
1333         (prolog-enable-sicstus-sd))
1334     (prolog-mode-variables)
1335     (prolog-ensure-process)
1336     ))
1337
1338 (defun prolog-inferior-guess-flavor (&optional ignored)
1339   (setq-local prolog-system
1340               (when (or (numberp prolog-system) (markerp prolog-system))
1341                 (save-excursion
1342                   (goto-char (1+ prolog-system))
1343                   (cond
1344                    ((looking-at "GNU Prolog") 'gnu)
1345                    ((looking-at "Welcome to SWI-Prolog\\|%.*\\<swi_") 'swi)
1346                    ((looking-at ".*\n") nil) ;There's at least one line.
1347                    (t prolog-system)))))
1348   (when (symbolp prolog-system)
1349     (remove-hook 'comint-output-filter-functions
1350                  'prolog-inferior-guess-flavor t)
1351     (when prolog-system
1352       (setq comint-prompt-regexp (prolog-prompt-regexp))
1353       (if (eq prolog-system 'gnu)
1354           (setq-local comint-process-echoes t)))))
1355
1356 (defun prolog-ensure-process (&optional wait)
1357   "If Prolog process is not running, run it.
1358 If the optional argument WAIT is non-nil, wait for Prolog prompt specified by
1359 the variable `prolog-prompt-regexp'."
1360   (if (null (prolog-program-name))
1361       (error "This Prolog system has defined no interpreter."))
1362   (if (comint-check-proc "*prolog*")
1363       ()
1364     (with-current-buffer (get-buffer-create "*prolog*")
1365       (prolog-inferior-mode)
1366       (apply 'make-comint-in-buffer "prolog" (current-buffer)
1367              (prolog-program-name) nil (prolog-program-switches))
1368       (unless prolog-system
1369         ;; Setup auto-detection.
1370         (setq-local
1371          prolog-system
1372          ;; Force re-detection.
1373          (let* ((proc (get-buffer-process (current-buffer)))
1374                 (pmark (and proc (marker-position (process-mark proc)))))
1375            (cond
1376             ((null pmark) (1- (point-min)))
1377             ;; The use of insert-before-markers in comint.el together with
1378             ;; the potential use of comint-truncate-buffer in the output
1379             ;; filter, means that it's difficult to reliably keep track of
1380             ;; the buffer position where the process's output started.
1381             ;; If possible we use a marker at "start - 1", so that
1382             ;; insert-before-marker at `start' won't shift it.  And if not,
1383             ;; we fall back on using a plain integer.
1384             ((> pmark (point-min)) (copy-marker (1- pmark)))
1385             (t (1- pmark)))))
1386         (add-hook 'comint-output-filter-functions
1387                   'prolog-inferior-guess-flavor nil t))
1388       (if wait
1389           (progn
1390             (goto-char (point-max))
1391             (while
1392                 (save-excursion
1393                   (not
1394                    (re-search-backward
1395                     (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
1396                     nil t)))
1397               (sit-for 0.1)))))))
1398
1399 (defun prolog-inferior-buffer (&optional dont-run)
1400   (or (get-buffer "*prolog*")
1401       (unless dont-run
1402         (prolog-ensure-process)
1403         (get-buffer "*prolog*"))))
1404
1405 (defun prolog-process-insert-string (process string)
1406   "Insert STRING into inferior Prolog buffer running PROCESS."
1407   ;; Copied from elisp manual, greek to me
1408   (with-current-buffer (process-buffer process)
1409     ;; FIXME: Use window-point-insertion-type instead.
1410     (let ((moving (= (point) (process-mark process))))
1411       (save-excursion
1412         ;; Insert the text, moving the process-marker.
1413         (goto-char (process-mark process))
1414         (insert string)
1415         (set-marker (process-mark process) (point)))
1416       (if moving (goto-char (process-mark process))))))
1417 \f
1418 ;;------------------------------------------------------------
1419 ;; Old consulting and compiling functions
1420 ;;------------------------------------------------------------
1421
1422 (declare-function compilation-forget-errors "compile" ())
1423 (declare-function compilation-fake-loc "compile"
1424                   (marker file &optional line col))
1425
1426 (defun prolog-old-process-region (compilep start end)
1427   "Process the region limited by START and END positions.
1428 If COMPILEP is non-nil then use compilation, otherwise consulting."
1429    (prolog-ensure-process)
1430    ;(let ((tmpfile prolog-temp-filename)
1431    (let ((tmpfile (prolog-temporary-file))
1432          ;(process (get-process "prolog"))
1433          (first-line (1+ (count-lines
1434                           (point-min)
1435                           (save-excursion
1436                             (goto-char start)
1437                             (point))))))
1438      (write-region start end tmpfile)
1439      (setq start (copy-marker start))
1440      (with-current-buffer (prolog-inferior-buffer)
1441        (compilation-forget-errors)
1442        (compilation-fake-loc start tmpfile))
1443      (process-send-string
1444       "prolog" (prolog-build-prolog-command
1445                 compilep tmpfile (prolog-bsts buffer-file-name)
1446                 first-line))
1447      (prolog-goto-prolog-process-buffer)))
1448
1449 (defun prolog-old-process-predicate (compilep)
1450   "Process the predicate around point.
1451 If COMPILEP is non-nil then use compilation, otherwise consulting."
1452   (prolog-old-process-region
1453    compilep (prolog-pred-start) (prolog-pred-end)))
1454
1455 (defun prolog-old-process-buffer (compilep)
1456   "Process the entire buffer.
1457 If COMPILEP is non-nil then use compilation, otherwise consulting."
1458   (prolog-old-process-region compilep (point-min) (point-max)))
1459
1460 (defun prolog-old-process-file (compilep)
1461   "Process the file of the current buffer.
1462 If COMPILEP is non-nil then use compilation, otherwise consulting."
1463   (save-some-buffers)
1464   (prolog-ensure-process)
1465   (with-current-buffer (prolog-inferior-buffer)
1466     (compilation-forget-errors))
1467     (process-send-string
1468      "prolog" (prolog-build-prolog-command
1469              compilep buffer-file-name
1470              (prolog-bsts buffer-file-name)))
1471   (prolog-goto-prolog-process-buffer))
1472
1473 \f
1474 ;;------------------------------------------------------------
1475 ;; Consulting and compiling
1476 ;;------------------------------------------------------------
1477
1478 ;; Interactive interface functions, used by both the standard
1479 ;; and the experimental consultation and compilation functions
1480 (defun prolog-consult-file ()
1481   "Consult file of current buffer."
1482   (interactive)
1483   (if prolog-use-standard-consult-compile-method-flag
1484       (prolog-old-process-file nil)
1485     (prolog-consult-compile-file nil)))
1486
1487 (defun prolog-consult-buffer ()
1488   "Consult buffer."
1489   (interactive)
1490   (if prolog-use-standard-consult-compile-method-flag
1491       (prolog-old-process-buffer nil)
1492     (prolog-consult-compile-buffer nil)))
1493
1494 (defun prolog-consult-region (beg end)
1495   "Consult region between BEG and END."
1496   (interactive "r")
1497   (if prolog-use-standard-consult-compile-method-flag
1498       (prolog-old-process-region nil beg end)
1499     (prolog-consult-compile-region nil beg end)))
1500
1501 (defun prolog-consult-predicate ()
1502   "Consult the predicate around current point."
1503   (interactive)
1504   (if prolog-use-standard-consult-compile-method-flag
1505       (prolog-old-process-predicate nil)
1506     (prolog-consult-compile-predicate nil)))
1507
1508 (defun prolog-compile-file ()
1509   "Compile file of current buffer."
1510   (interactive)
1511   (if prolog-use-standard-consult-compile-method-flag
1512       (prolog-old-process-file t)
1513     (prolog-consult-compile-file t)))
1514
1515 (defun prolog-compile-buffer ()
1516   "Compile buffer."
1517   (interactive)
1518   (if prolog-use-standard-consult-compile-method-flag
1519       (prolog-old-process-buffer t)
1520     (prolog-consult-compile-buffer t)))
1521
1522 (defun prolog-compile-region (beg end)
1523   "Compile region between BEG and END."
1524   (interactive "r")
1525   (if prolog-use-standard-consult-compile-method-flag
1526       (prolog-old-process-region t beg end)
1527     (prolog-consult-compile-region t beg end)))
1528
1529 (defun prolog-compile-predicate ()
1530   "Compile the predicate around current point."
1531   (interactive)
1532   (if prolog-use-standard-consult-compile-method-flag
1533       (prolog-old-process-predicate t)
1534     (prolog-consult-compile-predicate t)))
1535
1536 (defun prolog-buffer-module ()
1537   "Select Prolog module name appropriate for current buffer.
1538 Bases decision on buffer contents (-*- line)."
1539   ;; Look for -*- ... module: MODULENAME; ... -*-
1540   (let (beg end)
1541     (save-excursion
1542       (goto-char (point-min))
1543       (skip-chars-forward " \t")
1544       (and (search-forward "-*-" (line-end-position) t)
1545            (progn
1546              (skip-chars-forward " \t")
1547              (setq beg (point))
1548              (search-forward "-*-" (line-end-position) t))
1549            (progn
1550              (forward-char -3)
1551              (skip-chars-backward " \t")
1552              (setq end (point))
1553              (goto-char beg)
1554              (and (let ((case-fold-search t))
1555                     (search-forward "module:" end t))
1556                   (progn
1557                     (skip-chars-forward " \t")
1558                     (setq beg (point))
1559                     (if (search-forward ";" end t)
1560                         (forward-char -1)
1561                       (goto-char end))
1562                     (skip-chars-backward " \t")
1563                     (buffer-substring beg (point)))))))))
1564
1565 (defun prolog-build-prolog-command (compilep file buffername
1566                                     &optional first-line)
1567   "Make Prolog command for FILE compilation/consulting.
1568 If COMPILEP is non-nil, consider compilation, otherwise consulting."
1569   (let* ((compile-string
1570           ;; FIXME: If the process is not running yet, the auto-detection of
1571           ;; prolog-system won't help here, so we should make sure
1572           ;; we first run Prolog and then build the command.
1573           (if compilep (prolog-compile-string) (prolog-consult-string)))
1574          (module (prolog-buffer-module))
1575          (file-name (concat "'" (prolog-bsts file) "'"))
1576          (module-name (if module (concat "'" module "'")))
1577          (module-file (if module
1578                           (concat module-name ":" file-name)
1579                         file-name))
1580          strbeg strend
1581          (lineoffset (if first-line
1582                          (- first-line 1)
1583                        0)))
1584
1585     ;; Assure that there is a buffer name
1586     (if (not buffername)
1587         (error "The buffer is not saved"))
1588
1589     (if (not (string-match "\\`'.*'\\'" buffername)) ; Add quotes
1590         (setq buffername (concat "'" buffername "'")))
1591     (while (string-match "%m" compile-string)
1592       (setq strbeg (substring compile-string 0 (match-beginning 0)))
1593       (setq strend (substring compile-string (match-end 0)))
1594       (setq compile-string (concat strbeg module-file strend)))
1595     ;; FIXME: The code below will %-expand any %[fbl] that appears in
1596     ;; module-file.
1597     (while (string-match "%f" compile-string)
1598       (setq strbeg (substring compile-string 0 (match-beginning 0)))
1599       (setq strend (substring compile-string (match-end 0)))
1600       (setq compile-string (concat strbeg file-name strend)))
1601     (while (string-match "%b" compile-string)
1602       (setq strbeg (substring compile-string 0 (match-beginning 0)))
1603       (setq strend (substring compile-string (match-end 0)))
1604       (setq compile-string (concat strbeg buffername strend)))
1605     (while (string-match "%l" compile-string)
1606       (setq strbeg (substring compile-string 0 (match-beginning 0)))
1607       (setq strend (substring compile-string (match-end 0)))
1608       (setq compile-string (concat strbeg (format "%d" lineoffset) strend)))
1609     (concat compile-string "\n")))
1610
1611 ;; The rest of this page is experimental code!
1612
1613 ;; Global variables for process filter function
1614 (defvar prolog-process-flag nil
1615   "Non-nil means that a prolog task (i.e. a consultation or compilation job)
1616 is running.")
1617 (defvar prolog-consult-compile-output ""
1618   "Hold the unprocessed output from the current prolog task.")
1619 (defvar prolog-consult-compile-first-line 1
1620   "The number of the first line of the file to consult/compile.
1621 Used for temporary files.")
1622 (defvar prolog-consult-compile-file nil
1623   "The file to compile/consult (can be a temporary file).")
1624 (defvar prolog-consult-compile-real-file nil
1625   "The file name of the buffer to compile/consult.")
1626
1627 (defvar compilation-parse-errors-function)
1628
1629 (defun prolog-consult-compile (compilep file &optional first-line)
1630   "Consult/compile FILE.
1631 If COMPILEP is non-nil, perform compilation, otherwise perform CONSULTING.
1632 COMMAND is a string described by the variables `prolog-consult-string'
1633 and `prolog-compile-string'.
1634 Optional argument FIRST-LINE is the number of the first line in the compiled
1635 region.
1636
1637 This function must be called from the source code buffer."
1638   (if prolog-process-flag
1639       (error "Another Prolog task is running."))
1640   (prolog-ensure-process t)
1641   (let* ((buffer (get-buffer-create prolog-compilation-buffer))
1642          (real-file buffer-file-name)
1643          (command-string (prolog-build-prolog-command compilep file
1644                                                       real-file first-line))
1645          (process (get-process "prolog")))
1646     (with-current-buffer buffer
1647       (delete-region (point-min) (point-max))
1648       ;; FIXME: Wasn't this supposed to use prolog-inferior-mode?
1649       (compilation-mode)
1650       ;; FIXME: This doesn't seem to cooperate well with new(ish) compile.el.
1651       ;; Setting up font-locking for this buffer
1652       (setq-local font-lock-defaults
1653                   '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
1654       (if (eq prolog-system 'sicstus)
1655           ;; FIXME: This looks really problematic: not only is this using
1656           ;; the old compilation-parse-errors-function, but
1657           ;; prolog-parse-sicstus-compilation-errors only accepts one argument
1658           ;; whereas compile.el calls it with 2 (and did so at least since
1659           ;; Emacs-20).
1660           (setq-local compilation-parse-errors-function
1661                       'prolog-parse-sicstus-compilation-errors))
1662       (setq buffer-read-only nil)
1663       (insert command-string "\n"))
1664     (display-buffer buffer)
1665     (setq prolog-process-flag t
1666           prolog-consult-compile-output ""
1667           prolog-consult-compile-first-line (if first-line (1- first-line) 0)
1668           prolog-consult-compile-file file
1669           prolog-consult-compile-real-file (if (string=
1670                                                 file buffer-file-name)
1671                                                nil
1672                                              real-file))
1673     (with-current-buffer buffer
1674       (goto-char (point-max))
1675       (add-function :override (process-filter process)
1676                     #'prolog-consult-compile-filter)
1677       (process-send-string "prolog" command-string)
1678       ;; (prolog-build-prolog-command compilep file real-file first-line))
1679       (while (and prolog-process-flag
1680                   (accept-process-output process 10)) ; 10 secs is ok?
1681         (sit-for 0.1)
1682         (unless (get-process "prolog")
1683           (setq prolog-process-flag nil)))
1684       (insert (if compilep
1685                   "\nCompilation finished.\n"
1686                 "\nConsulted.\n"))
1687       (remove-function (process-filter process)
1688                        #'prolog-consult-compile-filter))))
1689
1690 (defvar compilation-error-list)
1691
1692 (defun prolog-parse-sicstus-compilation-errors (limit)
1693   "Parse the prolog compilation buffer for errors.
1694 Argument LIMIT is a buffer position limiting searching.
1695 For use with the `compilation-parse-errors-function' variable."
1696   (setq compilation-error-list nil)
1697   (message "Parsing SICStus error messages...")
1698   (let (filepath dir file errorline)
1699     (while
1700         (re-search-backward
1701          "{\\([a-zA-Z ]* ERROR\\|Warning\\):.* in line[s ]*\\([0-9]+\\)"
1702          limit t)
1703       (setq errorline (string-to-number (match-string 2)))
1704       (save-excursion
1705         (re-search-backward
1706          "{\\(consulting\\|compiling\\|processing\\) \\(.*\\)\\.\\.\\.}"
1707          limit t)
1708         (setq filepath (match-string 2)))
1709
1710       ;; ###### Does this work with SICStus under Windows
1711       ;; (i.e. backslashes and stuff?)
1712       (if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath)
1713           (progn
1714             (setq dir (match-string 1 filepath))
1715             (setq file (match-string 2 filepath))))
1716
1717       (setq compilation-error-list
1718             (cons
1719              (cons (save-excursion
1720                      (beginning-of-line)
1721                      (point-marker))
1722                    (list (list file dir) errorline))
1723              compilation-error-list)
1724             ))
1725     ))
1726
1727 (defun prolog-consult-compile-filter (process output)
1728   "Filter function for Prolog compilation PROCESS.
1729 Argument OUTPUT is a name of the output file."
1730   ;;(message "start")
1731   (setq prolog-consult-compile-output
1732         (concat prolog-consult-compile-output output))
1733   ;;(message "pccf1: %s" prolog-consult-compile-output)
1734   ;; Iterate through the lines of prolog-consult-compile-output
1735   (let (outputtype)
1736     (while (and prolog-process-flag
1737                 (or
1738                  ;; Trace question
1739                  (progn
1740                    (setq outputtype 'trace)
1741                    (and (eq prolog-system 'sicstus)
1742                         (string-match
1743                          "^[ \t]*[0-9]+[ \t]*[0-9]+[ \t]*Call:.*? "
1744                          prolog-consult-compile-output)))
1745
1746                  ;; Match anything
1747                  (progn
1748                    (setq outputtype 'normal)
1749                    (string-match "^.*\n" prolog-consult-compile-output))
1750                    ))
1751       ;;(message "outputtype: %s" outputtype)
1752
1753       (setq output (match-string 0 prolog-consult-compile-output))
1754       ;; remove the text in output from prolog-consult-compile-output
1755       (setq prolog-consult-compile-output
1756             (substring prolog-consult-compile-output (length output)))
1757       ;;(message "pccf2: %s" prolog-consult-compile-output)
1758
1759       ;; If temporary files were used, then we change the error
1760       ;; messages to point to the original source file.
1761       ;; FIXME: Use compilation-fake-loc instead.
1762       (cond
1763
1764        ;; If the prolog process was in trace mode then it requires
1765        ;; user input
1766        ((and (eq prolog-system 'sicstus)
1767              (eq outputtype 'trace))
1768         (let ((input (concat (read-string output) "\n")))
1769           (process-send-string process input)
1770           (setq output (concat output input))))
1771
1772        ((eq prolog-system 'sicstus)
1773         (if (and prolog-consult-compile-real-file
1774                  (string-match
1775                   "\\({.*:.* in line[s ]*\\)\\([0-9]+\\)-\\([0-9]+\\)" output))
1776             (setq output (replace-match
1777                           ;; Adds a {processing ...} line so that
1778                           ;; `prolog-parse-sicstus-compilation-errors'
1779                           ;; finds the real file instead of the temporary one.
1780                           ;; Also fixes the line numbers.
1781                           (format "Added by Emacs: {processing %s...}\n%s%d-%d"
1782                                   prolog-consult-compile-real-file
1783                                   (match-string 1 output)
1784                                   (+ prolog-consult-compile-first-line
1785                                      (string-to-number
1786                                       (match-string 2 output)))
1787                                   (+ prolog-consult-compile-first-line
1788                                      (string-to-number
1789                                       (match-string 3 output))))
1790                           t t output)))
1791         )
1792
1793        ((eq prolog-system 'swi)
1794         (if (and prolog-consult-compile-real-file
1795                  (string-match (format
1796                                 "%s\\([ \t]*:[ \t]*\\)\\([0-9]+\\)"
1797                                 prolog-consult-compile-file)
1798                                output))
1799             (setq output (replace-match
1800                           ;; Real filename + text + fixed linenum
1801                           (format "%s%s%d"
1802                                   prolog-consult-compile-real-file
1803                                   (match-string 1 output)
1804                                   (+ prolog-consult-compile-first-line
1805                                      (string-to-number
1806                                       (match-string 2 output))))
1807                           t t output)))
1808         )
1809
1810        (t ())
1811        )
1812       ;; Write the output in the *prolog-compilation* buffer
1813       (insert output)))
1814
1815   ;; If the prompt is visible, then the task is finished
1816   (if (string-match (prolog-prompt-regexp) prolog-consult-compile-output)
1817       (setq prolog-process-flag nil)))
1818
1819 (defun prolog-consult-compile-file (compilep)
1820   "Consult/compile file of current buffer.
1821 If COMPILEP is non-nil, compile, otherwise consult."
1822   (let ((file buffer-file-name))
1823     (if file
1824         (progn
1825           (save-some-buffers)
1826           (prolog-consult-compile compilep file))
1827       (prolog-consult-compile-region compilep (point-min) (point-max)))))
1828
1829 (defun prolog-consult-compile-buffer (compilep)
1830   "Consult/compile current buffer.
1831 If COMPILEP is non-nil, compile, otherwise consult."
1832   (prolog-consult-compile-region compilep (point-min) (point-max)))
1833
1834 (defun prolog-consult-compile-region (compilep beg end)
1835   "Consult/compile region between BEG and END.
1836 If COMPILEP is non-nil, compile, otherwise consult."
1837   ;(let ((file prolog-temp-filename)
1838   (let ((file (prolog-bsts (prolog-temporary-file)))
1839         (lines (count-lines 1 beg)))
1840     (write-region beg end file nil 'no-message)
1841     (write-region "\n" nil file t 'no-message)
1842     (prolog-consult-compile compilep file
1843                             (if (bolp) (1+ lines) lines))
1844     (delete-file file)))
1845
1846 (defun prolog-consult-compile-predicate (compilep)
1847   "Consult/compile the predicate around current point.
1848 If COMPILEP is non-nil, compile, otherwise consult."
1849   (prolog-consult-compile-region
1850    compilep (prolog-pred-start) (prolog-pred-end)))
1851
1852 \f
1853 ;;-------------------------------------------------------------------
1854 ;; Font-lock stuff
1855 ;;-------------------------------------------------------------------
1856
1857 ;; Auxiliary functions
1858
1859 (defun prolog-font-lock-object-matcher (bound)
1860   "Find SICStus objects method name for font lock.
1861 Argument BOUND is a buffer position limiting searching."
1862   (let (point
1863         (case-fold-search nil))
1864     (while (and (not point)
1865                 (re-search-forward "\\(::[ \t\n]*{\\|&\\)[ \t]*"
1866                                    bound t))
1867       (while (or (re-search-forward "\\=\n[ \t]*" bound t)
1868                  (re-search-forward "\\=%.*" bound t)
1869                  (and (re-search-forward "\\=/\\*" bound t)
1870                       (re-search-forward "\\*/[ \t]*" bound t))))
1871       (setq point (re-search-forward
1872                    (format "\\=\\(%s\\)" prolog-atom-regexp)
1873                    bound t)))
1874     point))
1875
1876 (defsubst prolog-face-name-p (facename)
1877   ;; Return t if FACENAME is the name of a face.  This method is
1878   ;; necessary since facep in XEmacs only returns t for the actual
1879   ;; face objects (while it's only their names that are used just
1880   ;; about anywhere else) without providing a predicate that tests
1881   ;; face names.  This function (including the above commentary) is
1882   ;; borrowed from cc-mode.
1883   (memq facename (face-list)))
1884
1885 ;; Set everything up
1886 (defun prolog-font-lock-keywords ()
1887   "Set up font lock keywords for the current Prolog system."
1888   ;;(when window-system
1889   (require 'font-lock)
1890
1891   ;; Define Prolog faces
1892   (defface prolog-redo-face
1893     '((((class grayscale)) (:italic t))
1894       (((class color)) (:foreground "darkorchid"))
1895       (t (:italic t)))
1896     "Prolog mode face for highlighting redo trace lines."
1897     :group 'prolog-faces)
1898   (defface prolog-exit-face
1899     '((((class grayscale)) (:underline t))
1900       (((class color) (background dark)) (:foreground "green"))
1901       (((class color) (background light)) (:foreground "ForestGreen"))
1902       (t (:underline t)))
1903     "Prolog mode face for highlighting exit trace lines."
1904     :group 'prolog-faces)
1905   (defface prolog-exception-face
1906     '((((class grayscale)) (:bold t :italic t :underline t))
1907       (((class color)) (:bold t :foreground "black" :background "Khaki"))
1908       (t (:bold t :italic t :underline t)))
1909     "Prolog mode face for highlighting exception trace lines."
1910     :group 'prolog-faces)
1911   (defface prolog-warning-face
1912     '((((class grayscale)) (:underline t))
1913       (((class color) (background dark)) (:foreground "blue"))
1914       (((class color) (background light)) (:foreground "MidnightBlue"))
1915       (t (:underline t)))
1916     "Face name to use for compiler warnings."
1917     :group 'prolog-faces)
1918   (defface prolog-builtin-face
1919     '((((class color) (background light)) (:foreground "Purple"))
1920       (((class color) (background dark)) (:foreground "Cyan"))
1921       (((class grayscale) (background light))
1922        :foreground "LightGray" :bold t)
1923       (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
1924       (t (:bold t)))
1925     "Face name to use for compiler warnings."
1926     :group 'prolog-faces)
1927   (defvar prolog-warning-face
1928     (if (prolog-face-name-p 'font-lock-warning-face)
1929         'font-lock-warning-face
1930       'prolog-warning-face)
1931     "Face name to use for built in predicates.")
1932   (defvar prolog-builtin-face
1933     (if (prolog-face-name-p 'font-lock-builtin-face)
1934         'font-lock-builtin-face
1935       'prolog-builtin-face)
1936     "Face name to use for built in predicates.")
1937   (defvar prolog-redo-face 'prolog-redo-face
1938     "Face name to use for redo trace lines.")
1939   (defvar prolog-exit-face 'prolog-exit-face
1940     "Face name to use for exit trace lines.")
1941   (defvar prolog-exception-face 'prolog-exception-face
1942     "Face name to use for exception trace lines.")
1943
1944   ;; Font Lock Patterns
1945   (let (
1946         ;; "Native" Prolog patterns
1947         (head-predicates
1948          (list (format "^\\(%s\\)\\((\\|[ \t]*:-\\)" prolog-atom-regexp)
1949                1 font-lock-function-name-face))
1950                                        ;(list (format "^%s" prolog-atom-regexp)
1951                                        ;      0 font-lock-function-name-face))
1952         (head-predicates-1
1953          (list (format "\\.[ \t]*\\(%s\\)" prolog-atom-regexp)
1954                1 font-lock-function-name-face) )
1955         (variables
1956          '("\\<\\([_A-Z][a-zA-Z0-9_]*\\)"
1957            1 font-lock-variable-name-face))
1958         (important-elements
1959          (list (if (eq prolog-system 'mercury)
1960                    "[][}{;|]\\|\\\\[+=]\\|<?=>?"
1961                  "[][}{!;|]\\|\\*->")
1962                0 'font-lock-keyword-face))
1963         (important-elements-1
1964          '("[^-*]\\(->\\)" 1 font-lock-keyword-face))
1965         (predspecs                      ; module:predicate/cardinality
1966          (list (format "\\<\\(%s:\\|\\)%s/[0-9]+"
1967                        prolog-atom-regexp prolog-atom-regexp)
1968                0 font-lock-function-name-face 'prepend))
1969         (keywords                       ; directives (queries)
1970          (list
1971           (if (eq prolog-system 'mercury)
1972               (concat
1973                "\\<\\("
1974                (regexp-opt prolog-keywords-i)
1975                "\\|"
1976                (regexp-opt
1977                 prolog-determinism-specificators-i)
1978                "\\)\\>")
1979             (concat
1980              "^[?:]- *\\("
1981              (regexp-opt prolog-keywords-i)
1982              "\\)\\>"))
1983           1 prolog-builtin-face))
1984         ;; SICStus specific patterns
1985         (sicstus-object-methods
1986          (if (eq prolog-system 'sicstus)
1987              '(prolog-font-lock-object-matcher
1988                1 font-lock-function-name-face)))
1989         ;; Mercury specific patterns
1990         (types
1991          (if (eq prolog-system 'mercury)
1992              (list
1993               (regexp-opt prolog-types-i 'words)
1994               0 'font-lock-type-face)))
1995         (modes
1996          (if (eq prolog-system 'mercury)
1997              (list
1998               (regexp-opt prolog-mode-specificators-i 'words)
1999               0 'font-lock-constant-face)))
2000         (directives
2001          (if (eq prolog-system 'mercury)
2002              (list
2003               (regexp-opt prolog-directives-i 'words)
2004               0 'prolog-warning-face)))
2005         ;; Inferior mode specific patterns
2006         (prompt
2007          ;; FIXME: Should be handled by comint already.
2008          (list (prolog-prompt-regexp) 0 'font-lock-keyword-face))
2009         (trace-exit
2010          ;; FIXME: Add to compilation-error-regexp-alist instead.
2011          (cond
2012           ((eq prolog-system 'sicstus)
2013            '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):"
2014              1 prolog-exit-face))
2015           ((eq prolog-system 'swi)
2016            '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face))
2017           (t nil)))
2018         (trace-fail
2019          ;; FIXME: Add to compilation-error-regexp-alist instead.
2020          (cond
2021           ((eq prolog-system 'sicstus)
2022            '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):"
2023              1 prolog-warning-face))
2024           ((eq prolog-system 'swi)
2025            '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face))
2026           (t nil)))
2027         (trace-redo
2028          ;; FIXME: Add to compilation-error-regexp-alist instead.
2029          (cond
2030           ((eq prolog-system 'sicstus)
2031            '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):"
2032              1 prolog-redo-face))
2033           ((eq prolog-system 'swi)
2034            '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face))
2035           (t nil)))
2036         (trace-call
2037          ;; FIXME: Add to compilation-error-regexp-alist instead.
2038          (cond
2039           ((eq prolog-system 'sicstus)
2040            '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):"
2041              1 font-lock-function-name-face))
2042           ((eq prolog-system 'swi)
2043            '("[ \t]*\\(Call\\):[ \t]*([ \t0-9]*)"
2044              1 font-lock-function-name-face))
2045           (t nil)))
2046         (trace-exception
2047          ;; FIXME: Add to compilation-error-regexp-alist instead.
2048          (cond
2049           ((eq prolog-system 'sicstus)
2050            '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):"
2051              1 prolog-exception-face))
2052           ((eq prolog-system 'swi)
2053            '("[ \t]*\\(Exception\\):[ \t]*([ \t0-9]*)"
2054              1 prolog-exception-face))
2055           (t nil)))
2056         (error-message-identifier
2057          ;; FIXME: Add to compilation-error-regexp-alist instead.
2058          (cond
2059           ((eq prolog-system 'sicstus)
2060            '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend))
2061           ((eq prolog-system 'swi)
2062            '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend))
2063           (t nil)))
2064         (error-whole-messages
2065          ;; FIXME: Add to compilation-error-regexp-alist instead.
2066          (cond
2067           ((eq prolog-system 'sicstus)
2068            '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$"
2069              1 font-lock-comment-face append))
2070           ((eq prolog-system 'swi)
2071            '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append))
2072           (t nil)))
2073         (error-warning-messages
2074          ;; FIXME: Add to compilation-error-regexp-alist instead.
2075          ;; Mostly errors that SICStus asks the user about how to solve,
2076          ;; such as "NAME CLASH:" for example.
2077          (cond
2078           ((eq prolog-system 'sicstus)
2079            '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face))
2080           (t nil)))
2081         (warning-messages
2082          ;; FIXME: Add to compilation-error-regexp-alist instead.
2083          (cond
2084           ((eq prolog-system 'sicstus)
2085            '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$"
2086              2 prolog-warning-face prepend))
2087           (t nil))))
2088
2089     ;; Make font lock list
2090     (delq
2091      nil
2092      (cond
2093       ((eq major-mode 'prolog-mode)
2094        (list
2095         head-predicates
2096         head-predicates-1
2097         variables
2098         important-elements
2099         important-elements-1
2100         predspecs
2101         keywords
2102         sicstus-object-methods
2103         types
2104         modes
2105         directives))
2106       ((eq major-mode 'prolog-inferior-mode)
2107        (list
2108         prompt
2109         error-message-identifier
2110         error-whole-messages
2111         error-warning-messages
2112         warning-messages
2113         predspecs
2114         trace-exit
2115         trace-fail
2116         trace-redo
2117         trace-call
2118         trace-exception))
2119       ((eq major-mode 'compilation-mode)
2120        (list
2121         error-message-identifier
2122         error-whole-messages
2123         error-warning-messages
2124         warning-messages
2125         predspecs))))
2126     ))
2127
2128 \f
2129
2130 (defun prolog-find-unmatched-paren ()
2131   "Return the column of the last unmatched left parenthesis."
2132   (save-excursion
2133     (goto-char (or (nth 1 (syntax-ppss)) (point-min)))
2134     (current-column)))
2135
2136
2137 (defun prolog-paren-balance ()
2138   "Return the parenthesis balance of the current line.
2139 A return value of N means N more left parentheses than right ones."
2140   (save-excursion
2141     (car (parse-partial-sexp (line-beginning-position)
2142                              (line-end-position)))))
2143
2144 (defun prolog-electric--if-then-else ()
2145   "Insert spaces after the opening parenthesis, \"then\" (->) and \"else\" (;) branches.
2146 Spaces are inserted if all preceding objects on the line are
2147 whitespace characters, parentheses, or then/else branches."
2148   (when prolog-electric-if-then-else-flag
2149     (save-excursion
2150       (let ((regexp (concat "(\\|" prolog-left-indent-regexp))
2151             (pos (point))
2152             level)
2153         (beginning-of-line)
2154         (skip-chars-forward " \t")
2155         ;; Treat "( If -> " lines specially.
2156         ;;(setq incr (if (looking-at "(.*->")
2157         ;;               2
2158         ;;             prolog-paren-indent))
2159
2160         ;; work on all subsequent "->", "(", ";"
2161         (and (looking-at regexp)
2162              (= pos (match-end 0))
2163              (indent-according-to-mode))
2164         (while (looking-at regexp)
2165           (goto-char (match-end 0))
2166           (setq level (+ (prolog-find-unmatched-paren) prolog-paren-indent))
2167
2168           ;; Remove old white space
2169           (let ((start (point)))
2170             (skip-chars-forward " \t")
2171             (delete-region start (point)))
2172           (indent-to level)
2173           (skip-chars-forward " \t"))
2174         ))
2175     (when (save-excursion
2176             (backward-char 2)
2177             (looking-at "\\s ;\\|\\s (\\|->")) ; (looking-at "\\s \\((\\|;\\)"))
2178       (skip-chars-forward " \t"))
2179     ))
2180
2181 ;;;; Comment filling
2182
2183 (defun prolog-comment-limits ()
2184   "Return the current comment limits plus the comment type (block or line).
2185 The comment limits are the range of a block comment or the range that
2186 contains all adjacent line comments (i.e. all comments that starts in
2187 the same column with no empty lines or non-whitespace characters
2188 between them)."
2189   (let ((here (point))
2190         lit-limits-b lit-limits-e lit-type beg end
2191         )
2192     (save-restriction
2193       ;; Widen to catch comment limits correctly.
2194       (widen)
2195       (setq end (line-end-position)
2196             beg (line-beginning-position))
2197       (save-excursion
2198         (beginning-of-line)
2199         (setq lit-type (if (search-forward-regexp "%" end t) 'line 'block))
2200                         ;    (setq lit-type 'line)
2201                         ;(if (search-forward-regexp "^[ \t]*%" end t)
2202                         ;    (setq lit-type 'line)
2203                         ;  (if (not (search-forward-regexp "%" end t))
2204                         ;      (setq lit-type 'block)
2205                         ;    (if (not (= (forward-line 1) 0))
2206                         ;        (setq lit-type 'block)
2207                         ;      (setq done t
2208                         ;            ret (prolog-comment-limits)))
2209                         ;    ))
2210         (if (eq lit-type 'block)
2211             (progn
2212               (goto-char here)
2213               (when (looking-at "/\\*") (forward-char 2))
2214               (when (and (looking-at "\\*") (> (point) (point-min))
2215                          (forward-char -1) (looking-at "/"))
2216                 (forward-char 1))
2217               (when (save-excursion (search-backward "/*" nil t))
2218                 (list (save-excursion (search-backward "/*") (point))
2219                       (or (search-forward "*/" nil t) (point-max)) lit-type)))
2220           ;; line comment
2221           (setq lit-limits-b (- (point) 1)
2222                 lit-limits-e end)
2223           (condition-case nil
2224               (if (progn (goto-char lit-limits-b)
2225                          (looking-at "%"))
2226                   (let ((col (current-column)) done)
2227                     (setq beg (point)
2228                           end lit-limits-e)
2229                     ;; Always at the beginning of the comment
2230                     ;; Go backward now
2231                     (beginning-of-line)
2232                     (while (and (zerop (setq done (forward-line -1)))
2233                                 (search-forward-regexp "^[ \t]*%"
2234                                                        (line-end-position) t)
2235                                 (= (+ 1 col) (current-column)))
2236                       (setq beg (- (point) 1)))
2237                     (when (= done 0)
2238                       (forward-line 1))
2239                     ;; We may have a line with code above...
2240                     (when (and (zerop (setq done (forward-line -1)))
2241                                (search-forward "%" (line-end-position) t)
2242                                (= (+ 1 col) (current-column)))
2243                       (setq beg (- (point) 1)))
2244                     (when (= done 0)
2245                       (forward-line 1))
2246                     ;; Go forward
2247                     (goto-char lit-limits-b)
2248                     (beginning-of-line)
2249                     (while (and (zerop (forward-line 1))
2250                                 (search-forward-regexp "^[ \t]*%"
2251                                                        (line-end-position) t)
2252                                 (= (+ 1 col) (current-column)))
2253                       (setq end (line-end-position)))
2254                     (list beg end lit-type))
2255                 (list lit-limits-b lit-limits-e lit-type)
2256                 )
2257             (error (list lit-limits-b lit-limits-e lit-type))))
2258         ))))
2259
2260 (defun prolog-guess-fill-prefix ()
2261   ;; fill 'txt entities?
2262   (when (save-excursion
2263           (end-of-line)
2264           (nth 4 (syntax-ppss)))
2265     (let* ((bounds (prolog-comment-limits))
2266            (cbeg (car bounds))
2267            (type (nth 2 bounds))
2268            beg end)
2269       (save-excursion
2270         (end-of-line)
2271         (setq end (point))
2272         (beginning-of-line)
2273         (setq beg (point))
2274         (if (and (eq type 'line)
2275                  (> cbeg beg)
2276                  (save-excursion (not (search-forward-regexp "^[ \t]*%"
2277                                                              cbeg t))))
2278             (progn
2279               (goto-char cbeg)
2280               (search-forward-regexp "%+[ \t]*" end t)
2281               (prolog-replace-in-string (buffer-substring beg (point))
2282                                         "[^ \t%]" " "))
2283           ;(goto-char beg)
2284           (if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
2285                                      end t)
2286               (prolog-replace-in-string (buffer-substring beg (point)) "/" " ")
2287             (beginning-of-line)
2288             (when (search-forward-regexp "^[ \t]+" end t)
2289               (buffer-substring beg (point)))))))))
2290
2291 (defun prolog-fill-paragraph ()
2292   "Fill paragraph comment at or after point."
2293   (interactive)
2294   (let* ((bounds (prolog-comment-limits))
2295          (type (nth 2 bounds)))
2296     (if (eq type 'line)
2297         (let ((fill-prefix (prolog-guess-fill-prefix)))
2298           (fill-paragraph nil))
2299       (save-excursion
2300         (save-restriction
2301           ;; exclude surrounding lines that delimit a multiline comment
2302           ;; and don't contain alphabetic characters, like "/*******",
2303           ;; "- - - */" etc.
2304           (save-excursion
2305             (backward-paragraph)
2306             (unless (bobp) (forward-line))
2307             (if (string-match "^/\\*[^a-zA-Z]*$" (thing-at-point 'line))
2308                 (narrow-to-region (point-at-eol) (point-max))))
2309           (save-excursion
2310             (forward-paragraph)
2311             (forward-line -1)
2312             (if (string-match "^[^a-zA-Z]*\\*/$" (thing-at-point 'line))
2313                 (narrow-to-region (point-min) (point-at-bol))))
2314           (let ((fill-prefix (prolog-guess-fill-prefix)))
2315             (fill-paragraph nil))))
2316       )))
2317
2318 (defun prolog-do-auto-fill ()
2319   "Carry out Auto Fill for Prolog mode.
2320 In effect it sets the `fill-prefix' when inside comments and then calls
2321 `do-auto-fill'."
2322   (let ((fill-prefix (prolog-guess-fill-prefix)))
2323     (do-auto-fill)
2324     ))
2325
2326 (defalias 'prolog-replace-in-string
2327   (if (fboundp 'replace-in-string)
2328       #'replace-in-string
2329     (lambda (str regexp newtext &optional literal)
2330       (replace-regexp-in-string regexp newtext str nil literal))))
2331 \f
2332 ;;-------------------------------------------------------------------
2333 ;; Online help
2334 ;;-------------------------------------------------------------------
2335
2336 (defvar prolog-help-function
2337   '((mercury nil)
2338     (eclipse prolog-help-online)
2339     ;; (sicstus prolog-help-info)
2340     (sicstus prolog-find-documentation)
2341     (swi prolog-help-online)
2342     (t prolog-help-online))
2343   "Alist for the name of the function for finding help on a predicate.")
2344
2345 (defun prolog-help-on-predicate ()
2346   "Invoke online help on the atom under cursor."
2347   (interactive)
2348
2349   (cond
2350    ;; Redirect help for SICStus to `prolog-find-documentation'.
2351    ((eq prolog-help-function-i 'prolog-find-documentation)
2352     (prolog-find-documentation))
2353
2354    ;; Otherwise, ask for the predicate name and then call the function
2355    ;; in prolog-help-function-i
2356    (t
2357     (let* ((word (prolog-atom-under-point))
2358            (predicate (read-string
2359                        (format "Help on predicate%s: "
2360                                (if word
2361                                    (concat " (default " word ")")
2362                                  ""))
2363                        nil nil word))
2364            ;;point
2365            )
2366       (if prolog-help-function-i
2367           (funcall prolog-help-function-i predicate)
2368         (error "Sorry, no help method defined for this Prolog system."))))
2369    ))
2370
2371
2372 (autoload 'Info-goto-node "info" nil t)
2373 (declare-function Info-follow-nearest-node "info" (&optional FORK))
2374
2375 (defun prolog-help-info (predicate)
2376   (let ((buffer (current-buffer))
2377         oldp
2378         (str (concat "^\\* " (regexp-quote predicate) " */")))
2379     (pop-to-buffer nil)
2380     (Info-goto-node prolog-info-predicate-index)
2381     (if (not (re-search-forward str nil t))
2382         (error "Help on predicate `%s' not found." predicate))
2383
2384     (setq oldp (point))
2385     (if (re-search-forward str nil t)
2386         ;; Multiple matches, ask user
2387         (let ((max 2)
2388               n)
2389           ;; Count matches
2390           (while (re-search-forward str nil t)
2391             (setq max (1+ max)))
2392
2393           (goto-char oldp)
2394           (re-search-backward "[^ /]" nil t)
2395           (recenter 0)
2396           (setq n (read-string  ;; was read-input, which is obsolete
2397                    (format "Several matches, choose (1-%d): " max) "1"))
2398           (forward-line (- (string-to-number n) 1)))
2399       ;; Single match
2400       (re-search-backward "[^ /]" nil t))
2401
2402     ;; (Info-follow-nearest-node (point))
2403     (prolog-Info-follow-nearest-node)
2404     (re-search-forward (concat "^`" (regexp-quote predicate)) nil t)
2405     (beginning-of-line)
2406     (recenter 0)
2407     (pop-to-buffer buffer)))
2408
2409 (defun prolog-Info-follow-nearest-node ()
2410   (if (featurep 'xemacs)
2411       (Info-follow-nearest-node (point))
2412     (Info-follow-nearest-node)))
2413
2414 (defun prolog-help-online (predicate)
2415   (prolog-ensure-process)
2416   (process-send-string "prolog" (concat "help(" predicate ").\n"))
2417   (display-buffer "*prolog*"))
2418
2419 (defun prolog-help-apropos (string)
2420   "Find Prolog apropos on given STRING.
2421 This function is only available when `prolog-system' is set to `swi'."
2422   (interactive "sApropos: ")
2423   (cond
2424    ((eq prolog-system 'swi)
2425     (prolog-ensure-process)
2426     (process-send-string "prolog" (concat "apropos(" string ").\n"))
2427     (display-buffer "*prolog*"))
2428    (t
2429     (error "Sorry, no Prolog apropos available for this Prolog system."))))
2430
2431 (defun prolog-atom-under-point ()
2432   "Return the atom under or left to the point."
2433   (save-excursion
2434     (let ((nonatom_chars "[](){},. \t\n")
2435           start)
2436       (skip-chars-forward (concat "^" nonatom_chars))
2437       (skip-chars-backward nonatom_chars)
2438       (skip-chars-backward (concat "^" nonatom_chars))
2439       (setq start (point))
2440       (skip-chars-forward (concat "^" nonatom_chars))
2441       (buffer-substring-no-properties start (point))
2442       )))
2443
2444 \f
2445 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2446 ;; Help function with completion
2447 ;; Stolen from Per Mildner's SICStus debugger mode and modified
2448
2449 (defun prolog-find-documentation ()
2450   "Go to the Info node for a predicate in the SICStus Info manual."
2451   (interactive)
2452   (let ((pred (prolog-read-predicate)))
2453     (prolog-goto-predicate-info pred)))
2454
2455 (defvar prolog-info-alist nil
2456   "Alist with all builtin predicates.
2457 Only for internal use by `prolog-find-documentation'")
2458
2459 ;; Very similar to prolog-help-info except that that function cannot
2460 ;; cope with arity and that it asks the user if there are several
2461 ;; functors with different arity. This function also uses
2462 ;; prolog-info-alist for finding the info node, rather than parsing
2463 ;; the predicate index.
2464 (defun prolog-goto-predicate-info (predicate)
2465   "Go to the info page for PREDICATE, which is a PredSpec."
2466   (interactive)
2467   (string-match "\\(.*\\)/\\([0-9]+\\).*$" predicate)
2468   (let ((buffer (current-buffer))
2469         (name (match-string 1 predicate))
2470         (arity (string-to-number (match-string 2 predicate)))
2471         ;oldp
2472         ;(str (regexp-quote predicate))
2473         )
2474     (pop-to-buffer nil)
2475
2476     (Info-goto-node
2477      prolog-info-predicate-index) ;; We must be in the SICStus pages
2478     (Info-goto-node (car (cdr (assoc predicate prolog-info-alist))))
2479
2480     (prolog-find-term (regexp-quote name) arity "^`")
2481
2482     (recenter 0)
2483     (pop-to-buffer buffer))
2484 )
2485
2486 (defun prolog-read-predicate ()
2487   "Read a PredSpec from the user.
2488 Returned value is a string \"FUNCTOR/ARITY\".
2489 Interaction supports completion."
2490   (let ((default (prolog-atom-under-point)))
2491     ;; If the predicate index is not yet built, do it now
2492     (if (not prolog-info-alist)
2493         (prolog-build-info-alist))
2494     ;; Test if the default string could be the base for completion.
2495     ;; Discard it if not.
2496     (if (eq (try-completion default prolog-info-alist) nil)
2497         (setq default nil))
2498     ;; Read the PredSpec from the user
2499     (completing-read
2500      (if (zerop (length default))
2501          "Help on predicate: "
2502        (concat "Help on predicate (default " default "): "))
2503      prolog-info-alist nil t nil nil default)))
2504
2505 (defun prolog-build-info-alist (&optional verbose)
2506   "Build an alist of all builtins and library predicates.
2507 Each element is of the form (\"NAME/ARITY\" . (INFO-NODE1 INFO-NODE2 ...)).
2508 Typically there is just one Info node associated with each name
2509 If an optional argument VERBOSE is non-nil, print messages at the beginning
2510 and end of list building."
2511   (if verbose
2512       (message "Building info alist..."))
2513   (setq prolog-info-alist
2514         (let ((l ())
2515               (last-entry (cons "" ())))
2516           (save-excursion
2517             (save-window-excursion
2518               ;; select any window but the minibuffer (as we cannot switch
2519               ;; buffers in minibuffer window.
2520               ;; I am not sure this is the right/best way
2521               (if (active-minibuffer-window)  ; nil if none active
2522                   (select-window (next-window)))
2523               ;; Do this after going away from minibuffer window
2524               (save-window-excursion
2525                 (info))
2526               (Info-goto-node prolog-info-predicate-index)
2527               (goto-char (point-min))
2528               (while (re-search-forward
2529                       "^\\* \\(.+\\)/\\([0-9]+\\)\\([^\n:*]*\\):" nil t)
2530                 (let* ((name (match-string 1))
2531                        (arity (string-to-number (match-string 2)))
2532                        (comment (match-string 3))
2533                        (fa (format "%s/%d%s" name arity comment))
2534                        info-node)
2535                   (beginning-of-line)
2536                   ;; Extract the info node name
2537                   (setq info-node (progn
2538                                     (re-search-forward ":[ \t]*\\([^:]+\\).$")
2539                                     (match-string 1)
2540                                    ))
2541                   ;; ###### Easier? (from Milan version 0.1.28)
2542                   ;; (setq info-node (Info-extract-menu-node-name))
2543                   (if (equal fa (car last-entry))
2544                       (setcdr last-entry (cons info-node (cdr last-entry)))
2545                     (setq last-entry (cons fa (list info-node))
2546                           l (cons last-entry l)))))
2547               (nreverse l)
2548               ))))
2549   (if verbose
2550       (message "Building info alist... done.")))
2551
2552 \f
2553 ;;-------------------------------------------------------------------
2554 ;; Miscellaneous functions
2555 ;;-------------------------------------------------------------------
2556
2557 ;; For Windows. Change backslash to slash. SICStus handles either
2558 ;; path separator but backslash must be doubled, therefore use slash.
2559 (defun prolog-bsts (string)
2560   "Change backslashes to slashes in STRING."
2561   (let ((str1 (copy-sequence string))
2562         (len (length string))
2563         (i 0))
2564     (while (< i len)
2565       (if (char-equal (aref str1 i) ?\\)
2566           (aset str1 i ?/))
2567       (setq i (1+ i)))
2568     str1))
2569
2570 ;;(defun prolog-temporary-file ()
2571 ;;  "Make temporary file name for compilation."
2572 ;;  (make-temp-name
2573 ;;   (concat
2574 ;;    (or
2575 ;;     (getenv "TMPDIR")
2576 ;;     (getenv "TEMP")
2577 ;;     (getenv "TMP")
2578 ;;     (getenv "SYSTEMP")
2579 ;;     "/tmp")
2580 ;;    "/prolcomp")))
2581 ;;(setq prolog-temp-filename (prolog-bsts (prolog-temporary-file)))
2582
2583 (defun prolog-temporary-file ()
2584   "Make temporary file name for compilation."
2585   (if prolog-temporary-file-name
2586       ;; We already have a file, erase content and continue
2587       (progn
2588         (write-region "" nil prolog-temporary-file-name nil 'silent)
2589         prolog-temporary-file-name)
2590     ;; Actually create the file and set `prolog-temporary-file-name'
2591     ;; accordingly.
2592     (setq prolog-temporary-file-name
2593           (make-temp-file "prolcomp" nil ".pl"))))
2594
2595 (defun prolog-goto-prolog-process-buffer ()
2596   "Switch to the prolog process buffer and go to its end."
2597   (switch-to-buffer-other-window "*prolog*")
2598   (goto-char (point-max))
2599 )
2600
2601 (defun prolog-enable-sicstus-sd ()
2602   "Enable the source level debugging facilities of SICStus 3.7 and later."
2603   (interactive)
2604   (require 'pltrace)  ; Load the SICStus debugger code
2605   ;; Turn on the source level debugging by default
2606   (add-hook 'prolog-inferior-mode-hook 'pltrace-on)
2607   (if (not prolog-use-sicstus-sd)
2608       (progn
2609         ;; If there is a *prolog* buffer, then call pltrace-on
2610         (if (get-buffer "*prolog*")
2611             ;; Avoid compilation warnings by using eval
2612             (eval '(pltrace-on)))
2613         (setq prolog-use-sicstus-sd t)
2614         )))
2615
2616 (defun prolog-disable-sicstus-sd ()
2617   "Disable the source level debugging facilities of SICStus 3.7 and later."
2618   (interactive)
2619   (setq prolog-use-sicstus-sd nil)
2620   ;; Remove the hook
2621   (remove-hook 'prolog-inferior-mode-hook 'pltrace-on)
2622   ;; If there is a *prolog* buffer, then call pltrace-off
2623   (if (get-buffer "*prolog*")
2624       ;; Avoid compile warnings by using eval
2625       (eval '(pltrace-off))))
2626
2627 (defun prolog-toggle-sicstus-sd ()
2628   ;; FIXME: Use define-minor-mode.
2629   "Toggle the source level debugging facilities of SICStus 3.7 and later."
2630   (interactive)
2631   (if prolog-use-sicstus-sd
2632       (prolog-disable-sicstus-sd)
2633     (prolog-enable-sicstus-sd)))
2634
2635 (defun prolog-debug-on (&optional arg)
2636   "Enable debugging.
2637 When called with prefix argument ARG, disable debugging instead."
2638   (interactive "P")
2639   (if arg
2640       (prolog-debug-off)
2641     (prolog-process-insert-string (get-process "prolog")
2642                                   prolog-debug-on-string)
2643     (process-send-string "prolog" prolog-debug-on-string)))
2644
2645 (defun prolog-debug-off ()
2646   "Disable debugging."
2647   (interactive)
2648   (prolog-process-insert-string (get-process "prolog")
2649                                 prolog-debug-off-string)
2650   (process-send-string "prolog" prolog-debug-off-string))
2651
2652 (defun prolog-trace-on (&optional arg)
2653   "Enable tracing.
2654 When called with prefix argument ARG, disable tracing instead."
2655   (interactive "P")
2656   (if arg
2657       (prolog-trace-off)
2658     (prolog-process-insert-string (get-process "prolog")
2659                                   prolog-trace-on-string)
2660     (process-send-string "prolog" prolog-trace-on-string)))
2661
2662 (defun prolog-trace-off ()
2663   "Disable tracing."
2664   (interactive)
2665   (prolog-process-insert-string (get-process "prolog")
2666                                 prolog-trace-off-string)
2667   (process-send-string "prolog" prolog-trace-off-string))
2668
2669 (defun prolog-zip-on (&optional arg)
2670   "Enable zipping (for SICStus 3.7 and later).
2671 When called with prefix argument ARG, disable zipping instead."
2672   (interactive "P")
2673   (if (not (and (eq prolog-system 'sicstus)
2674                 (prolog-atleast-version '(3 . 7))))
2675       (error "Only works for SICStus 3.7 and later"))
2676   (if arg
2677       (prolog-zip-off)
2678     (prolog-process-insert-string (get-process "prolog")
2679                                   prolog-zip-on-string)
2680     (process-send-string "prolog" prolog-zip-on-string)))
2681
2682 (defun prolog-zip-off ()
2683   "Disable zipping (for SICStus 3.7 and later)."
2684   (interactive)
2685   (prolog-process-insert-string (get-process "prolog")
2686                                 prolog-zip-off-string)
2687   (process-send-string "prolog" prolog-zip-off-string))
2688
2689 ;; (defun prolog-create-predicate-index ()
2690 ;;   "Create an index for all predicates in the buffer."
2691 ;;   (let ((predlist '())
2692 ;;         clauseinfo
2693 ;;         object
2694 ;;         pos
2695 ;;         )
2696 ;;     (goto-char (point-min))
2697 ;;     ;; Replace with prolog-clause-start!
2698 ;;     (while (re-search-forward "^.+:-" nil t)
2699 ;;       (setq pos (match-beginning 0))
2700 ;;       (setq clauseinfo (prolog-clause-info))
2701 ;;       (setq object (prolog-in-object))
2702 ;;       (setq predlist (append
2703 ;;                       predlist
2704 ;;                       (list (cons
2705 ;;                              (if (and (eq prolog-system 'sicstus)
2706 ;;                                       (prolog-in-object))
2707 ;;                                  (format "%s::%s/%d"
2708 ;;                                          object
2709 ;;                                          (nth 0 clauseinfo)
2710 ;;                                          (nth 1 clauseinfo))
2711 ;;                                (format "%s/%d"
2712 ;;                                        (nth 0 clauseinfo)
2713 ;;                                        (nth 1 clauseinfo)))
2714 ;;                              pos
2715 ;;                              ))))
2716 ;;       (prolog-end-of-predicate))
2717 ;;     predlist))
2718
2719 (defun prolog-get-predspec ()
2720   (save-excursion
2721     (let ((state (prolog-clause-info))
2722           (object (prolog-in-object)))
2723       (if (or (equal (nth 0 state) "")
2724               (nth 4 (syntax-ppss)))
2725           nil
2726         (if (and (eq prolog-system 'sicstus)
2727                  object)
2728             (format "%s::%s/%d"
2729                     object
2730                     (nth 0 state)
2731                     (nth 1 state))
2732           (format "%s/%d"
2733                   (nth 0 state)
2734                   (nth 1 state)))
2735         ))))
2736
2737 ;; For backward compatibility. Stolen from custom.el.
2738 (or (fboundp 'match-string)
2739     ;; Introduced in Emacs 19.29.
2740     (defun match-string (num &optional string)
2741   "Return string of text matched by last search.
2742 NUM specifies which parenthesized expression in the last regexp.
2743  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
2744 Zero means the entire text matched by the whole regexp or whole string.
2745 STRING should be given if the last search was by `string-match' on STRING."
2746   (if (match-beginning num)
2747       (if string
2748           (substring string (match-beginning num) (match-end num))
2749         (buffer-substring (match-beginning num) (match-end num))))))
2750
2751 (defun prolog-pred-start ()
2752   "Return the starting point of the first clause of the current predicate."
2753   ;; FIXME: Use SMIE.
2754   (save-excursion
2755     (goto-char (prolog-clause-start))
2756     ;; Find first clause, unless it was a directive
2757     (if (and (not (looking-at "[:?]-"))
2758              (not (looking-at "[ \t]*[%/]"))  ; Comment
2759
2760              )
2761         (let* ((pinfo (prolog-clause-info))
2762                (predname (nth 0 pinfo))
2763                (arity (nth 1 pinfo))
2764                (op (point)))
2765           (while (and (re-search-backward
2766                        (format "^%s\\([(\\.]\\| *%s\\)"
2767                                predname prolog-head-delimiter) nil t)
2768                       (= arity (nth 1 (prolog-clause-info)))
2769                       )
2770             (setq op (point)))
2771           (if (eq prolog-system 'mercury)
2772               ;; Skip to the beginning of declarations of the predicate
2773               (progn
2774                 (goto-char (prolog-beginning-of-clause))
2775                 (while (and (not (eq (point) op))
2776                             (looking-at
2777                              (format ":-[ \t]*\\(pred\\|mode\\)[ \t]+%s"
2778                                      predname)))
2779                   (setq op (point))
2780                   (goto-char (prolog-beginning-of-clause)))))
2781           op)
2782       (point))))
2783
2784 (defun prolog-pred-end ()
2785   "Return the position at the end of the last clause of the current predicate."
2786   ;; FIXME: Use SMIE.
2787   (save-excursion
2788     (goto-char (prolog-clause-end))     ; If we are before the first predicate.
2789     (goto-char (prolog-clause-start))
2790     (let* ((pinfo (prolog-clause-info))
2791           (predname (nth 0 pinfo))
2792           (arity (nth 1 pinfo))
2793           oldp
2794           (notdone t)
2795           (op (point)))
2796       (if (looking-at "[:?]-")
2797           ;; This was a directive
2798           (progn
2799             (if (and (eq prolog-system 'mercury)
2800                      (looking-at
2801                       (format ":-[ \t]*\\(pred\\|mode\\)[ \t]+\\(%s+\\)"
2802                               prolog-atom-regexp)))
2803                 ;; Skip predicate declarations
2804                 (progn
2805                   (setq predname (buffer-substring-no-properties
2806                                   (match-beginning 2) (match-end 2)))
2807                   (while (re-search-forward
2808                           (format
2809                            "\n*\\(:-[ \t]*\\(pred\\|mode\\)[ \t]+\\)?%s[( \t]"
2810                            predname)
2811                           nil t))))
2812             (goto-char (prolog-clause-end))
2813             (setq op (point)))
2814         ;; It was not a directive, find the last clause
2815         (while (and notdone
2816                     (re-search-forward
2817                      (format "^%s\\([(\\.]\\| *%s\\)"
2818                              predname prolog-head-delimiter) nil t)
2819                     (= arity (nth 1 (prolog-clause-info))))
2820           (setq oldp (point))
2821           (setq op (prolog-clause-end))
2822           (if (>= oldp op)
2823               ;; End of clause not found.
2824               (setq notdone nil)
2825             ;; Continue while loop
2826             (goto-char op))))
2827       op)))
2828
2829 (defun prolog-clause-start (&optional not-allow-methods)
2830   "Return the position at the start of the head of the current clause.
2831 If NOTALLOWMETHODS is non-nil then do not match on methods in
2832 objects (relevant only if `prolog-system' is set to `sicstus')."
2833   (save-excursion
2834     (let ((notdone t)
2835           (retval (point-min)))
2836       (end-of-line)
2837
2838       ;; SICStus object?
2839       (if (and (not not-allow-methods)
2840                (eq prolog-system 'sicstus)
2841                (prolog-in-object))
2842           (while (and
2843                   notdone
2844                   ;; Search for a head or a fact
2845                   (re-search-backward
2846                    ;; If in object, then find method start.
2847                    ;; "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\|,\\)"
2848                    "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\)" ; The comma causes
2849                                         ; problems since we cannot assume
2850                                         ; that the line starts at column 0,
2851                                         ; thus we don't know if the line
2852                                         ; is a head or a subgoal
2853                    (point-min) t))
2854             (if (>= (prolog-paren-balance) 0) ; To no match on "   a) :-"
2855                 ;; Start of method found
2856                 (progn
2857                   (setq retval (point))
2858                   (setq notdone nil)))
2859             )                                ; End of while
2860
2861         ;; Not in object
2862         (while (and
2863                 notdone
2864                 ;; Search for a text at beginning of a line
2865                 ;; ######
2866                 ;; (re-search-backward "^[a-z$']" nil t))
2867                 (let ((case-fold-search nil))
2868                   (re-search-backward "^\\([[:lower:]$']\\|[:?]-\\)"
2869                                       nil t)))
2870           (let ((bal (prolog-paren-balance)))
2871             (cond
2872              ((> bal 0)
2873               ;; Start of clause found
2874               (progn
2875                 (setq retval (point))
2876                 (setq notdone nil)))
2877              ((and (= bal 0)
2878                    (looking-at
2879                     (format ".*\\(\\.\\|%s\\|!,\\)[ \t]*\\(%%.*\\|\\)$"
2880                             prolog-head-delimiter)))
2881               ;; Start of clause found if the line ends with a '.' or
2882               ;; a prolog-head-delimiter
2883               (progn
2884                 (setq retval (point))
2885                 (setq notdone nil))
2886               )
2887              (t nil) ; Do nothing
2888              ))))
2889
2890         retval)))
2891
2892 (defun prolog-clause-end (&optional not-allow-methods)
2893   "Return the position at the end of the current clause.
2894 If NOTALLOWMETHODS is non-nil then do not match on methods in
2895 objects (relevant only if `prolog-system' is set to `sicstus')."
2896   (save-excursion
2897     (beginning-of-line) ; Necessary since we use "^...." for the search.
2898     (if (re-search-forward
2899          (if (and (not not-allow-methods)
2900                   (eq prolog-system 'sicstus)
2901                   (prolog-in-object))
2902              (format
2903               "^\\(%s\\|%s\\|[^\n'\"%%]\\)*&[ \t]*\\(\\|%%.*\\)$\\|[ \t]*}"
2904               prolog-quoted-atom-regexp prolog-string-regexp)
2905            (format
2906             "^\\(%s\\|%s\\|[^\n'\"%%]\\)*\\.[ \t]*\\(\\|%%.*\\)$"
2907             prolog-quoted-atom-regexp prolog-string-regexp))
2908          nil t)
2909         (if (and (nth 8 (syntax-ppss))
2910                  (not (eobp)))
2911             (progn
2912               (forward-char)
2913               (prolog-clause-end))
2914           (point))
2915       (point))))
2916
2917 (defun prolog-clause-info ()
2918   "Return a (name arity) list for the current clause."
2919   (save-excursion
2920     (goto-char (prolog-clause-start))
2921     (let* ((op (point))
2922            (predname
2923             (if (looking-at prolog-atom-char-regexp)
2924                 (progn
2925                   (skip-chars-forward "^ (\\.")
2926                   (buffer-substring op (point)))
2927               ""))
2928            (arity 0))
2929       ;; Retrieve the arity.
2930       (if (looking-at prolog-left-paren)
2931           (let ((endp (save-excursion
2932                         (forward-list) (point))))
2933             (setq arity 1)
2934             (forward-char 1)            ; Skip the opening paren.
2935             (while (progn
2936                      (skip-chars-forward "^[({,'\"")
2937                      (< (point) endp))
2938               (if (looking-at ",")
2939                   (progn
2940                     (setq arity (1+ arity))
2941                     (forward-char 1)    ; Skip the comma.
2942                     )
2943                 ;; We found a string, list or something else we want
2944                 ;; to skip over.
2945                 (forward-sexp 1))
2946               )))
2947       (list predname arity))))
2948
2949 (defun prolog-in-object ()
2950   "Return object name if the point is inside a SICStus object definition."
2951   ;; Return object name if the last line that starts with a character
2952   ;; that is neither white space nor a comment start
2953   (save-excursion
2954     (if (save-excursion
2955           (beginning-of-line)
2956           (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{"))
2957         ;; We were in the head of the object
2958         (match-string 1)
2959       ;; We were not in the head
2960       (if (and (re-search-backward "^[a-z$'}]" nil t)
2961                (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{"))
2962           (match-string 1)
2963         nil))))
2964
2965 (defun prolog-beginning-of-clause ()
2966   "Move to the beginning of current clause.
2967 If already at the beginning of clause, move to previous clause."
2968   (interactive)
2969   (let ((point (point))
2970         (new-point (prolog-clause-start)))
2971     (if (and (>= new-point point)
2972              (> point 1))
2973         (progn
2974           (goto-char (1- point))
2975           (goto-char (prolog-clause-start)))
2976       (goto-char new-point)
2977       (skip-chars-forward " \t"))))
2978
2979 ;; (defun prolog-previous-clause ()
2980 ;;   "Move to the beginning of the previous clause."
2981 ;;   (interactive)
2982 ;;   (forward-char -1)
2983 ;;   (prolog-beginning-of-clause))
2984
2985 (defun prolog-end-of-clause ()
2986   "Move to the end of clause.
2987 If already at the end of clause, move to next clause."
2988   (interactive)
2989   (let ((point (point))
2990         (new-point (prolog-clause-end)))
2991     (if (and (<= new-point point)
2992              (not (eq new-point (point-max))))
2993         (progn
2994           (goto-char (1+ point))
2995           (goto-char (prolog-clause-end)))
2996       (goto-char new-point))))
2997
2998 ;; (defun prolog-next-clause ()
2999 ;;   "Move to the beginning of the next clause."
3000 ;;   (interactive)
3001 ;;   (prolog-end-of-clause)
3002 ;;   (forward-char)
3003 ;;   (prolog-end-of-clause)
3004 ;;   (prolog-beginning-of-clause))
3005
3006 (defun prolog-beginning-of-predicate ()
3007   "Go to the nearest beginning of predicate before current point.
3008 Return the final point or nil if no such a beginning was found."
3009   ;; FIXME: Hook into beginning-of-defun.
3010   (interactive)
3011   (let ((op (point))
3012         (pos (prolog-pred-start)))
3013     (if pos
3014         (if (= op pos)
3015             (if (not (bobp))
3016                 (progn
3017                   (goto-char pos)
3018                   (backward-char 1)
3019                   (setq pos (prolog-pred-start))
3020                   (if pos
3021                       (progn
3022                         (goto-char pos)
3023                         (point)))))
3024           (goto-char pos)
3025           (point)))))
3026
3027 (defun prolog-end-of-predicate ()
3028   "Go to the end of the current predicate."
3029   ;; FIXME: Hook into end-of-defun.
3030   (interactive)
3031   (let ((op (point)))
3032     (goto-char (prolog-pred-end))
3033     (if (= op (point))
3034         (progn
3035           (forward-line 1)
3036           (prolog-end-of-predicate)))))
3037
3038 (defun prolog-insert-predspec ()
3039   "Insert the predspec for the current predicate."
3040   (interactive)
3041   (let* ((pinfo (prolog-clause-info))
3042          (predname (nth 0 pinfo))
3043          (arity (nth 1 pinfo)))
3044     (insert (format "%s/%d" predname arity))))
3045
3046 (defun prolog-view-predspec ()
3047   "Insert the predspec for the current predicate."
3048   (interactive)
3049   (let* ((pinfo (prolog-clause-info))
3050          (predname (nth 0 pinfo))
3051          (arity (nth 1 pinfo)))
3052     (message "%s/%d" predname arity)))
3053
3054 (defun prolog-insert-predicate-template ()
3055   "Insert the template for the current clause."
3056   (interactive)
3057   (let* ((n 1)
3058          oldp
3059          (pinfo (prolog-clause-info))
3060          (predname (nth 0 pinfo))
3061          (arity (nth 1 pinfo)))
3062     (insert predname)
3063     (if (> arity 0)
3064         (progn
3065           (insert "(")
3066           (when prolog-electric-dot-full-predicate-template
3067             (setq oldp (point))
3068             (while (< n arity)
3069               (insert ",")
3070               (setq n (1+ n)))
3071             (insert ")")
3072             (goto-char oldp))
3073           ))
3074   ))
3075
3076 (defun prolog-insert-next-clause ()
3077   "Insert newline and the name of the current clause."
3078   (interactive)
3079   (insert "\n")
3080   (prolog-insert-predicate-template))
3081
3082 (defun prolog-insert-module-modeline ()
3083   "Insert a modeline for module specification.
3084 This line should be first in the buffer.
3085 The module name should be written manually just before the semi-colon."
3086   (interactive)
3087   (insert "%%% -*- Module: ; -*-\n")
3088   (backward-char 6))
3089
3090 (defalias 'prolog-uncomment-region
3091   (if (fboundp 'uncomment-region) #'uncomment-region
3092     (lambda (beg end)
3093       "Uncomment the region between BEG and END."
3094       (interactive "r")
3095       (comment-region beg end -1))))
3096
3097 (defun prolog-indent-predicate ()
3098   "Indent the current predicate."
3099   (interactive)
3100   (indent-region (prolog-pred-start) (prolog-pred-end) nil))
3101
3102 (defun prolog-indent-buffer ()
3103   "Indent the entire buffer."
3104   (interactive)
3105   (indent-region (point-min) (point-max) nil))
3106
3107 (defun prolog-mark-clause ()
3108   "Put mark at the end of this clause and move point to the beginning."
3109   (interactive)
3110   (let ((pos (point)))
3111     (goto-char (prolog-clause-end))
3112     (forward-line 1)
3113     (beginning-of-line)
3114     (set-mark (point))
3115     (goto-char pos)
3116     (goto-char (prolog-clause-start))))
3117
3118 (defun prolog-mark-predicate ()
3119   "Put mark at the end of this predicate and move point to the beginning."
3120   (interactive)
3121   (goto-char (prolog-pred-end))
3122   (let ((pos (point)))
3123     (forward-line 1)
3124     (beginning-of-line)
3125     (set-mark (point))
3126     (goto-char pos)
3127     (goto-char (prolog-pred-start))))
3128
3129 (defun prolog-electric--colon ()
3130   "If `prolog-electric-colon-flag' is non-nil, insert the electric `:' construct.
3131 That is, insert space (if appropriate), `:-' and newline if colon is pressed
3132 at the end of a line that starts in the first column (i.e., clause heads)."
3133   (when (and prolog-electric-colon-flag
3134              (eq (char-before) ?:)
3135              (not current-prefix-arg)
3136              (eolp)
3137              (not (memq (char-after (line-beginning-position))
3138                         '(?\s ?\t ?\%))))
3139     (unless (memq (char-before (1- (point))) '(?\s ?\t))
3140       (save-excursion (forward-char -1) (insert " ")))
3141     (insert "-\n")
3142     (indent-according-to-mode)))
3143
3144 (defun prolog-electric--dash ()
3145   "If `prolog-electric-dash-flag' is non-nil, insert the electric `-' construct.
3146 that is, insert space (if appropriate), `-->' and newline if dash is pressed
3147 at the end of a line that starts in the first column (i.e., DCG heads)."
3148   (when (and prolog-electric-dash-flag
3149              (eq (char-before) ?-)
3150              (not current-prefix-arg)
3151              (eolp)
3152              (not (memq (char-after (line-beginning-position))
3153                         '(?\s ?\t ?\%))))
3154     (unless (memq (char-before (1- (point))) '(?\s ?\t))
3155       (save-excursion (forward-char -1) (insert " ")))
3156     (insert "->\n")
3157     (indent-according-to-mode)))
3158
3159 (defun prolog-electric--dot ()
3160   "Make dot electric, if `prolog-electric-dot-flag' is non-nil.
3161 When invoked at the end of nonempty line, insert dot and newline.
3162 When invoked at the end of an empty line, insert a recursive call to
3163 the current predicate.
3164 When invoked at the beginning of line, insert a head of a new clause
3165 of the current predicate."
3166   ;; Check for situations when the electricity should not be active
3167   (if (or (not prolog-electric-dot-flag)
3168           (not (eq (char-before) ?\.))
3169           current-prefix-arg
3170           (nth 8 (syntax-ppss))
3171           ;; Do not be electric in a floating point number or an operator
3172           (not
3173            (save-excursion
3174              (forward-char -1)
3175              (skip-chars-backward " \t")
3176              (let ((num (> (skip-chars-backward "0-9") 0)))
3177                (or (bolp)
3178                    (memq (char-syntax (char-before))
3179                          (if num '(?w ?_) '(?\) ?w ?_)))))))
3180           ;; Do not be electric if inside a parenthesis pair.
3181           (not (= (car (syntax-ppss))
3182                   0))
3183           )
3184       nil ;;Not electric.
3185     (cond
3186      ;; Beginning of line
3187      ((save-excursion (forward-char -1) (bolp))
3188       (delete-region (1- (point)) (point)) ;Delete the dot that called us.
3189       (prolog-insert-predicate-template))
3190      ;; At an empty line with at least one whitespace
3191      ((save-excursion
3192         (beginning-of-line)
3193         (looking-at "[ \t]+\\.$"))
3194       (delete-region (1- (point)) (point)) ;Delete the dot that called us.
3195       (prolog-insert-predicate-template)
3196       (when prolog-electric-dot-full-predicate-template
3197         (save-excursion
3198           (end-of-line)
3199           (insert ".\n"))))
3200      ;; Default
3201      (t
3202       (insert "\n"))
3203      )))
3204
3205 (defun prolog-electric--underscore ()
3206   "Replace variable with an underscore.
3207 If `prolog-electric-underscore-flag' is non-nil and the point is
3208 on a variable then replace the variable with underscore and skip
3209 the following comma and whitespace, if any."
3210   (when prolog-electric-underscore-flag
3211     (let ((case-fold-search nil))
3212       (when (and (not (nth 8 (syntax-ppss)))
3213                  (eq (char-before) ?_)
3214                  (save-excursion
3215                    (skip-chars-backward "[:alpha:]_")
3216                    (looking-at "\\_<[_[:upper:]][[:alnum:]_]*\\_>")))
3217         (replace-match "_")
3218         (skip-chars-forward ", \t\n")))))
3219
3220 (defun prolog-post-self-insert ()
3221   (pcase last-command-event
3222     (`?_ (prolog-electric--underscore))
3223     (`?- (prolog-electric--dash))
3224     (`?: (prolog-electric--colon))
3225     ((or `?\( `?\; `?>) (prolog-electric--if-then-else))
3226     (`?. (prolog-electric--dot))))
3227
3228 (defun prolog-find-term (functor arity &optional prefix)
3229   "Go to the position at the start of the next occurrence of a term.
3230 The term is specified with FUNCTOR and ARITY.  The optional argument
3231 PREFIX is the prefix of the search regexp."
3232   (let* (;; If prefix is not set then use the default "\\<"
3233          (prefix (if (not prefix)
3234                      "\\<"
3235                    prefix))
3236          (regexp (concat prefix functor))
3237          (i 1))
3238
3239     ;; Build regexp for the search if the arity is > 0
3240     (if (= arity 0)
3241         ;; Add that the functor must be at the end of a word. This
3242         ;; does not work if the arity is > 0 since the closing )
3243         ;; is not a word constituent.
3244         (setq regexp (concat regexp "\\>"))
3245       ;; Arity is > 0, add parens and commas
3246       (setq regexp (concat regexp "("))
3247       (while (< i arity)
3248         (setq regexp (concat regexp ".+,"))
3249         (setq i (1+ i)))
3250       (setq regexp (concat regexp ".+)")))
3251
3252     ;; Search, and return position
3253     (if (re-search-forward regexp nil t)
3254         (goto-char (match-beginning 0))
3255       (error "Term not found"))
3256     ))
3257
3258 (defun prolog-variables-to-anonymous (beg end)
3259   "Replace all variables within a region BEG to END by anonymous variables."
3260   (interactive "r")
3261   (save-excursion
3262     (let ((case-fold-search nil))
3263       (goto-char end)
3264       (while (re-search-backward "\\<[A-Z_][a-zA-Z_0-9]*\\>" beg t)
3265         (progn
3266           (replace-match "_")
3267           (backward-char)))
3268       )))
3269
3270 ;;(defun prolog-regexp-dash-continuous-chars (chars)
3271 ;;  (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
3272 ;;        (beg 0)
3273 ;;        (end 0))
3274 ;;    (if (null ints)
3275 ;;        chars
3276 ;;      (while (and (< (+ beg 1) (length chars))
3277 ;;                  (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
3278 ;;                           (= (nth beg ints) (nth (+ beg 1) ints)))))
3279 ;;        (setq beg (+ beg 1)))
3280 ;;      (setq beg (+ beg 1)
3281 ;;            end beg)
3282 ;;      (while (and (< (+ end 1) (length chars))
3283 ;;                  (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
3284 ;;                      (= (nth end ints) (nth (+ end 1) ints))))
3285 ;;        (setq end (+ end 1)))
3286 ;;      (if (equal (substring chars end) "")
3287 ;;          (substring chars 0 beg)
3288 ;;        (concat (substring chars 0 beg) "-"
3289 ;;                (prolog-regexp-dash-continuous-chars (substring chars end))))
3290 ;;    )))
3291
3292 ;;(defun prolog-condense-character-sets (regexp)
3293 ;;  "Condense adjacent characters in character sets of REGEXP."
3294 ;;  (let ((next -1))
3295 ;;    (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
3296 ;;      (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
3297 ;;                                t t regexp 1))))
3298 ;;  regexp)
3299
3300 ;;-------------------------------------------------------------------
3301 ;; Menu stuff (both for the editing buffer and for the inferior
3302 ;; prolog buffer)
3303 ;;-------------------------------------------------------------------
3304
3305 (unless (fboundp 'region-exists-p)
3306   (defun region-exists-p ()
3307     "Non-nil if the mark is set.  Lobotomized version for Emacsen that do not provide their own."
3308     (mark)))
3309
3310
3311 ;; GNU Emacs ignores `easy-menu-add' so the order in which the menus
3312 ;; are defined _is_ important!
3313
3314 (easy-menu-define
3315   prolog-menu-help (list prolog-mode-map prolog-inferior-mode-map)
3316   "Help menu for the Prolog mode."
3317   ;; FIXME: Does it really deserve a whole menu to itself?
3318   `(,(if (featurep 'xemacs) "Help"
3319        ;; Not sure it's worth the trouble.  --Stef
3320        ;; (add-to-list 'menu-bar-final-items
3321        ;;         (easy-menu-intern "Prolog-Help"))
3322        "Prolog-help")
3323     ["On predicate" prolog-help-on-predicate prolog-help-function-i]
3324     ["Apropos" prolog-help-apropos (eq prolog-system 'swi)]
3325     "---"
3326     ["Describe mode" describe-mode t]))
3327
3328 (easy-menu-define
3329   prolog-edit-menu-runtime prolog-mode-map
3330   "Runtime Prolog commands available from the editing buffer"
3331   ;; FIXME: Don't use a whole menu for just "Run Mercury".  --Stef
3332   `("System"
3333     ;; Runtime menu name.
3334     ,@(unless (featurep 'xemacs)
3335         '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe")
3336                        ((eq prolog-system 'mercury) "Mercury")
3337                        (t "System"))))
3338
3339     ;; Consult items, NIL for mercury.
3340     ["Consult file" prolog-consult-file
3341      :included (not (eq prolog-system 'mercury))]
3342     ["Consult buffer" prolog-consult-buffer
3343      :included (not (eq prolog-system 'mercury))]
3344     ["Consult region" prolog-consult-region :active (region-exists-p)
3345      :included (not (eq prolog-system 'mercury))]
3346     ["Consult predicate" prolog-consult-predicate
3347      :included (not (eq prolog-system 'mercury))]
3348
3349     ;; Compile items, NIL for everything but SICSTUS.
3350     ,(if (featurep 'xemacs) "---"
3351        ["---" nil :included (eq prolog-system 'sicstus)])
3352     ["Compile file" prolog-compile-file
3353      :included (eq prolog-system 'sicstus)]
3354     ["Compile buffer" prolog-compile-buffer
3355      :included (eq prolog-system 'sicstus)]
3356     ["Compile region" prolog-compile-region :active (region-exists-p)
3357      :included (eq prolog-system 'sicstus)]
3358     ["Compile predicate" prolog-compile-predicate
3359      :included (eq prolog-system 'sicstus)]
3360
3361     ;; Debug items, NIL for Mercury.
3362     ,(if (featurep 'xemacs) "---"
3363        ["---" nil :included (not (eq prolog-system 'mercury))])
3364     ;; FIXME: Could we use toggle or radio buttons?  --Stef
3365     ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))]
3366     ["Debug off" prolog-debug-off
3367      ;; In SICStus, these are pairwise disjunctive,
3368      ;; so it's enough with a single "off"-command
3369      :included (not (memq prolog-system '(mercury sicstus)))]
3370     ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))]
3371     ["Trace off" prolog-trace-off
3372      :included (not (memq prolog-system '(mercury sicstus)))]
3373     ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus)
3374                                         (prolog-atleast-version '(3 . 7)))]
3375     ["All debug off" prolog-debug-off
3376      :included (eq prolog-system 'sicstus)]
3377     ["Source level debugging"
3378      prolog-toggle-sicstus-sd
3379      :included (and (eq prolog-system 'sicstus)
3380                     (prolog-atleast-version '(3 . 7)))
3381      :style toggle
3382      :selected prolog-use-sicstus-sd]
3383
3384     "---"
3385     ["Run" run-prolog
3386      :suffix (cond ((eq prolog-system 'eclipse) "ECLiPSe")
3387                    ((eq prolog-system 'mercury) "Mercury")
3388                    (t "Prolog"))]))
3389
3390 (easy-menu-define
3391   prolog-edit-menu-insert-move prolog-mode-map
3392   "Commands for Prolog code manipulation."
3393   '("Prolog"
3394     ["Comment region" comment-region (region-exists-p)]
3395     ["Uncomment region" prolog-uncomment-region (region-exists-p)]
3396     ["Add comment/move to comment" indent-for-comment t]
3397     ["Convert variables in region to '_'" prolog-variables-to-anonymous
3398      :active (region-exists-p) :included (not (eq prolog-system 'mercury))]
3399     "---"
3400     ["Insert predicate template" prolog-insert-predicate-template t]
3401     ["Insert next clause head" prolog-insert-next-clause t]
3402     ["Insert predicate spec" prolog-insert-predspec t]
3403     ["Insert module modeline" prolog-insert-module-modeline t]
3404     "---"
3405     ["Beginning of clause" prolog-beginning-of-clause t]
3406     ["End of clause" prolog-end-of-clause t]
3407     ["Beginning of predicate" prolog-beginning-of-predicate t]
3408     ["End of predicate" prolog-end-of-predicate t]
3409     "---"
3410     ["Indent line" indent-according-to-mode t]
3411     ["Indent region" indent-region (region-exists-p)]
3412     ["Indent predicate" prolog-indent-predicate t]
3413     ["Indent buffer" prolog-indent-buffer t]
3414     ["Align region" align (region-exists-p)]
3415     "---"
3416     ["Mark clause" prolog-mark-clause t]
3417     ["Mark predicate" prolog-mark-predicate t]
3418     ["Mark paragraph" mark-paragraph t]
3419     ))
3420
3421 (defun prolog-menu ()
3422   "Add the menus for the Prolog editing buffers."
3423
3424   (easy-menu-add prolog-edit-menu-insert-move)
3425   (easy-menu-add prolog-edit-menu-runtime)
3426
3427   ;; Add predicate index menu
3428   (setq-local imenu-create-index-function
3429               'imenu-default-create-index-function)
3430   ;;Milan (this has problems with object methods...)  ###### Does it? (Stefan)
3431   (setq-local imenu-prev-index-position-function
3432               #'prolog-beginning-of-predicate)
3433   (setq-local imenu-extract-index-name-function #'prolog-get-predspec)
3434
3435   (if (and prolog-imenu-flag
3436            (< (count-lines (point-min) (point-max)) prolog-imenu-max-lines))
3437       (imenu-add-to-menubar "Predicates"))
3438
3439   (easy-menu-add prolog-menu-help))
3440
3441 (easy-menu-define
3442   prolog-inferior-menu-all prolog-inferior-mode-map
3443   "Menu for the inferior Prolog buffer."
3444   `("Prolog"
3445     ;; Runtime menu name.
3446     ,@(unless (featurep 'xemacs)
3447         '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe")
3448                        ((eq prolog-system 'mercury) "Mercury")
3449                        (t "Prolog"))))
3450
3451     ;; Debug items, NIL for Mercury.
3452     ,(if (featurep 'xemacs) "---"
3453        ["---" nil :included (not (eq prolog-system 'mercury))])
3454     ;; FIXME: Could we use toggle or radio buttons?  --Stef
3455     ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))]
3456     ["Debug off" prolog-debug-off
3457      ;; In SICStus, these are pairwise disjunctive,
3458      ;; so it's enough with a single "off"-command
3459      :included (not (memq prolog-system '(mercury sicstus)))]
3460     ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))]
3461     ["Trace off" prolog-trace-off
3462      :included (not (memq prolog-system '(mercury sicstus)))]
3463     ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus)
3464                                         (prolog-atleast-version '(3 . 7)))]
3465     ["All debug off" prolog-debug-off
3466      :included (eq prolog-system 'sicstus)]
3467     ["Source level debugging"
3468      prolog-toggle-sicstus-sd
3469      :included (and (eq prolog-system 'sicstus)
3470                     (prolog-atleast-version '(3 . 7)))
3471      :style toggle
3472      :selected prolog-use-sicstus-sd]
3473
3474     ;; Runtime.
3475     "---"
3476     ["Interrupt Prolog" comint-interrupt-subjob t]
3477     ["Quit Prolog" comint-quit-subjob t]
3478     ["Kill Prolog" comint-kill-subjob t]))
3479
3480
3481 (defun prolog-inferior-menu ()
3482   "Create the menus for the Prolog inferior buffer.
3483 This menu is dynamically created because one may change systems during
3484 the life of an Emacs session."
3485   (easy-menu-add prolog-inferior-menu-all)
3486   (easy-menu-add prolog-menu-help))
3487
3488 (defun prolog-mode-version ()
3489   "Echo the current version of Prolog mode in the minibuffer."
3490   (interactive)
3491   (message "Using Prolog mode version %s" prolog-mode-version))
3492
3493 (provide 'prolog)
3494
3495 ;;; prolog.el ends here