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