lisp/progmodes/prolog.el

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