lisp/progmodes/prolog.el

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