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 (defvar prolog-upper-case-string ""
 837   "A string containing all upper case characters.
 838 Set by prolog-build-case-strings.")
 839 (defvar prolog-lower-case-string ""
 840   "A string containing all lower case characters.
 841 Set by prolog-build-case-strings.")
 842
 843 (defvar prolog-atom-char-regexp ""
 844   "Set by prolog-set-atom-regexps.")
 845 ;; "Regexp specifying characters which constitute atoms without quoting.")
 846 (defvar prolog-atom-regexp ""
 847   "Set by prolog-set-atom-regexps.")
 848
 849 (defconst prolog-left-paren "[[({]"     ;FIXME: Why not \\s(?
 850   "The characters used as left parentheses for the indentation code.")
 851 (defconst prolog-right-paren "[])}]"    ;FIXME: Why not \\s)?
 852   "The characters used as right parentheses for the indentation code.")
 853
 854 (defconst prolog-quoted-atom-regexp
 855   "\\(^\\|[^0-9]\\)\\('\\([^\n']\\|\\\\'\\)*'\\)"
 856   "Regexp matching a quoted atom.")
 857 (defconst prolog-string-regexp
 858   "\\(\"\\([^\n\"]\\|\\\\\"\\)*\"\\)"
 859   "Regexp matching a string.")
 860 (defconst prolog-head-delimiter "\\(:-\\|\\+:\\|-:\\|\\+\\?\\|-\\?\\|-->\\)"
 861   "A regexp for matching on the end delimiter of a head (e.g. \":-\").")
 862
 863 (defvar prolog-compilation-buffer "*prolog-compilation*"
 864   "Name of the output buffer for Prolog compilation/consulting.")
 865
 866 (defvar prolog-temporary-file-name nil)
 867 (defvar prolog-keywords-i nil)
 868 (defvar prolog-types-i nil)
 869 (defvar prolog-mode-specificators-i nil)
 870 (defvar prolog-determinism-specificators-i nil)
 871 (defvar prolog-directives-i nil)
 872 (defvar prolog-eof-string-i nil)
 873 ;; (defvar prolog-continued-prompt-regexp-i nil)
 874 (defvar prolog-help-function-i nil)
 875
 876 (defvar prolog-align-rules
 877   (eval-when-compile
 878     (mapcar
 879      (lambda (x)
 880        (let ((name (car x))
 881              (sym  (cdr x)))
 882          `(,(intern (format "prolog-%s" name))
 883            (regexp . ,(format "\\(\\s-*\\)%s\\(\\s-*\\)" sym))
 884            (tab-stop . nil)
 885            (modes . '(prolog-mode))
 886            (group . (1 2)))))
 887      '(("dcg" . "-->") ("rule" . ":-") ("simplification" . "<=>")
 888        ("propagation" . "==>")))))
 889
 890
 891 \f
 892 ;;-------------------------------------------------------------------
 893 ;; Prolog mode
 894 ;;-------------------------------------------------------------------
 895
 896 ;; Example: (prolog-atleast-version '(3 . 6))
 897 (defun prolog-atleast-version (version)
 898   "Return t if the version of the current prolog system is VERSION or later.
 899 VERSION is of the format (Major . Minor)"
 900   ;; Version.major < major or
 901   ;; Version.major = major and Version.minor <= minor
 902   (let* ((thisversion (prolog-find-value-by-system prolog-system-version))
 903          (thismajor (car thisversion))
 904          (thisminor (cdr thisversion)))
 905     (or (< (car version) thismajor)
 906         (and (= (car version) thismajor)
 907              (<= (cdr version) thisminor)))
 908     ))
 909
 910 (define-abbrev-table 'prolog-mode-abbrev-table ())
 911
 912 (defun prolog-find-value-by-system (alist)
 913   "Get value from ALIST according to `prolog-system'."
 914   (let ((system (or prolog-system
 915                     (let ((infbuf (prolog-inferior-buffer 'dont-run)))
 916                       (when infbuf
 917                         (buffer-local-value 'prolog-system infbuf))))))
 918     (if (listp alist)
 919         (let (result
 920               id)
 921           (while alist
 922             (setq id (car (car alist)))
 923             (if (or (eq id system)
 924                     (eq id t)
 925                     (and (listp id)
 926                          (eval id)))
 927                 (progn
 928                   (setq result (car (cdr (car alist))))
 929                   (if (and (listp result)
 930                            (eq (car result) 'eval))
 931                       (setq result (eval (car (cdr result)))))
 932                   (setq alist nil))
 933               (setq alist (cdr alist))))
 934           result)
 935       alist)))
 936
 937 (defconst prolog-syntax-propertize-function
 938   (when (fboundp 'syntax-propertize-rules)
 939     (syntax-propertize-rules
 940      ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
 941      ;; possible meaning of 0'' is rather clear.
 942      ("\\<0\\(''?\\)"
 943       (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
 944            (string-to-syntax "_"))))
 945      ;; We could check that we're not inside an atom, but I don't think
 946      ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
 947      ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
 948      ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
 949      ;; escape sequences in atoms, so be careful not to let the terminating \
 950      ;; escape a subsequent quote.
 951      ("\\\\[x0-7][0-9a-fA-F]*\\(\\\\\\)" (1 "_"))
 952      )))
 953
 954 (defun prolog-mode-variables ()
 955   "Set some common variables to Prolog code specific values."
 956   (setq local-abbrev-table prolog-mode-abbrev-table)
 957   (set (make-local-variable 'paragraph-start)
 958        (concat "[ \t]*$\\|" page-delimiter)) ;'%%..'
 959   (set (make-local-variable 'paragraph-separate) paragraph-start)
 960   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
 961   (set (make-local-variable 'normal-auto-fill-function) 'prolog-do-auto-fill)
 962   (set (make-local-variable 'indent-line-function) 'prolog-indent-line)
 963   (set (make-local-variable 'comment-start) "%")
 964   (set (make-local-variable 'comment-end) "")
 965   (set (make-local-variable 'comment-add) 1)
 966   (set (make-local-variable 'comment-start-skip)
 967        ;; This complex regexp makes sure that comments cannot start
 968        ;; inside quoted atoms or strings
 969        (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)"
 970                prolog-quoted-atom-regexp prolog-string-regexp))
 971   (set (make-local-variable 'comment-indent-function) 'prolog-comment-indent)
 972   (set (make-local-variable 'parens-require-spaces) nil)
 973   ;; Initialize Prolog system specific variables
 974   (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
 975                  prolog-determinism-specificators prolog-directives
 976                  prolog-eof-string
 977                  ;; prolog-continued-prompt-regexp
 978                  prolog-help-function))
 979     (set (intern (concat (symbol-name var) "-i"))
 980          (prolog-find-value-by-system (symbol-value var))))
 981   (when (null (prolog-program-name))
 982     (set (make-local-variable 'compile-command) (prolog-compile-string)))
 983   (set (make-local-variable 'font-lock-defaults)
 984        '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
 985   (set (make-local-variable 'syntax-propertize-function)
 986       prolog-syntax-propertize-function)
 987   )
 988
 989 (defun prolog-mode-keybindings-common (map)
 990   "Define keybindings common to both Prolog modes in MAP."
 991   (define-key map "\C-c?" 'prolog-help-on-predicate)
 992   (define-key map "\C-c/" 'prolog-help-apropos)
 993   (define-key map "\C-c\C-d" 'prolog-debug-on)
 994   (define-key map "\C-c\C-t" 'prolog-trace-on)
 995   (define-key map "\C-c\C-z" 'prolog-zip-on)
 996   (define-key map "\C-c\r" 'run-prolog))
 997
 998 (defun prolog-mode-keybindings-edit (map)
 999   "Define keybindings for Prolog mode in MAP."
1000   (define-key map "\M-a" 'prolog-beginning-of-clause)
1001   (define-key map "\M-e" 'prolog-end-of-clause)
1002   (define-key map "\M-q" 'prolog-fill-paragraph)
1003   (define-key map "\C-c\C-a" 'align)
1004   (define-key map "\C-\M-a" 'prolog-beginning-of-predicate)
1005   (define-key map "\C-\M-e" 'prolog-end-of-predicate)
1006   (define-key map "\M-\C-c" 'prolog-mark-clause)
1007   (define-key map "\M-\C-h" 'prolog-mark-predicate)
1008   (define-key map "\M-\C-n" 'prolog-forward-list)
1009   (define-key map "\M-\C-p" 'prolog-backward-list)
1010   (define-key map "\C-c\C-n" 'prolog-insert-predicate-template)
1011   (define-key map "\C-c\C-s" 'prolog-insert-predspec)
1012   (define-key map "\M-\r" 'prolog-insert-next-clause)
1013   (define-key map "\C-c\C-va" 'prolog-variables-to-anonymous)
1014   (define-key map "\C-c\C-v\C-s" 'prolog-view-predspec)
1015
1016   (define-key map [Backspace] 'prolog-electric-delete)
1017   (define-key map "." 'prolog-electric-dot)
1018   (define-key map "_" 'prolog-electric-underscore)
1019   (define-key map "(" 'prolog-electric-if-then-else)
1020   (define-key map ";" 'prolog-electric-if-then-else)
1021   (define-key map ">" 'prolog-electric-if-then-else)
1022   (define-key map ":" 'prolog-electric-colon)
1023   (define-key map "-" 'prolog-electric-dash)
1024   (if prolog-electric-newline-flag
1025       (define-key map "\r" 'newline-and-indent))
1026
1027   ;; If we're running SICStus, then map C-c C-c e/d to enabling
1028   ;; and disabling of the source-level debugging facilities.
1029   ;(if (and (eq prolog-system 'sicstus)
1030   ;         (prolog-atleast-version '(3 . 7)))
1031   ;    (progn
1032   ;      (define-key map "\C-c\C-ce" 'prolog-enable-sicstus-sd)
1033   ;      (define-key map "\C-c\C-cd" 'prolog-disable-sicstus-sd)
1034   ;      ))
1035
1036   (if prolog-old-sicstus-keys-flag
1037       (progn
1038         (define-key map "\C-c\C-c" 'prolog-consult-predicate)
1039         (define-key map "\C-cc" 'prolog-consult-region)
1040         (define-key map "\C-cC" 'prolog-consult-buffer)
1041         (define-key map "\C-c\C-k" 'prolog-compile-predicate)
1042         (define-key map "\C-ck" 'prolog-compile-region)
1043         (define-key map "\C-cK" 'prolog-compile-buffer))
1044     (define-key map "\C-c\C-p" 'prolog-consult-predicate)
1045     (define-key map "\C-c\C-r" 'prolog-consult-region)
1046     (define-key map "\C-c\C-b" 'prolog-consult-buffer)
1047     (define-key map "\C-c\C-f" 'prolog-consult-file)
1048     (define-key map "\C-c\C-cp" 'prolog-compile-predicate)
1049     (define-key map "\C-c\C-cr" 'prolog-compile-region)
1050     (define-key map "\C-c\C-cb" 'prolog-compile-buffer)
1051     (define-key map "\C-c\C-cf" 'prolog-compile-file))
1052
1053   ;; Inherited from the old prolog.el.
1054   (define-key map "\e\C-x" 'prolog-consult-region)
1055   (define-key map "\C-c\C-l" 'prolog-consult-file)
1056   (define-key map "\C-c\C-z" 'switch-to-prolog))
1057
1058 (defun prolog-mode-keybindings-inferior (_map)
1059   "Define keybindings for inferior Prolog mode in MAP."
1060   ;; No inferior mode specific keybindings now.
1061   )
1062
1063 (defvar prolog-mode-map
1064   (let ((map (make-sparse-keymap)))
1065     (prolog-mode-keybindings-common map)
1066     (prolog-mode-keybindings-edit map)
1067     map))
1068
1069
1070 (defvar prolog-mode-hook nil
1071   "List of functions to call after the prolog mode has initialized.")
1072
1073 (unless (fboundp 'prog-mode)
1074   (defalias 'prog-mode 'fundamental-mode))
1075 ;;;###autoload
1076 (define-derived-mode prolog-mode prog-mode "Prolog"
1077   "Major mode for editing Prolog code.
1078
1079 Blank lines and `%%...' separate paragraphs.  `%'s starts a comment
1080 line and comments can also be enclosed in /* ... */.
1081
1082 If an optional argument SYSTEM is non-nil, set up mode for the given system.
1083
1084 To find out what version of Prolog mode you are running, enter
1085 `\\[prolog-mode-version]'.
1086
1087 Commands:
1088 \\{prolog-mode-map}
1089 Entry to this mode calls the value of `prolog-mode-hook'
1090 if that value is non-nil."
1091   (setq mode-name (concat "Prolog"
1092                           (cond
1093                            ((eq prolog-system 'eclipse) "[ECLiPSe]")
1094                            ((eq prolog-system 'sicstus) "[SICStus]")
1095                            ((eq prolog-system 'swi) "[SWI]")
1096                            ((eq prolog-system 'gnu) "[GNU]")
1097                            (t ""))))
1098   (prolog-mode-variables)
1099   (prolog-build-case-strings)
1100   (prolog-set-atom-regexps)
1101   (dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar))
1102
1103   ;; imenu entry moved to the appropriate hook for consistency
1104
1105   ;; Load SICStus debugger if suitable
1106   (if (and (eq prolog-system 'sicstus)
1107            (prolog-atleast-version '(3 . 7))
1108            prolog-use-sicstus-sd)
1109       (prolog-enable-sicstus-sd))
1110
1111   (prolog-menu))
1112
1113 (defvar mercury-mode-map
1114   (let ((map (make-sparse-keymap)))
1115     (set-keymap-parent map prolog-mode-map)
1116     map))
1117
1118 ;;;###autoload
1119 (define-derived-mode mercury-mode prolog-mode "Prolog[Mercury]"
1120   "Major mode for editing Mercury programs.
1121 Actually this is just customized `prolog-mode'."
1122   (set (make-local-variable 'prolog-system) 'mercury))
1123
1124 \f
1125 ;;-------------------------------------------------------------------
1126 ;; Inferior prolog mode
1127 ;;-------------------------------------------------------------------
1128
1129 (defvar prolog-inferior-mode-map
1130   (let ((map (make-sparse-keymap)))
1131     (prolog-mode-keybindings-common map)
1132     (prolog-mode-keybindings-inferior map)
1133     (define-key map [remap self-insert-command]
1134       'prolog-inferior-self-insert-command)
1135     map))
1136
1137 (defvar prolog-inferior-mode-hook nil
1138   "List of functions to call after the inferior prolog mode has initialized.")
1139
1140 (defvar prolog-inferior-error-regexp-alist
1141   '(;; GNU Prolog used to not follow the GNU standard format.
1142     ;; ("^\\(.*?\\):\\([0-9]+\\) error: .*(char:\\([0-9]+\\)" 1 2 3)
1143     ;; SWI-Prolog.
1144     ("^\\(?:\\?- *\\)?\\(\\(?:ERROR\\|\\(W\\)arning\\): *\\(.*?\\):\\([1-9][0-9]*\\):\\(?:\\([0-9]*\\):\\)?\\)\\(?:$\\| \\)"
1145      3 4 5 (2 . nil) 1)
1146     ;; GNU-Prolog now uses the GNU standard format.
1147     gnu))
1148
1149 (defun prolog-inferior-self-insert-command ()
1150   "Insert the char in the buffer or pass it directly to the process."
1151   (interactive)
1152   (let* ((proc (get-buffer-process (current-buffer)))
1153          (pmark (and proc (marker-position (process-mark proc)))))
1154     ;; FIXME: the same treatment would be needed for SWI-Prolog, but I can't
1155     ;; seem to find any way for Emacs to figure out when to use it because
1156     ;; SWI doesn't include a " ? " or some such recognizable marker.
1157     (if (and (eq prolog-system 'gnu)
1158              pmark
1159              (null current-prefix-arg)
1160              (eobp)
1161              (eq (point) pmark)
1162              (save-excursion
1163                (goto-char (- pmark 3))
1164                ;; FIXME: check this comes from the process's output, maybe?
1165                (looking-at " \\? ")))
1166         ;; This is GNU prolog waiting to know whether you want more answers
1167         ;; or not (or abort, etc...).  The answer is a single char, not
1168         ;; a line, so pass this char directly rather than wait for RET to
1169         ;; send a whole line.
1170         (comint-send-string proc (string last-command-event))
1171       (call-interactively 'self-insert-command))))
1172
1173 (declare-function 'compilation-shell-minor-mode "compile" (&optional arg))
1174 (defvar compilation-error-regexp-alist)
1175
1176 (define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog"
1177   "Major mode for interacting with an inferior Prolog process.
1178
1179 The following commands are available:
1180 \\{prolog-inferior-mode-map}
1181
1182 Entry to this mode calls the value of `prolog-mode-hook' with no arguments,
1183 if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
1184 `prolog-mode-hook' is called after `comint-mode-hook'.
1185
1186 You can send text to the inferior Prolog from other buffers
1187 using the commands `send-region', `send-string' and \\[prolog-consult-region].
1188
1189 Commands:
1190 Tab indents for Prolog; with argument, shifts rest
1191  of expression rigidly with the current line.
1192 Paragraphs are separated only by blank lines and '%%'. '%'s start comments.
1193
1194 Return at end of buffer sends line as input.
1195 Return not at end copies rest of line to end and sends it.
1196 \\[comint-delchar-or-maybe-eof] sends end-of-file as input.
1197 \\[comint-kill-input] and \\[backward-kill-word] are kill commands,
1198 imitating normal Unix input editing.
1199 \\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
1200 \\[comint-stop-subjob] stops, likewise.
1201 \\[comint-quit-subjob] sends quit signal, likewise.
1202
1203 To find out what version of Prolog mode you are running, enter
1204 `\\[prolog-mode-version]'."
1205   (require 'compile)
1206   (setq comint-input-filter 'prolog-input-filter)
1207   (setq mode-line-process '(": %s"))
1208   (prolog-mode-variables)
1209   (setq comint-prompt-regexp (prolog-prompt-regexp))
1210   (set (make-local-variable 'shell-dirstack-query) "pwd.")
1211   (set (make-local-variable 'compilation-error-regexp-alist)
1212        prolog-inferior-error-regexp-alist)
1213   (compilation-shell-minor-mode)
1214   (prolog-inferior-menu))
1215
1216 (defun prolog-input-filter (str)
1217   (cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace
1218         ((not (derived-mode-p 'prolog-inferior-mode)) t)
1219         ((= (length str) 1) nil)        ;one character
1220         ((string-match "\\`[rf] *[0-9]*\\'" str) nil) ;r(edo) or f(ail)
1221         (t t)))
1222
1223 ;;;###autoload
1224 (defun run-prolog (arg)
1225   "Run an inferior Prolog process, input and output via buffer *prolog*.
1226 With prefix argument ARG, restart the Prolog process if running before."
1227   (interactive "P")
1228   ;; FIXME: It should be possible to interactively specify the command to use
1229   ;; to run prolog.
1230   (if (and arg (get-process "prolog"))
1231       (progn
1232         (process-send-string "prolog" "halt.\n")
1233         (while (get-process "prolog") (sit-for 0.1))))
1234   (let ((buff (buffer-name)))
1235     (if (not (string= buff "*prolog*"))
1236         (prolog-goto-prolog-process-buffer))
1237     ;; Load SICStus debugger if suitable
1238     (if (and (eq prolog-system 'sicstus)
1239              (prolog-atleast-version '(3 . 7))
1240              prolog-use-sicstus-sd)
1241         (prolog-enable-sicstus-sd))
1242     (prolog-mode-variables)
1243     (prolog-ensure-process)
1244     ))
1245
1246 (defun prolog-inferior-guess-flavor (&optional ignored)
1247   (setq prolog-system
1248         (when (or (numberp prolog-system) (markerp prolog-system))
1249           (save-excursion
1250             (goto-char (1+ prolog-system))
1251             (cond
1252              ((looking-at "GNU Prolog") 'gnu)
1253              ((looking-at "Welcome to SWI-Prolog\\|%.*\\<swi_") 'swi)
1254              ((looking-at ".*\n") nil) ;There's at least one line.
1255              (t prolog-system)))))
1256   (when (symbolp prolog-system)
1257     (remove-hook 'comint-output-filter-functions
1258                  'prolog-inferior-guess-flavor t)
1259     (when prolog-system
1260       (setq comint-prompt-regexp (prolog-prompt-regexp))
1261       (if (eq prolog-system 'gnu)
1262           (set (make-local-variable 'comint-process-echoes) t)))))
1263
1264 (defun prolog-ensure-process (&optional wait)
1265   "If Prolog process is not running, run it.
1266 If the optional argument WAIT is non-nil, wait for Prolog prompt specified by
1267 the variable `prolog-prompt-regexp'."
1268   (if (null (prolog-program-name))
1269       (error "This Prolog system has defined no interpreter."))
1270   (if (comint-check-proc "*prolog*")
1271       ()
1272     (with-current-buffer (get-buffer-create "*prolog*")
1273       (prolog-inferior-mode)
1274       (apply 'make-comint-in-buffer "prolog" (current-buffer)
1275              (prolog-program-name) nil (prolog-program-switches))
1276       (unless prolog-system
1277         ;; Setup auto-detection.
1278         (set (make-local-variable 'prolog-system)
1279              ;; Force re-detection.
1280              (let* ((proc (get-buffer-process (current-buffer)))
1281                     (pmark (and proc (marker-position (process-mark proc)))))
1282                (cond
1283                 ((null pmark) (1- (point-min)))
1284                 ;; The use of insert-before-markers in comint.el together with
1285                 ;; the potential use of comint-truncate-buffer in the output
1286                 ;; filter, means that it's difficult to reliably keep track of
1287                 ;; the buffer position where the process's output started.
1288                 ;; If possible we use a marker at "start - 1", so that
1289                 ;; insert-before-marker at `start' won't shift it.  And if not,
1290                 ;; we fall back on using a plain integer.
1291                 ((> pmark (point-min)) (copy-marker (1- pmark)))
1292                 (t (1- pmark)))))
1293         (add-hook 'comint-output-filter-functions
1294                   'prolog-inferior-guess-flavor nil t))
1295       (if wait
1296           (progn
1297             (goto-char (point-max))
1298             (while
1299                 (save-excursion
1300                   (not
1301                    (re-search-backward
1302                     (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
1303                     nil t)))
1304               (sit-for 0.1)))))))
1305
1306 (defun prolog-inferior-buffer (&optional dont-run)
1307   (or (get-buffer "*prolog*")
1308       (unless dont-run
1309         (prolog-ensure-process)
1310         (get-buffer "*prolog*"))))
1311
1312 (defun prolog-process-insert-string (process string)
1313   "Insert STRING into inferior Prolog buffer running PROCESS."
1314   ;; Copied from elisp manual, greek to me
1315   (with-current-buffer (process-buffer process)
1316     ;; FIXME: Use window-point-insertion-type instead.
1317     (let ((moving (= (point) (process-mark process))))
1318       (save-excursion
1319         ;; Insert the text, moving the process-marker.
1320         (goto-char (process-mark process))
1321         (insert string)
1322         (set-marker (process-mark process) (point)))
1323       (if moving (goto-char (process-mark process))))))
1324 \f
1325 ;;------------------------------------------------------------
1326 ;; Old consulting and compiling functions
1327 ;;------------------------------------------------------------
1328
1329 (declare-function compilation-forget-errors "compile" ())
1330 (declare-function compilation-fake-loc "compile"
1331                   (marker file &optional line col))
1332
1333 (defun prolog-old-process-region (compilep start end)
1334   "Process the region limited by START and END positions.
1335 If COMPILEP is non-nil then use compilation, otherwise consulting."
1336    (prolog-ensure-process)
1337    ;(let ((tmpfile prolog-temp-filename)
1338    (let ((tmpfile (prolog-temporary-file))
1339          ;(process (get-process "prolog"))
1340          (first-line (1+ (count-lines
1341                           (point-min)
1342                           (save-excursion
1343                             (goto-char start)
1344                             (point))))))
1345      (write-region start end tmpfile)
1346      (setq start (copy-marker start))
1347      (with-current-buffer (prolog-inferior-buffer)
1348        (compilation-forget-errors)
1349        (compilation-fake-loc start tmpfile))
1350      (process-send-string
1351       "prolog" (prolog-build-prolog-command
1352                 compilep tmpfile (prolog-bsts buffer-file-name)
1353                 first-line))
1354      (prolog-goto-prolog-process-buffer)))
1355
1356 (defun prolog-old-process-predicate (compilep)
1357   "Process the predicate around point.
1358 If COMPILEP is non-nil then use compilation, otherwise consulting."
1359   (prolog-old-process-region
1360    compilep (prolog-pred-start) (prolog-pred-end)))
1361
1362 (defun prolog-old-process-buffer (compilep)
1363   "Process the entire buffer.
1364 If COMPILEP is non-nil then use compilation, otherwise consulting."
1365   (prolog-old-process-region compilep (point-min) (point-max)))
1366
1367 (defun prolog-old-process-file (compilep)
1368   "Process the file of the current buffer.
1369 If COMPILEP is non-nil then use compilation, otherwise consulting."
1370   (save-some-buffers)
1371   (prolog-ensure-process)
1372   (with-current-buffer (prolog-inferior-buffer)
1373     (compilation-forget-errors))
1374     (process-send-string
1375      "prolog" (prolog-build-prolog-command
1376              compilep buffer-file-name
1377              (prolog-bsts buffer-file-name)))
1378   (prolog-goto-prolog-process-buffer))
1379
1380 \f
1381 ;;------------------------------------------------------------
1382 ;; Consulting and compiling
1383 ;;------------------------------------------------------------
1384
1385 ;; Interactive interface functions, used by both the standard
1386 ;; and the experimental consultation and compilation functions
1387 (defun prolog-consult-file ()
1388   "Consult file of current buffer."
1389   (interactive)
1390   (if prolog-use-standard-consult-compile-method-flag
1391       (prolog-old-process-file nil)
1392     (prolog-consult-compile-file nil)))
1393
1394 (defun prolog-consult-buffer ()
1395   "Consult buffer."
1396   (interactive)
1397   (if prolog-use-standard-consult-compile-method-flag
1398       (prolog-old-process-buffer nil)
1399     (prolog-consult-compile-buffer nil)))
1400
1401 (defun prolog-consult-region (beg end)
1402   "Consult region between BEG and END."
1403   (interactive "r")
1404   (if prolog-use-standard-consult-compile-method-flag
1405       (prolog-old-process-region nil beg end)
1406     (prolog-consult-compile-region nil beg end)))
1407
1408 (defun prolog-consult-predicate ()
1409   "Consult the predicate around current point."
1410   (interactive)
1411   (if prolog-use-standard-consult-compile-method-flag
1412       (prolog-old-process-predicate nil)
1413     (prolog-consult-compile-predicate nil)))
1414
1415 (defun prolog-compile-file ()
1416   "Compile file of current buffer."
1417   (interactive)
1418   (if prolog-use-standard-consult-compile-method-flag
1419       (prolog-old-process-file t)
1420     (prolog-consult-compile-file t)))
1421
1422 (defun prolog-compile-buffer ()
1423   "Compile buffer."
1424   (interactive)
1425   (if prolog-use-standard-consult-compile-method-flag
1426       (prolog-old-process-buffer t)
1427     (prolog-consult-compile-buffer t)))
1428
1429 (defun prolog-compile-region (beg end)
1430   "Compile region between BEG and END."
1431   (interactive "r")
1432   (if prolog-use-standard-consult-compile-method-flag
1433       (prolog-old-process-region t beg end)
1434     (prolog-consult-compile-region t beg end)))
1435
1436 (defun prolog-compile-predicate ()
1437   "Compile the predicate around current point."
1438   (interactive)
1439   (if prolog-use-standard-consult-compile-method-flag
1440       (prolog-old-process-predicate t)
1441     (prolog-consult-compile-predicate t)))
1442
1443 (defun prolog-buffer-module ()
1444   "Select Prolog module name appropriate for current buffer.
1445 Bases decision on buffer contents (-*- line)."
1446   ;; Look for -*- ... module: MODULENAME; ... -*-
1447   (let (beg end)
1448     (save-excursion
1449       (goto-char (point-min))
1450       (skip-chars-forward " \t")
1451       (and (search-forward "-*-" (line-end-position) t)
1452            (progn
1453              (skip-chars-forward " \t")
1454              (setq beg (point))
1455              (search-forward "-*-" (line-end-position) t))
1456            (progn
1457              (forward-char -3)
1458              (skip-chars-backward " \t")
1459              (setq end (point))
1460              (goto-char beg)
1461              (and (let ((case-fold-search t))
1462                     (search-forward "module:" end t))
1463                   (progn
1464                     (skip-chars-forward " \t")
1465                     (setq beg (point))
1466                     (if (search-forward ";" end t)
1467                         (forward-char -1)
1468                       (goto-char end))
1469                     (skip-chars-backward " \t")
1470                     (buffer-substring beg (point)))))))))
1471
1472 (defun prolog-build-prolog-command (compilep file buffername
1473                                     &optional first-line)
1474   "Make Prolog command for FILE compilation/consulting.
1475 If COMPILEP is non-nil, consider compilation, otherwise consulting."
1476   (let* ((compile-string
1477           ;; FIXME: If the process is not running yet, the auto-detection of
1478           ;; prolog-system won't help here, so we should make sure
1479           ;; we first run Prolog and then build the command.
1480           (if compilep (prolog-compile-string) (prolog-consult-string)))
1481          (module (prolog-buffer-module))
1482          (file-name (concat "'" (prolog-bsts file) "'"))
1483          (module-name (if module (concat "'" module "'")))
1484          (module-file (if module
1485                           (concat module-name ":" file-name)
1486                         file-name))
1487          strbeg strend
1488          (lineoffset (if first-line
1489                          (- first-line 1)
1490                        0)))
1491
1492     ;; Assure that there is a buffer name
1493     (if (not buffername)
1494         (error "The buffer is not saved"))
1495
1496     (if (not (string-match "\\`'.*'\\'" buffername)) ; Add quotes
1497         (setq buffername (concat "'" buffername "'")))
1498     (while (string-match "%m" compile-string)
1499       (setq strbeg (substring compile-string 0 (match-beginning 0)))
1500       (setq strend (substring compile-string (match-end 0)))
1501       (setq compile-string (concat strbeg module-file strend)))
1502     ;; FIXME: The code below will %-expand any %[fbl] that appears in
1503     ;; module-file.
1504     (while (string-match "%f" compile-string)
1505       (setq strbeg (substring compile-string 0 (match-beginning 0)))
1506       (setq strend (substring compile-string (match-end 0)))
1507       (setq compile-string (concat strbeg file-name strend)))
1508     (while (string-match "%b" compile-string)
1509       (setq strbeg (substring compile-string 0 (match-beginning 0)))
1510       (setq strend (substring compile-string (match-end 0)))
1511       (setq compile-string (concat strbeg buffername strend)))
1512     (while (string-match "%l" compile-string)
1513       (setq strbeg (substring compile-string 0 (match-beginning 0)))
1514       (setq strend (substring compile-string (match-end 0)))
1515       (setq compile-string (concat strbeg (format "%d" lineoffset) strend)))
1516     (concat compile-string "\n")))
1517
1518 ;; The rest of this page is experimental code!
1519
1520 ;; Global variables for process filter function
1521 (defvar prolog-process-flag nil
1522   "Non-nil means that a prolog task (i.e. a consultation or compilation job)
1523 is running.")
1524 (defvar prolog-consult-compile-output ""
1525   "Hold the unprocessed output from the current prolog task.")
1526 (defvar prolog-consult-compile-first-line 1
1527   "The number of the first line of the file to consult/compile.
1528 Used for temporary files.")
1529 (defvar prolog-consult-compile-file nil
1530   "The file to compile/consult (can be a temporary file).")
1531 (defvar prolog-consult-compile-real-file nil
1532   "The file name of the buffer to compile/consult.")
1533
1534 (defvar compilation-parse-errors-function)
1535
1536 (defun prolog-consult-compile (compilep file &optional first-line)
1537   "Consult/compile FILE.
1538 If COMPILEP is non-nil, perform compilation, otherwise perform CONSULTING.
1539 COMMAND is a string described by the variables `prolog-consult-string'
1540 and `prolog-compile-string'.
1541 Optional argument FIRST-LINE is the number of the first line in the compiled
1542 region.
1543
1544 This function must be called from the source code buffer."
1545   (if prolog-process-flag
1546       (error "Another Prolog task is running."))
1547   (prolog-ensure-process t)
1548   (let* ((buffer (get-buffer-create prolog-compilation-buffer))
1549          (real-file buffer-file-name)
1550          (command-string (prolog-build-prolog-command compilep file
1551                                                       real-file first-line))
1552          (process (get-process "prolog"))
1553          (old-filter (process-filter process)))
1554     (with-current-buffer buffer
1555       (delete-region (point-min) (point-max))
1556       ;; FIXME: Wasn't this supposed to use prolog-inferior-mode?
1557       (compilation-mode)
1558       ;; FIXME: This doesn't seem to cooperate well with new(ish) compile.el.
1559       ;; Setting up font-locking for this buffer
1560       (set (make-local-variable 'font-lock-defaults)
1561            '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
1562       (if (eq prolog-system 'sicstus)
1563           ;; FIXME: This looks really problematic: not only is this using
1564           ;; the old compilation-parse-errors-function, but
1565           ;; prolog-parse-sicstus-compilation-errors only accepts one argument
1566           ;; whereas compile.el calls it with 2 (and did so at least since
1567           ;; Emacs-20).
1568             (set (make-local-variable 'compilation-parse-errors-function)
1569                'prolog-parse-sicstus-compilation-errors))
1570       (setq buffer-read-only nil)
1571       (insert command-string "\n"))
1572     (save-selected-window
1573       (pop-to-buffer buffer))
1574     (setq prolog-process-flag t
1575           prolog-consult-compile-output ""
1576           prolog-consult-compile-first-line (if first-line (1- first-line) 0)
1577           prolog-consult-compile-file file
1578           prolog-consult-compile-real-file (if (string=
1579                                                 file buffer-file-name)
1580                                                nil
1581                                              real-file))
1582     (with-current-buffer buffer
1583       (goto-char (point-max))
1584       (set-process-filter process 'prolog-consult-compile-filter)
1585       (process-send-string "prolog" command-string)
1586       ;; (prolog-build-prolog-command compilep file real-file first-line))
1587       (while (and prolog-process-flag
1588                   (accept-process-output process 10)) ; 10 secs is ok?
1589         (sit-for 0.1)
1590         (unless (get-process "prolog")
1591           (setq prolog-process-flag nil)))
1592       (insert (if compilep
1593                   "\nCompilation finished.\n"
1594                 "\nConsulted.\n"))
1595       (set-process-filter process old-filter))))
1596
1597 (defvar compilation-error-list)
1598
1599 (defun prolog-parse-sicstus-compilation-errors (limit)
1600   "Parse the prolog compilation buffer for errors.
1601 Argument LIMIT is a buffer position limiting searching.
1602 For use with the `compilation-parse-errors-function' variable."
1603   (setq compilation-error-list nil)
1604   (message "Parsing SICStus error messages...")
1605   (let (filepath dir file errorline)
1606     (while
1607         (re-search-backward
1608          "{\\([a-zA-Z ]* ERROR\\|Warning\\):.* in line[s ]*\\([0-9]+\\)"
1609          limit t)
1610       (setq errorline (string-to-number (match-string 2)))
1611       (save-excursion
1612         (re-search-backward
1613          "{\\(consulting\\|compiling\\|processing\\) \\(.*\\)\\.\\.\\.}"
1614          limit t)
1615         (setq filepath (match-string 2)))
1616
1617       ;; ###### Does this work with SICStus under Windows (i.e. backslashes and stuff?)
1618       (if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath)
1619           (progn
1620             (setq dir (match-string 1 filepath))
1621             (setq file (match-string 2 filepath))))
1622
1623       (setq compilation-error-list
1624             (cons
1625              (cons (save-excursion
1626                      (beginning-of-line)
1627                      (point-marker))
1628                    (list (list file dir) errorline))
1629              compilation-error-list)
1630             ))
1631     ))
1632
1633 (defun prolog-consult-compile-filter (process output)
1634   "Filter function for Prolog compilation PROCESS.
1635 Argument OUTPUT is a name of the output file."
1636   ;;(message "start")
1637   (setq prolog-consult-compile-output
1638         (concat prolog-consult-compile-output output))
1639   ;;(message "pccf1: %s" prolog-consult-compile-output)
1640   ;; Iterate through the lines of prolog-consult-compile-output
1641   (let (outputtype)
1642     (while (and prolog-process-flag
1643                 (or
1644                  ;; Trace question
1645                  (progn
1646                    (setq outputtype 'trace)
1647                    (and (eq prolog-system 'sicstus)
1648                         (string-match
1649                          "^[ \t]*[0-9]+[ \t]*[0-9]+[ \t]*Call:.*? "
1650                          prolog-consult-compile-output)))
1651
1652                  ;; Match anything
1653                  (progn
1654                    (setq outputtype 'normal)
1655                    (string-match "^.*\n" prolog-consult-compile-output))
1656                    ))
1657       ;;(message "outputtype: %s" outputtype)
1658
1659       (setq output (match-string 0 prolog-consult-compile-output))
1660       ;; remove the text in output from prolog-consult-compile-output
1661       (setq prolog-consult-compile-output
1662             (substring prolog-consult-compile-output (length output)))
1663       ;;(message "pccf2: %s" prolog-consult-compile-output)
1664
1665       ;; If temporary files were used, then we change the error
1666       ;; messages to point to the original source file.
1667       ;; FIXME: Use compilation-fake-loc instead.
1668       (cond
1669
1670        ;; If the prolog process was in trace mode then it requires
1671        ;; user input
1672        ((and (eq prolog-system 'sicstus)
1673              (eq outputtype 'trace))
1674         (let ((input (concat (read-string output) "\n")))
1675           (process-send-string process input)
1676           (setq output (concat output input))))
1677
1678        ((eq prolog-system 'sicstus)
1679         (if (and prolog-consult-compile-real-file
1680                  (string-match
1681                   "\\({.*:.* in line[s ]*\\)\\([0-9]+\\)-\\([0-9]+\\)" output))
1682             (setq output (replace-match
1683                           ;; Adds a {processing ...} line so that
1684                           ;; `prolog-parse-sicstus-compilation-errors'
1685                           ;; finds the real file instead of the temporary one.
1686                           ;; Also fixes the line numbers.
1687                           (format "Added by Emacs: {processing %s...}\n%s%d-%d"
1688                                   prolog-consult-compile-real-file
1689                                   (match-string 1 output)
1690                                   (+ prolog-consult-compile-first-line
1691                                      (string-to-number
1692                                       (match-string 2 output)))
1693                                   (+ prolog-consult-compile-first-line
1694                                      (string-to-number
1695                                       (match-string 3 output))))
1696                           t t output)))
1697         )
1698
1699        ((eq prolog-system 'swi)
1700         (if (and prolog-consult-compile-real-file
1701                  (string-match (format
1702                                 "%s\\([ \t]*:[ \t]*\\)\\([0-9]+\\)"
1703                                 prolog-consult-compile-file)
1704                                output))
1705             (setq output (replace-match
1706                           ;; Real filename + text + fixed linenum
1707                           (format "%s%s%d"
1708                                   prolog-consult-compile-real-file
1709                                   (match-string 1 output)
1710                                   (+ prolog-consult-compile-first-line
1711                                      (string-to-number
1712                                       (match-string 2 output))))
1713                           t t output)))
1714         )
1715
1716        (t ())
1717        )
1718       ;; Write the output in the *prolog-compilation* buffer
1719       (insert output)))
1720
1721   ;; If the prompt is visible, then the task is finished
1722   (if (string-match (prolog-prompt-regexp) prolog-consult-compile-output)
1723       (setq prolog-process-flag nil)))
1724
1725 (defun prolog-consult-compile-file (compilep)
1726   "Consult/compile file of current buffer.
1727 If COMPILEP is non-nil, compile, otherwise consult."
1728   (let ((file buffer-file-name))
1729     (if file
1730         (progn
1731           (save-some-buffers)
1732           (prolog-consult-compile compilep file))
1733       (prolog-consult-compile-region compilep (point-min) (point-max)))))
1734
1735 (defun prolog-consult-compile-buffer (compilep)
1736   "Consult/compile current buffer.
1737 If COMPILEP is non-nil, compile, otherwise consult."
1738   (prolog-consult-compile-region compilep (point-min) (point-max)))
1739
1740 (defun prolog-consult-compile-region (compilep beg end)
1741   "Consult/compile region between BEG and END.
1742 If COMPILEP is non-nil, compile, otherwise consult."
1743   ;(let ((file prolog-temp-filename)
1744   (let ((file (prolog-bsts (prolog-temporary-file)))
1745         (lines (count-lines 1 beg)))
1746     (write-region beg end file nil 'no-message)
1747     (write-region "\n" nil file t 'no-message)
1748     (prolog-consult-compile compilep file
1749                             (if (bolp) (1+ lines) lines))
1750     (delete-file file)))
1751
1752 (defun prolog-consult-compile-predicate (compilep)
1753   "Consult/compile the predicate around current point.
1754 If COMPILEP is non-nil, compile, otherwise consult."
1755   (prolog-consult-compile-region
1756    compilep (prolog-pred-start) (prolog-pred-end)))
1757
1758 \f
1759 ;;-------------------------------------------------------------------
1760 ;; Font-lock stuff
1761 ;;-------------------------------------------------------------------
1762
1763 ;; Auxiliary functions
1764 (defun prolog-make-keywords-regexp (keywords &optional protect)
1765   "Create regexp from the list of strings KEYWORDS.
1766 If PROTECT is non-nil, surround the result regexp by word breaks."
1767   (let ((regexp
1768          (if (fboundp 'regexp-opt)
1769              ;; Emacs 20
1770              ;; Avoid compile warnings under earlier versions by using eval
1771              (eval '(regexp-opt keywords))
1772            ;; Older Emacsen
1773            (concat (mapconcat 'regexp-quote keywords "\\|")))
1774          ))
1775     (if protect
1776         (concat "\\<\\(" regexp "\\)\\>")
1777       regexp)))
1778
1779 (defun prolog-font-lock-object-matcher (bound)
1780   "Find SICStus objects method name for font lock.
1781 Argument BOUND is a buffer position limiting searching."
1782   (let (point
1783         (case-fold-search nil))
1784     (while (and (not point)
1785                 (re-search-forward "\\(::[ \t\n]*{\\|&\\)[ \t]*"
1786                                    bound t))
1787       (while (or (re-search-forward "\\=\n[ \t]*" bound t)
1788                  (re-search-forward "\\=%.*" bound t)
1789                  (and (re-search-forward "\\=/\\*" bound t)
1790                       (re-search-forward "\\*/[ \t]*" bound t))))
1791       (setq point (re-search-forward
1792                    (format "\\=\\(%s\\)" prolog-atom-regexp)
1793                    bound t)))
1794     point))
1795
1796 (defsubst prolog-face-name-p (facename)
1797   ;; Return t if FACENAME is the name of a face.  This method is
1798   ;; necessary since facep in XEmacs only returns t for the actual
1799   ;; face objects (while it's only their names that are used just
1800   ;; about anywhere else) without providing a predicate that tests
1801   ;; face names.  This function (including the above commentary) is
1802   ;; borrowed from cc-mode.
1803   (memq facename (face-list)))
1804
1805 ;; Set everything up
1806 (defun prolog-font-lock-keywords ()
1807   "Set up font lock keywords for the current Prolog system."
1808   ;(when window-system
1809     (require 'font-lock)
1810
1811     ;; Define Prolog faces
1812     (defface prolog-redo-face
1813       '((((class grayscale)) (:italic t))
1814         (((class color)) (:foreground "darkorchid"))
1815         (t (:italic t)))
1816       "Prolog mode face for highlighting redo trace lines."
1817       :group 'prolog-faces)
1818     (defface prolog-exit-face
1819       '((((class grayscale)) (:underline t))
1820         (((class color) (background dark)) (:foreground "green"))
1821         (((class color) (background light)) (:foreground "ForestGreen"))
1822         (t (:underline t)))
1823       "Prolog mode face for highlighting exit trace lines."
1824       :group 'prolog-faces)
1825     (defface prolog-exception-face
1826       '((((class grayscale)) (:bold t :italic t :underline t))
1827         (((class color)) (:bold t :foreground "black" :background "Khaki"))
1828         (t (:bold t :italic t :underline t)))
1829       "Prolog mode face for highlighting exception trace lines."
1830       :group 'prolog-faces)
1831     (defface prolog-warning-face
1832       '((((class grayscale)) (:underline t))
1833         (((class color) (background dark)) (:foreground "blue"))
1834         (((class color) (background light)) (:foreground "MidnightBlue"))
1835         (t (:underline t)))
1836       "Face name to use for compiler warnings."
1837       :group 'prolog-faces)
1838     (defface prolog-builtin-face
1839       '((((class color) (background light)) (:foreground "Purple"))
1840         (((class color) (background dark)) (:foreground "Cyan"))
1841         (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
1842         (((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
1843         (t (:bold t)))
1844       "Face name to use for compiler warnings."
1845       :group 'prolog-faces)
1846     (defvar prolog-warning-face
1847       (if (prolog-face-name-p 'font-lock-warning-face)
1848           'font-lock-warning-face
1849         'prolog-warning-face)
1850       "Face name to use for built in predicates.")
1851     (defvar prolog-builtin-face
1852       (if (prolog-face-name-p 'font-lock-builtin-face)
1853           'font-lock-builtin-face
1854         'prolog-builtin-face)
1855       "Face name to use for built in predicates.")
1856     (defvar prolog-redo-face 'prolog-redo-face
1857       "Face name to use for redo trace lines.")
1858     (defvar prolog-exit-face 'prolog-exit-face
1859       "Face name to use for exit trace lines.")
1860     (defvar prolog-exception-face 'prolog-exception-face
1861       "Face name to use for exception trace lines.")
1862
1863     ;; Font Lock Patterns
1864     (let (
1865           ;; "Native" Prolog patterns
1866           (head-predicates
1867            (list (format "^\\(%s\\)\\((\\|[ \t]*:-\\)" prolog-atom-regexp)
1868                  1 font-lock-function-name-face))
1869            ;(list (format "^%s" prolog-atom-regexp)
1870            ;      0 font-lock-function-name-face))
1871           (head-predicates-1
1872            (list (format "\\.[ \t]*\\(%s\\)" prolog-atom-regexp)
1873                  1 font-lock-function-name-face) )
1874           (variables
1875            '("\\<\\([_A-Z][a-zA-Z0-9_]*\\)"
1876              1 font-lock-variable-name-face))
1877           (important-elements
1878            (list (if (eq prolog-system 'mercury)
1879                      "[][}{;|]\\|\\\\[+=]\\|<?=>?"
1880                    "[][}{!;|]\\|\\*->")
1881                  0 'font-lock-keyword-face))
1882           (important-elements-1
1883            '("[^-*]\\(->\\)" 1 font-lock-keyword-face))
1884           (predspecs                        ; module:predicate/cardinality
1885            (list (format "\\<\\(%s:\\|\\)%s/[0-9]+"
1886                          prolog-atom-regexp prolog-atom-regexp)
1887                  0 font-lock-function-name-face 'prepend))
1888           (keywords                        ; directives (queries)
1889            (list
1890             (if (eq prolog-system 'mercury)
1891                 (concat
1892                  "\\<\\("
1893                  (prolog-make-keywords-regexp prolog-keywords-i)
1894                  "\\|"
1895                  (prolog-make-keywords-regexp
1896                   prolog-determinism-specificators-i)
1897                  "\\)\\>")
1898               (concat
1899                "^[?:]- *\\("
1900                (prolog-make-keywords-regexp prolog-keywords-i)
1901                "\\)\\>"))
1902               1 prolog-builtin-face))
1903           (quoted_atom (list prolog-quoted-atom-regexp
1904                              2 'font-lock-string-face 'append))
1905           (string (list prolog-string-regexp
1906                         1 'font-lock-string-face 'append))
1907           ;; SICStus specific patterns
1908           (sicstus-object-methods
1909            (if (eq prolog-system 'sicstus)
1910                '(prolog-font-lock-object-matcher
1911                  1 font-lock-function-name-face)))
1912           ;; Mercury specific patterns
1913           (types
1914            (if (eq prolog-system 'mercury)
1915                (list
1916                 (prolog-make-keywords-regexp prolog-types-i t)
1917                 0 'font-lock-type-face)))
1918           (modes
1919            (if (eq prolog-system 'mercury)
1920                (list
1921                 (prolog-make-keywords-regexp prolog-mode-specificators-i t)
1922                 0 'font-lock-reference-face)))
1923           (directives
1924            (if (eq prolog-system 'mercury)
1925                (list
1926                 (prolog-make-keywords-regexp prolog-directives-i t)
1927                 0 'prolog-warning-face)))
1928           ;; Inferior mode specific patterns
1929           (prompt
1930            ;; FIXME: Should be handled by comint already.
1931            (list (prolog-prompt-regexp) 0 'font-lock-keyword-face))
1932           (trace-exit
1933            ;; FIXME: Add to compilation-error-regexp-alist instead.
1934            (cond
1935             ((eq prolog-system 'sicstus)
1936              '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):"
1937                1 prolog-exit-face))
1938             ((eq prolog-system 'swi)
1939              '("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face))
1940             (t nil)))
1941           (trace-fail
1942            ;; FIXME: Add to compilation-error-regexp-alist instead.
1943            (cond
1944             ((eq prolog-system 'sicstus)
1945              '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):"
1946                1 prolog-warning-face))
1947             ((eq prolog-system 'swi)
1948              '("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face))
1949             (t nil)))
1950           (trace-redo
1951            ;; FIXME: Add to compilation-error-regexp-alist instead.
1952            (cond
1953             ((eq prolog-system 'sicstus)
1954              '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):"
1955                1 prolog-redo-face))
1956             ((eq prolog-system 'swi)
1957              '("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face))
1958             (t nil)))
1959           (trace-call
1960            ;; FIXME: Add to compilation-error-regexp-alist instead.
1961            (cond
1962             ((eq prolog-system 'sicstus)
1963              '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):"
1964                1 font-lock-function-name-face))
1965             ((eq prolog-system 'swi)
1966              '("[ \t]*\\(Call\\):[ \t]*([ \t0-9]*)"
1967                1 font-lock-function-name-face))
1968             (t nil)))
1969           (trace-exception
1970            ;; FIXME: Add to compilation-error-regexp-alist instead.
1971            (cond
1972             ((eq prolog-system 'sicstus)
1973              '("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):"
1974                1 prolog-exception-face))
1975             ((eq prolog-system 'swi)
1976              '("[ \t]*\\(Exception\\):[ \t]*([ \t0-9]*)"
1977                1 prolog-exception-face))
1978             (t nil)))
1979           (error-message-identifier
1980            ;; FIXME: Add to compilation-error-regexp-alist instead.
1981            (cond
1982             ((eq prolog-system 'sicstus)
1983              '("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend))
1984             ((eq prolog-system 'swi)
1985              '("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend))
1986             (t nil)))
1987           (error-whole-messages
1988            ;; FIXME: Add to compilation-error-regexp-alist instead.
1989            (cond
1990             ((eq prolog-system 'sicstus)
1991              '("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$"
1992                1 font-lock-comment-face append))
1993             ((eq prolog-system 'swi)
1994              '("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append))
1995             (t nil)))
1996           (error-warning-messages
1997            ;; FIXME: Add to compilation-error-regexp-alist instead.
1998            ;; Mostly errors that SICStus asks the user about how to solve,
1999            ;; such as "NAME CLASH:" for example.
2000            (cond
2001             ((eq prolog-system 'sicstus)
2002              '("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face))
2003             (t nil)))
2004           (warning-messages
2005            ;; FIXME: Add to compilation-error-regexp-alist instead.
2006            (cond
2007             ((eq prolog-system 'sicstus)
2008              '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$"
2009                2 prolog-warning-face prepend))
2010             (t nil))))
2011
2012       ;; Make font lock list
2013       (delq
2014        nil
2015        (cond
2016         ((eq major-mode 'prolog-mode)
2017          (list
2018           head-predicates
2019           head-predicates-1
2020           quoted_atom
2021           string
2022           variables
2023           important-elements
2024           important-elements-1
2025           predspecs
2026           keywords
2027           sicstus-object-methods
2028           types
2029           modes
2030           directives))
2031         ((eq major-mode 'prolog-inferior-mode)
2032          (list
2033          prompt
2034          error-message-identifier
2035          error-whole-messages
2036          error-warning-messages
2037          warning-messages
2038          predspecs
2039          trace-exit
2040          trace-fail
2041          trace-redo
2042          trace-call
2043          trace-exception))
2044         ((eq major-mode 'compilation-mode)
2045          (list
2046          error-message-identifier
2047          error-whole-messages
2048          error-warning-messages
2049          warning-messages
2050          predspecs))))
2051       ))
2052
2053 \f
2054 ;;-------------------------------------------------------------------
2055 ;; Indentation stuff
2056 ;;-------------------------------------------------------------------
2057
2058 ;; NB: This function *MUST* have this optional argument since XEmacs
2059 ;; assumes it. This does not mean we have to use it...
2060 (defun prolog-indent-line (&optional _whole-exp)
2061   "Indent current line as Prolog code.
2062 With argument, indent any additional lines of the same clause
2063 rigidly along with this one (not yet)."
2064   (interactive "p")
2065   (let ((indent (prolog-indent-level))
2066         (pos (- (point-max) (point))))
2067     (beginning-of-line)
2068     (skip-chars-forward " \t")
2069     (indent-line-to indent)
2070     (if (> (- (point-max) pos) (point))
2071         (goto-char (- (point-max) pos)))
2072
2073     ;; Align comments
2074     (if (and prolog-align-comments-flag
2075              (save-excursion
2076                (line-beginning-position)
2077                ;; (let ((start (comment-search-forward (line-end-position) t)))
2078                ;;   (and start             ;There's a comment to indent.
2079                ;;       ;; If it's first on the line, we've indented it already
2080                ;;       ;; and prolog-goto-comment-column would inf-loop.
2081                ;;       (progn (goto-char start) (skip-chars-backward " \t")
2082                ;;              (not (bolp)))))))
2083                (and (looking-at comment-start-skip)
2084                     ;; The definition of comment-start-skip used in this
2085                     ;; mode is unusual in that it only matches at BOL.
2086                     (progn (skip-chars-forward " \t")
2087                            (not (eq (point) (match-end 1)))))))
2088         (save-excursion
2089           (prolog-goto-comment-column t)))
2090
2091     ;; Insert spaces if needed
2092     (if (or prolog-electric-tab-flag prolog-electric-if-then-else-flag)
2093         (prolog-insert-spaces-after-paren))
2094     ))
2095
2096 (defun prolog-comment-indent ()
2097   "Compute prolog comment indentation."
2098   ;; FIXME: Only difference with default behavior is that %%% is not
2099   ;; flushed to column 0 but just left where the user put it.
2100   (cond ((looking-at "%%%") (prolog-indentation-level-of-line))
2101         ((looking-at "%%") (prolog-indent-level))
2102         (t
2103          (save-excursion
2104            (skip-chars-backward " \t")
2105            ;; Insert one space at least, except at left margin.
2106            (max (+ (current-column) (if (bolp) 0 1))
2107                 comment-column)))
2108         ))
2109
2110 (defun prolog-indent-level ()
2111   "Compute prolog indentation level."
2112   (save-excursion
2113     (beginning-of-line)
2114     (let ((totbal (prolog-region-paren-balance
2115                    (prolog-clause-start t) (point)))
2116           (oldpoint (point)))
2117       (skip-chars-forward " \t")
2118       (cond
2119        ((looking-at "%%%") (prolog-indentation-level-of-line))
2120                                              ;Large comment starts
2121        ((looking-at "%[^%]") comment-column) ;Small comment starts
2122        ((bobp) 0)                            ;Beginning of buffer
2123
2124        ;; If we found '}' then we must check if it's the
2125        ;; end of an object declaration or something else.
2126        ((and (looking-at "}")
2127              (save-excursion
2128                (forward-char 1)
2129                ;; Goto to matching {
2130                (if prolog-use-prolog-tokenizer-flag
2131                    (prolog-backward-list)
2132                  (backward-list))
2133                (skip-chars-backward " \t")
2134                (backward-char 2)
2135                (looking-at "::")))
2136         ;; It was an object
2137         (if prolog-object-end-to-0-flag
2138             0
2139           prolog-indent-width))
2140
2141        ;;End of /* */ comment
2142        ((looking-at "\\*/")
2143         (save-excursion
2144           (prolog-find-start-of-mline-comment)
2145           (skip-chars-backward " \t")
2146           (- (current-column) 2)))
2147
2148        ;; Here we check if the current line is within a /* */ pair
2149        ((and (looking-at "[^%/]")
2150              (eq (prolog-in-string-or-comment) 'cmt))
2151         (if prolog-indent-mline-comments-flag
2152             (prolog-find-start-of-mline-comment)
2153           ;; Same as before
2154           (prolog-indentation-level-of-line)))
2155
2156        (t
2157         (let ((empty t) ind linebal)
2158           ;; See previous indentation
2159           (while empty
2160             (forward-line -1)
2161             (beginning-of-line)
2162             (if (bobp)
2163                 (setq empty nil)
2164               (skip-chars-forward " \t")
2165               (if (not (or (not (member (prolog-in-string-or-comment)
2166                                         '(nil txt)))
2167                            (looking-at "%")
2168                            (looking-at "\n")))
2169                   (setq empty nil))))
2170
2171           ;; Store this line's indentation
2172           (setq ind (if (bobp)
2173                         0                ;Beginning of buffer.
2174                       (current-column))) ;Beginning of clause.
2175
2176           ;; Compute the balance of the line
2177           (setq linebal (prolog-paren-balance))
2178           ;;(message "bal of previous line %d totbal %d" linebal totbal)
2179           (if (< linebal 0)
2180               (progn
2181                 ;; Add 'indent-level' mode to find-unmatched-paren instead?
2182                 (end-of-line)
2183                 (setq ind (prolog-find-indent-of-matching-paren))))
2184
2185           ;;(message "ind %d" ind)
2186           (beginning-of-line)
2187
2188           ;; Check if the line ends with ":-", ".", ":: {", "}" (might be
2189           ;; unnecessary), "&" or ")" (The last four concerns SICStus objects)
2190           (cond
2191            ;; If the last char of the line is a '&' then set the indent level
2192            ;; to prolog-indent-width (used in SICStus objects)
2193            ((and (eq prolog-system 'sicstus)
2194                  (looking-at ".+&[ \t]*\\(%.*\\|\\)$"))
2195             (setq ind prolog-indent-width))
2196
2197            ;; Increase indentation if the previous line was the head of a rule
2198            ;; and does not contain a '.'
2199            ((and (looking-at (format ".*%s[^\\.]*[ \t]*\\(%%.*\\|\\)$"
2200                                      prolog-head-delimiter))
2201                  ;; We must check that the match is at a paren balance of 0.
2202                  (save-excursion
2203                    (let ((p (point)))
2204                      (re-search-forward prolog-head-delimiter)
2205                      (>= 0 (prolog-region-paren-balance p (point))))))
2206             (let ((headindent
2207                    (if (< (prolog-paren-balance) 0)
2208                        (save-excursion
2209                          (end-of-line)
2210                          (prolog-find-indent-of-matching-paren))
2211                      (prolog-indentation-level-of-line))))
2212               (setq ind (+ headindent prolog-indent-width))))
2213
2214            ;; The previous line was the head of an object
2215            ((looking-at ".+ *::.*{[ \t]*$")
2216             (setq ind prolog-indent-width))
2217
2218            ;; If a '.' is found at the end of the previous line, then
2219            ;; decrease the indentation. (The \\(%.*\\|\\) part of the
2220            ;; regexp is for comments at the end of the line)
2221            ((and (looking-at "^.+\\.[ \t]*\\(%.*\\|\\)$")
2222                  ;; Make sure that the '.' found is not in a comment or string
2223                  (save-excursion
2224                    (end-of-line)
2225                    (re-search-backward "\\.[ \t]*\\(%.*\\|\\)$" (point-min))
2226                    ;; Guard against the real '.' being followed by a
2227                    ;; commented '.'.
2228                    (if (eq (prolog-in-string-or-comment) 'cmt)
2229                        ;; commented out '.'
2230                        (let ((here (line-beginning-position)))
2231                          (end-of-line)
2232                          (re-search-backward "\\.[ \t]*%.*$" here t))
2233                      (not (prolog-in-string-or-comment))
2234                      )
2235                    ))
2236             (setq ind 0))
2237
2238            ;; If a '.' is found at the end of the previous line, then
2239            ;; decrease the indentation. (The /\\*.*\\*/ part of the
2240            ;; regexp is for C-like comments at the end of the
2241            ;; line--can we merge with the case above?).
2242            ((and (looking-at "^.+\\.[ \t]*\\(/\\*.*\\|\\)$")
2243                  ;; Make sure that the '.' found is not in a comment or string
2244                  (save-excursion
2245                    (end-of-line)
2246                    (re-search-backward "\\.[ \t]*\\(/\\*.*\\|\\)$" (point-min))
2247                    ;; Guard against the real '.' being followed by a
2248                    ;; commented '.'.
2249                    (if (eq (prolog-in-string-or-comment) 'cmt)
2250                        ;; commented out '.'
2251                        (let ((here (line-beginning-position)))
2252                          (end-of-line)
2253                          (re-search-backward "\\.[ \t]*/\\*.*$" here t))
2254                      (not (prolog-in-string-or-comment))
2255                      )
2256                    ))
2257             (setq ind 0))
2258
2259            )
2260
2261           ;; If the last non comment char is a ',' or left paren or a left-
2262           ;; indent-regexp then indent to open parenthesis level
2263           (if (and
2264                (> totbal 0)
2265                ;; SICStus objects have special syntax rules if point is
2266                ;; not inside additional parens (objects are defined
2267                ;; within {...})
2268                (not (and (eq prolog-system 'sicstus)
2269                          (= totbal 1)
2270                          (prolog-in-object))))
2271               (if (looking-at
2272                    (format "\\(%s\\|%s\\|0'.\\|[0-9]+'[0-9a-zA-Z]+\\|[^\n\'\"%%]\\)*\\(,\\|%s\\|%s\\)\[ \t]*\\(%%.*\\|\\)$"
2273                            prolog-quoted-atom-regexp prolog-string-regexp
2274                            prolog-left-paren prolog-left-indent-regexp))
2275                   (progn
2276                     (goto-char oldpoint)
2277                     (setq ind (prolog-find-unmatched-paren
2278                                (if prolog-paren-indent-p
2279                                    'termdependent
2280                                  'skipwhite)))
2281                     ;;(setq ind (prolog-find-unmatched-paren 'termdependent))
2282                     )
2283                 (goto-char oldpoint)
2284                 (setq ind (prolog-find-unmatched-paren nil))
2285                 ))
2286
2287
2288           ;; Return the indentation level
2289           ind
2290           ))))))
2291
2292 (defun prolog-find-indent-of-matching-paren ()
2293   "Find the indentation level based on the matching parenthesis.
2294 Indentation level is set to the one the point is after when the function is
2295 called."
2296   (save-excursion
2297     ;; Go to the matching paren
2298     (if prolog-use-prolog-tokenizer-flag
2299         (prolog-backward-list)
2300       (backward-list))
2301
2302     ;; If this was the first paren on the line then return this line's
2303     ;; indentation level
2304     (if (prolog-paren-is-the-first-on-line-p)
2305         (prolog-indentation-level-of-line)
2306       ;; It was not the first one
2307       (progn
2308          ;; Find the next paren
2309          (prolog-goto-next-paren 0)
2310
2311          ;; If this paren is a left one then use its column as indent level,
2312          ;; if not then recurse this function
2313          (if (looking-at prolog-left-paren)
2314              (+ (current-column) 1)
2315            (progn
2316               (forward-char 1)
2317               (prolog-find-indent-of-matching-paren)))
2318          ))
2319     ))
2320
2321 (defun prolog-indentation-level-of-line ()
2322   "Return the indentation level of the current line."
2323   (save-excursion
2324     (beginning-of-line)
2325     (skip-chars-forward " \t")
2326     (current-column)))
2327
2328 (defun prolog-paren-is-the-first-on-line-p ()
2329   "Return t if the parenthesis under the point is the first one on the line.
2330 Return nil otherwise.
2331 Note: does not check if the point is actually at a parenthesis!"
2332   (save-excursion
2333     (let ((begofline (line-beginning-position)))
2334       (if (= begofline (point))
2335           t
2336         (if (prolog-goto-next-paren begofline)
2337             nil
2338           t)))))
2339
2340 (defun prolog-find-unmatched-paren (&optional mode)
2341   "Return the column of the last unmatched left parenthesis.
2342 If MODE is `skipwhite' then any white space after the parenthesis is added to
2343 the answer.
2344 If MODE is `plusone' then the parenthesis' column +1 is returned.
2345 If MODE is `termdependent' then if the unmatched parenthesis is part of
2346 a compound term the function will work as `skipwhite', otherwise
2347 it will return the column paren plus the value of `prolog-paren-indent'.
2348 If MODE is nil or not set then the parenthesis' exact column is returned."
2349   (save-excursion
2350     ;; If the next paren we find is a left one we're finished, if it's
2351     ;; a right one then we go back one step and recurse
2352     (prolog-goto-next-paren 0)
2353
2354     (let ((roundparen (looking-at "(")))
2355       (if (looking-at prolog-left-paren)
2356           (let ((not-part-of-term
2357                  (save-excursion
2358                    (backward-char 1)
2359                    (looking-at "[ \t]"))))
2360             (if (eq mode nil)
2361                 (current-column)
2362               (if (and roundparen
2363                        (eq mode 'termdependent)
2364                        not-part-of-term)
2365                   (+ (current-column)
2366                      (if prolog-electric-tab-flag
2367                          ;; Electric TAB
2368                          prolog-paren-indent
2369                        ;; Not electric TAB
2370                        (if (looking-at ".[ \t]*$")
2371                            2
2372                          prolog-paren-indent))
2373                      )
2374
2375                 (forward-char 1)
2376                 (if (or (eq mode 'skipwhite) (eq mode 'termdependent) )
2377                     (skip-chars-forward " \t"))
2378                 (current-column))))
2379         ;; Not looking at left paren
2380         (progn
2381           (forward-char 1)
2382           ;; Go to the matching paren. When we get there we have a total
2383           ;; balance of 0.
2384           (if prolog-use-prolog-tokenizer-flag
2385               (prolog-backward-list)
2386             (backward-list))
2387           (prolog-find-unmatched-paren mode)))
2388       )))
2389
2390
2391 (defun prolog-paren-balance ()
2392   "Return the parenthesis balance of the current line.
2393 A return value of n means n more left parentheses than right ones."
2394   (save-excursion
2395     (end-of-line)
2396     (prolog-region-paren-balance (line-beginning-position) (point))))
2397
2398 (defun prolog-region-paren-balance (beg end)
2399   "Return the summed parenthesis balance in the region.
2400 The region is limited by BEG and END positions."
2401   (save-excursion
2402     (let ((state (if prolog-use-prolog-tokenizer-flag
2403                      (prolog-tokenize beg end)
2404                    (parse-partial-sexp beg end))))
2405       (nth 0 state))))
2406
2407 (defun prolog-goto-next-paren (limit-pos)
2408   "Move the point to the next parenthesis earlier in the buffer.
2409 Return t if a match was found before LIMIT-POS.  Return nil otherwise."
2410   (let ((retval (re-search-backward
2411                  (concat prolog-left-paren "\\|" prolog-right-paren)
2412                  limit-pos t)))
2413
2414     ;; If a match was found but it was in a string or comment, then recurse
2415     (if (and retval (prolog-in-string-or-comment))
2416         (prolog-goto-next-paren limit-pos)
2417       retval)
2418     ))
2419
2420 (defun prolog-in-string-or-comment ()
2421   "Check whether string, atom, or comment is under current point.
2422 Return:
2423  `txt' if the point is in a string, atom, or character code expression
2424  `cmt' if the point is in a comment
2425  nil otherwise."
2426   (save-excursion
2427     (let* ((start
2428             (if (eq prolog-parse-mode 'beg-of-line)
2429                 ;; 'beg-of-line
2430                 (save-excursion
2431                   (let (safepoint)
2432                     (beginning-of-line)
2433                     (setq safepoint (point))
2434                     (while (and (> (point) (point-min))
2435                                 (progn
2436                                   (forward-line -1)
2437                                   (end-of-line)
2438                                   (if (not (bobp))
2439                                       (backward-char 1))
2440                                   (looking-at "\\\\"))
2441                                 )
2442                       (beginning-of-line)
2443                       (setq safepoint (point)))
2444                     safepoint))
2445               ;; 'beg-of-clause
2446               (prolog-clause-start)))
2447            (end (point))
2448            (state (if prolog-use-prolog-tokenizer-flag
2449                       (prolog-tokenize start end)
2450                     (if (fboundp 'syntax-ppss)
2451                         (syntax-ppss)
2452                       (parse-partial-sexp start end)))))
2453       (cond
2454        ((nth 3 state) 'txt) ; String
2455        ((nth 4 state) 'cmt) ; Comment
2456        (t
2457         (cond
2458          ((looking-at "%") 'cmt) ; Start of a comment
2459          ((looking-at "/\\*") 'cmt) ; Start of a comment
2460          ((looking-at "\'") 'txt) ; Start of an atom
2461          ((looking-at "\"") 'txt) ; Start of a string
2462          (t nil)
2463          ))))
2464     ))
2465
2466 (defun prolog-find-start-of-mline-comment ()
2467   "Return the start column of a /* */ comment.
2468 This assumes that the point is inside a comment."
2469   (re-search-backward "/\\*" (point-min) t)
2470   (forward-char 2)
2471   (skip-chars-forward " \t")
2472   (current-column))
2473
2474 (defun prolog-insert-spaces-after-paren ()
2475   "Insert spaces after the opening parenthesis, \"then\" (->) and \"else\" (;) branches.
2476 Spaces are inserted if all preceding objects on the line are
2477 whitespace characters, parentheses, or then/else branches."
2478   (save-excursion
2479     (let ((regexp (concat "(\\|" prolog-left-indent-regexp))
2480           level)
2481       (beginning-of-line)
2482       (skip-chars-forward " \t")
2483       (when (looking-at regexp)
2484         ;; Treat "( If -> " lines specially.
2485         ;;(setq incr (if (looking-at "(.*->")
2486         ;;               2
2487         ;;             prolog-paren-indent))
2488
2489         ;; work on all subsequent "->", "(", ";"
2490         (while (looking-at regexp)
2491           (goto-char (match-end 0))
2492           (setq level (+ (prolog-find-unmatched-paren) prolog-paren-indent))
2493
2494           ;; Remove old white space
2495           (let ((start (point)))
2496             (skip-chars-forward " \t")
2497             (delete-region start (point)))
2498           (indent-to level)
2499           (skip-chars-forward " \t"))
2500         )))
2501   (when (save-excursion
2502           (backward-char 2)
2503           (looking-at "\\s ;\\|\\s (\\|->")) ; (looking-at "\\s \\((\\|;\\)"))
2504     (skip-chars-forward " \t"))
2505   )
2506
2507 ;;;; Comment filling
2508
2509 (defun prolog-comment-limits ()
2510   "Return the current comment limits plus the comment type (block or line).
2511 The comment limits are the range of a block comment or the range that
2512 contains all adjacent line comments (i.e. all comments that starts in
2513 the same column with no empty lines or non-whitespace characters
2514 between them)."
2515   (let ((here (point))
2516         lit-limits-b lit-limits-e lit-type beg end
2517         )
2518     (save-restriction
2519       ;; Widen to catch comment limits correctly.
2520       (widen)
2521       (setq end (line-end-position)
2522             beg (line-beginning-position))
2523       (save-excursion
2524         (beginning-of-line)
2525         (setq lit-type (if (search-forward-regexp "%" end t) 'line 'block))
2526                         ;    (setq lit-type 'line)
2527                         ;(if (search-forward-regexp "^[ \t]*%" end t)
2528                         ;    (setq lit-type 'line)
2529                         ;  (if (not (search-forward-regexp "%" end t))
2530                         ;      (setq lit-type 'block)
2531                         ;    (if (not (= (forward-line 1) 0))
2532                         ;        (setq lit-type 'block)
2533                         ;      (setq done t
2534                         ;            ret (prolog-comment-limits)))
2535                         ;    ))
2536         (if (eq lit-type 'block)
2537             (progn
2538               (goto-char here)
2539               (when (looking-at "/\\*") (forward-char 2))
2540               (when (and (looking-at "\\*") (> (point) (point-min))
2541                          (forward-char -1) (looking-at "/"))
2542                 (forward-char 1))
2543               (when (save-excursion (search-backward "/*" nil t))
2544                 (list (save-excursion (search-backward "/*") (point))
2545                       (or (search-forward "*/" nil t) (point-max)) lit-type)))
2546           ;; line comment
2547           (setq lit-limits-b (- (point) 1)
2548                 lit-limits-e end)
2549           (condition-case nil
2550               (if (progn (goto-char lit-limits-b)
2551                          (looking-at "%"))
2552                   (let ((col (current-column)) done)
2553                     (setq beg (point)
2554                           end lit-limits-e)
2555                     ;; Always at the beginning of the comment
2556                     ;; Go backward now
2557                     (beginning-of-line)
2558                     (while (and (zerop (setq done (forward-line -1)))
2559                                 (search-forward-regexp "^[ \t]*%"
2560                                                        (line-end-position) t)
2561                                 (= (+ 1 col) (current-column)))
2562                       (setq beg (- (point) 1)))
2563                     (when (= done 0)
2564                       (forward-line 1))
2565                     ;; We may have a line with code above...
2566                     (when (and (zerop (setq done (forward-line -1)))
2567                                (search-forward "%" (line-end-position) t)
2568                                (= (+ 1 col) (current-column)))
2569                       (setq beg (- (point) 1)))
2570                     (when (= done 0)
2571                       (forward-line 1))
2572                     ;; Go forward
2573                     (goto-char lit-limits-b)
2574                     (beginning-of-line)
2575                     (while (and (zerop (forward-line 1))
2576                                 (search-forward-regexp "^[ \t]*%"
2577                                                        (line-end-position) t)
2578                                 (= (+ 1 col) (current-column)))
2579                       (setq end (line-end-position)))
2580                     (list beg end lit-type))
2581                 (list lit-limits-b lit-limits-e lit-type)
2582                 )
2583             (error (list lit-limits-b lit-limits-e lit-type))))
2584         ))))
2585
2586 (defun prolog-guess-fill-prefix ()
2587   ;; fill 'txt entities?
2588   (when (save-excursion
2589           (end-of-line)
2590           (equal (prolog-in-string-or-comment) 'cmt))
2591     (let* ((bounds (prolog-comment-limits))
2592            (cbeg (car bounds))
2593            (type (nth 2 bounds))
2594            beg end)
2595       (save-excursion
2596         (end-of-line)
2597         (setq end (point))
2598         (beginning-of-line)
2599         (setq beg (point))
2600         (if (and (eq type 'line)
2601                  (> cbeg beg)
2602                  (save-excursion (not (search-forward-regexp "^[ \t]*%"
2603                                                              cbeg t))))
2604             (progn
2605               (goto-char cbeg)
2606               (search-forward-regexp "%+[ \t]*" end t)
2607               (prolog-replace-in-string (buffer-substring beg (point))
2608                                         "[^ \t%]" " "))
2609           ;(goto-char beg)
2610           (if (search-forward-regexp "^[ \t]*\\(%+\\|\\*+\\|/\\*+\\)[ \t]*"
2611                                      end t)
2612               (prolog-replace-in-string (buffer-substring beg (point)) "/" " ")
2613             (beginning-of-line)
2614             (when (search-forward-regexp "^[ \t]+" end t)
2615               (buffer-substring beg (point)))))))))
2616
2617 (defun prolog-fill-paragraph ()
2618   "Fill paragraph comment at or after point."
2619   (interactive)
2620   (let* ((bounds (prolog-comment-limits))
2621          (type (nth 2 bounds)))
2622     (if (eq type 'line)
2623         (let ((fill-prefix (prolog-guess-fill-prefix)))
2624           (fill-paragraph nil))
2625       (save-excursion
2626         (save-restriction
2627           ;; exclude surrounding lines that delimit a multiline comment
2628           ;; and don't contain alphabetic characters, like "/*******",
2629           ;; "- - - */" etc.
2630           (save-excursion
2631             (backward-paragraph)
2632             (unless (bobp) (forward-line))
2633             (if (string-match "^/\\*[^a-zA-Z]*$" (thing-at-point 'line))
2634                 (narrow-to-region (point-at-eol) (point-max))))
2635           (save-excursion
2636             (forward-paragraph)
2637             (forward-line -1)
2638             (if (string-match "^[^a-zA-Z]*\\*/$" (thing-at-point 'line))
2639                 (narrow-to-region (point-min) (point-at-bol))))
2640           (let ((fill-prefix (prolog-guess-fill-prefix)))
2641             (fill-paragraph nil))))
2642       )))
2643
2644 (defun prolog-do-auto-fill ()
2645   "Carry out Auto Fill for Prolog mode.
2646 In effect it sets the `fill-prefix' when inside comments and then calls
2647 `do-auto-fill'."
2648   (let ((fill-prefix (prolog-guess-fill-prefix)))
2649     (do-auto-fill)
2650     ))
2651
2652 (defalias 'prolog-replace-in-string
2653   (if (fboundp 'replace-in-string)
2654       #'replace-in-string
2655     (lambda (str regexp newtext &optional literal)
2656       (replace-regexp-in-string regexp newtext str nil literal))))
2657 \f
2658 ;;-------------------------------------------------------------------
2659 ;; The tokenizer
2660 ;;-------------------------------------------------------------------
2661
2662 (defconst prolog-tokenize-searchkey
2663   (concat "[0-9]+'"
2664           "\\|"
2665           "['\"]"
2666           "\\|"
2667           prolog-left-paren
2668           "\\|"
2669           prolog-right-paren
2670           "\\|"
2671           "%"
2672           "\\|"
2673           "/\\*"
2674           ))
2675
2676 (defun prolog-tokenize (beg end &optional stopcond)
2677   "Tokenize a region of prolog code between BEG and END.
2678 STOPCOND decides the stop condition of the parsing.  Valid values
2679 are 'zerodepth which stops the parsing at the first right parenthesis
2680 where the parenthesis depth is zero, 'skipover which skips over
2681 the current entity (e.g. a list, a string, etc.) and nil.
2682
2683 The function returns a list with the following information:
2684  0. parenthesis depth
2685  3. 'atm if END is inside an atom
2686     'str if END is inside a string
2687     'chr if END is in a character code expression (0'x)
2688     nil otherwise
2689  4. non-nil if END is inside a comment
2690  5. end position (always equal to END if STOPCOND is nil)
2691 The rest of the elements are undefined."
2692   (save-excursion
2693     (let* ((end2 (1+ end))
2694            oldp
2695            (depth 0)
2696            (quoted nil)
2697            inside_cmt
2698            (endpos end2)
2699            skiptype ; The type of entity we'll skip over
2700            )
2701       (goto-char beg)
2702
2703       (if (and (eq stopcond 'skipover)
2704                (looking-at "[^[({'\"]"))
2705           (setq endpos (point))                ; Stay where we are
2706         (while (and
2707                 (re-search-forward prolog-tokenize-searchkey end2 t)
2708                 (< (point) end2))
2709           (progn
2710             (setq oldp (point))
2711             (goto-char (match-beginning 0))
2712             (cond
2713              ;; Atoms and strings
2714              ((looking-at "'")
2715               ;; Find end of atom
2716               (if (re-search-forward "[^\\]'" end2 'limit)
2717                   ;; Found end of atom
2718                   (progn
2719                     (setq oldp end2)
2720                     (if (and (eq stopcond 'skipover)
2721                              (not skiptype))
2722                         (setq endpos (point))
2723                       (setq oldp (point)))) ; Continue tokenizing
2724                 (setq quoted 'atm)))
2725
2726              ((looking-at "\"")
2727               ;; Find end of string
2728               (if (re-search-forward "[^\\]\"" end2 'limit)
2729                   ;; Found end of string
2730                   (progn
2731                     (setq oldp end2)
2732                     (if (and (eq stopcond 'skipover)
2733                              (not skiptype))
2734                         (setq endpos (point))
2735                       (setq oldp (point)))) ; Continue tokenizing
2736                 (setq quoted 'str)))
2737
2738              ;; Paren stuff
2739              ((looking-at prolog-left-paren)
2740               (setq depth (1+ depth))
2741               (setq skiptype 'paren))
2742
2743              ((looking-at prolog-right-paren)
2744               (setq depth (1- depth))
2745               (if (and
2746                    (or (eq stopcond 'zerodepth)
2747                        (and (eq stopcond 'skipover)
2748                             (eq skiptype 'paren)))
2749                    (= depth 0))
2750                   (progn
2751                     (setq endpos (1+ (point)))
2752                     (setq oldp end2))))
2753
2754              ;; Comment stuff
2755              ((looking-at comment-start)
2756               (end-of-line)
2757               ;; (if (>= (point) end2)
2758               (if (>= (point) end)
2759                   (progn
2760                     (setq inside_cmt t)
2761                     (setq oldp end2))
2762                 (setq oldp (point))))
2763
2764              ((looking-at "/\\*")
2765               (if (re-search-forward "\\*/" end2 'limit)
2766                   (setq oldp (point))
2767                 (setq inside_cmt t)
2768                 (setq oldp end2)))
2769
2770              ;; 0'char
2771              ((looking-at "0'")
2772               (setq oldp (1+ (match-end 0)))
2773               (if (> oldp end)
2774                   (setq quoted 'chr)))
2775
2776              ;; base'number
2777              ((looking-at "[0-9]+'")
2778               (goto-char (match-end 0))
2779               (skip-chars-forward "0-9a-zA-Z")
2780               (setq oldp (point)))
2781
2782
2783              )
2784             (goto-char oldp)
2785             ))                                ; End of while
2786         )
2787
2788       ;; Deal with multi-line comments
2789       (and (prolog-inside-mline-comment end)
2790            (setq inside_cmt t))
2791
2792       ;; Create return list
2793       (list depth nil nil quoted inside_cmt endpos)
2794       )))
2795
2796 (defun prolog-inside-mline-comment (here)
2797   (save-excursion
2798     (goto-char here)
2799     (let* ((next-close (save-excursion (search-forward "*/" nil t)))
2800            (next-open  (save-excursion (search-forward "/*" nil t)))
2801            (prev-open  (save-excursion (search-backward "/*" nil t)))
2802            (prev-close (save-excursion (search-backward "*/" nil t)))
2803            (unmatched-next-close (and next-close
2804                                       (or (not next-open)
2805                                           (> next-open next-close))))
2806            (unmatched-prev-open  (and prev-open
2807                                       (or (not prev-close)
2808                                           (> prev-open prev-close))))
2809            )
2810       (or unmatched-next-close unmatched-prev-open)
2811       )))
2812
2813 \f
2814 ;;-------------------------------------------------------------------
2815 ;; Online help
2816 ;;-------------------------------------------------------------------
2817
2818 (defvar prolog-help-function
2819   '((mercury nil)
2820     (eclipse prolog-help-online)
2821     ;; (sicstus prolog-help-info)
2822     (sicstus prolog-find-documentation)
2823     (swi prolog-help-online)
2824     (t prolog-help-online))
2825   "Alist for the name of the function for finding help on a predicate.")
2826
2827 (defun prolog-help-on-predicate ()
2828   "Invoke online help on the atom under cursor."
2829   (interactive)
2830
2831   (cond
2832    ;; Redirect help for SICStus to `prolog-find-documentation'.
2833    ((eq prolog-help-function-i 'prolog-find-documentation)
2834     (prolog-find-documentation))
2835
2836    ;; Otherwise, ask for the predicate name and then call the function
2837    ;; in prolog-help-function-i
2838    (t
2839     (let* ((word (prolog-atom-under-point))
2840            (predicate (read-string
2841                        (format "Help on predicate%s: "
2842                                (if word
2843                                    (concat " (default " word ")")
2844                                  ""))
2845                        nil nil word))
2846            ;;point
2847            )
2848       (if prolog-help-function-i
2849           (funcall prolog-help-function-i predicate)
2850         (error "Sorry, no help method defined for this Prolog system."))))
2851    ))
2852
2853 (defun prolog-help-info (predicate)
2854   (let ((buffer (current-buffer))
2855         oldp
2856         (str (concat "^\\* " (regexp-quote predicate) " */")))
2857     (require 'info)
2858     (pop-to-buffer nil)
2859     (Info-goto-node prolog-info-predicate-index)
2860     (if (not (re-search-forward str nil t))
2861         (error (format "Help on predicate `%s' not found." predicate)))
2862
2863     (setq oldp (point))
2864     (if (re-search-forward str nil t)
2865         ;; Multiple matches, ask user
2866         (let ((max 2)
2867               n)
2868           ;; Count matches
2869           (while (re-search-forward str nil t)
2870             (setq max (1+ max)))
2871
2872           (goto-char oldp)
2873           (re-search-backward "[^ /]" nil t)
2874           (recenter 0)
2875           (setq n (read-string  ;; was read-input, which is obsolete
2876                    (format "Several matches, choose (1-%d): " max) "1"))
2877           (forward-line (- (string-to-number n) 1)))
2878       ;; Single match
2879       (re-search-backward "[^ /]" nil t))
2880
2881     ;; (Info-follow-nearest-node (point))
2882     (prolog-Info-follow-nearest-node)
2883     (re-search-forward (concat "^`" (regexp-quote predicate)) nil t)
2884     (beginning-of-line)
2885     (recenter 0)
2886     (pop-to-buffer buffer)))
2887
2888 (defun prolog-Info-follow-nearest-node ()
2889   (if (featurep 'xemacs)
2890       (Info-follow-nearest-node (point))
2891     (Info-follow-nearest-node)))
2892
2893 (defun prolog-help-online (predicate)
2894   (prolog-ensure-process)
2895   (process-send-string "prolog" (concat "help(" predicate ").\n"))
2896   (display-buffer "*prolog*"))
2897
2898 (defun prolog-help-apropos (string)
2899   "Find Prolog apropos on given STRING.
2900 This function is only available when `prolog-system' is set to `swi'."
2901   (interactive "sApropos: ")
2902   (cond
2903    ((eq prolog-system 'swi)
2904     (prolog-ensure-process)
2905     (process-send-string "prolog" (concat "apropos(" string ").\n"))
2906     (display-buffer "*prolog*"))
2907    (t
2908     (error "Sorry, no Prolog apropos available for this Prolog system."))))
2909
2910 (defun prolog-atom-under-point ()
2911   "Return the atom under or left to the point."
2912   (save-excursion
2913     (let ((nonatom_chars "[](){},\. \t\n")
2914           start)
2915       (skip-chars-forward (concat "^" nonatom_chars))
2916       (skip-chars-backward nonatom_chars)
2917       (skip-chars-backward (concat "^" nonatom_chars))
2918       (setq start (point))
2919       (skip-chars-forward (concat "^" nonatom_chars))
2920       (buffer-substring-no-properties start (point))
2921       )))
2922
2923 \f
2924 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2925 ;; Help function with completion
2926 ;; Stolen from Per Mildner's SICStus debugger mode and modified
2927
2928 (defun prolog-find-documentation ()
2929   "Go to the Info node for a predicate in the SICStus Info manual."
2930   (interactive)
2931   (let ((pred (prolog-read-predicate)))
2932     (prolog-goto-predicate-info pred)))
2933
2934 (defvar prolog-info-alist nil
2935   "Alist with all builtin predicates.
2936 Only for internal use by `prolog-find-documentation'")
2937
2938 ;; Very similar to prolog-help-info except that that function cannot
2939 ;; cope with arity and that it asks the user if there are several
2940 ;; functors with different arity. This function also uses
2941 ;; prolog-info-alist for finding the info node, rather than parsing
2942 ;; the predicate index.
2943 (defun prolog-goto-predicate-info (predicate)
2944   "Go to the info page for PREDICATE, which is a PredSpec."
2945   (interactive)
2946   (require 'info)
2947   (string-match "\\(.*\\)/\\([0-9]+\\).*$" predicate)
2948   (let ((buffer (current-buffer))
2949         (name (match-string 1 predicate))
2950         (arity (string-to-number (match-string 2 predicate)))
2951         ;oldp
2952         ;(str (regexp-quote predicate))
2953         )
2954     (pop-to-buffer nil)
2955
2956     (Info-goto-node
2957      prolog-info-predicate-index) ;; We must be in the SICStus pages
2958     (Info-goto-node (car (cdr (assoc predicate prolog-info-alist))))
2959
2960     (prolog-find-term (regexp-quote name) arity "^`")
2961
2962     (recenter 0)
2963     (pop-to-buffer buffer))
2964 )
2965
2966 (defun prolog-read-predicate ()
2967   "Read a PredSpec from the user.
2968 Returned value is a string \"FUNCTOR/ARITY\".
2969 Interaction supports completion."
2970   (let ((default (prolog-atom-under-point)))
2971     ;; If the predicate index is not yet built, do it now
2972     (if (not prolog-info-alist)
2973         (prolog-build-info-alist))
2974     ;; Test if the default string could be the base for completion.
2975     ;; Discard it if not.
2976     (if (eq (try-completion default prolog-info-alist) nil)
2977         (setq default nil))
2978     ;; Read the PredSpec from the user
2979     (completing-read
2980      (if (zerop (length default))
2981          "Help on predicate: "
2982        (concat "Help on predicate (default " default "): "))
2983      prolog-info-alist nil t nil nil default)))
2984
2985 (defun prolog-build-info-alist (&optional verbose)
2986   "Build an alist of all builtins and library predicates.
2987 Each element is of the form (\"NAME/ARITY\" . (INFO-NODE1 INFO-NODE2 ...)).
2988 Typically there is just one Info node associated with each name
2989 If an optional argument VERBOSE is non-nil, print messages at the beginning
2990 and end of list building."
2991   (if verbose
2992       (message "Building info alist..."))
2993   (setq prolog-info-alist
2994         (let ((l ())
2995               (last-entry (cons "" ())))
2996           (save-excursion
2997             (save-window-excursion
2998               ;; select any window but the minibuffer (as we cannot switch
2999               ;; buffers in minibuffer window.
3000               ;; I am not sure this is the right/best way
3001               (if (active-minibuffer-window)  ; nil if none active
3002                   (select-window (next-window)))
3003               ;; Do this after going away from minibuffer window
3004               (save-window-excursion
3005                 (info))
3006               (Info-goto-node prolog-info-predicate-index)
3007               (goto-char (point-min))
3008               (while (re-search-forward
3009                       "^\\* \\(.+\\)/\\([0-9]+\\)\\([^\n:*]*\\):" nil t)
3010                 (let* ((name (match-string 1))
3011                        (arity (string-to-number (match-string 2)))
3012                        (comment (match-string 3))
3013                        (fa (format "%s/%d%s" name arity comment))
3014                        info-node)
3015                   (beginning-of-line)
3016                   ;; Extract the info node name
3017                   (setq info-node (progn
3018                                     (re-search-forward ":[ \t]*\\([^:]+\\).$")
3019                                     (match-string 1)
3020                                    ))
3021                   ;; ###### Easier? (from Milan version 0.1.28)
3022                   ;; (setq info-node (Info-extract-menu-node-name))
3023                   (if (equal fa (car last-entry))
3024                       (setcdr last-entry (cons info-node (cdr last-entry)))
3025                     (setq last-entry (cons fa (list info-node))
3026                           l (cons last-entry l)))))
3027               (nreverse l)
3028               ))))
3029   (if verbose
3030       (message "Building info alist... done.")))
3031
3032 \f
3033 ;;-------------------------------------------------------------------
3034 ;; Miscellaneous functions
3035 ;;-------------------------------------------------------------------
3036
3037 ;; For Windows. Change backslash to slash. SICStus handles either
3038 ;; path separator but backslash must be doubled, therefore use slash.
3039 (defun prolog-bsts (string)
3040   "Change backslashes to slashes in STRING."
3041   (let ((str1 (copy-sequence string))
3042         (len (length string))
3043         (i 0))
3044     (while (< i len)
3045       (if (char-equal (aref str1 i) ?\\)
3046           (aset str1 i ?/))
3047       (setq i (1+ i)))
3048     str1))
3049
3050 ;;(defun prolog-temporary-file ()
3051 ;;  "Make temporary file name for compilation."
3052 ;;  (make-temp-name
3053 ;;   (concat
3054 ;;    (or
3055 ;;     (getenv "TMPDIR")
3056 ;;     (getenv "TEMP")
3057 ;;     (getenv "TMP")
3058 ;;     (getenv "SYSTEMP")
3059 ;;     "/tmp")
3060 ;;    "/prolcomp")))
3061 ;;(setq prolog-temp-filename (prolog-bsts (prolog-temporary-file)))
3062
3063 (defun prolog-temporary-file ()
3064   "Make temporary file name for compilation."
3065   (if prolog-temporary-file-name
3066       ;; We already have a file, erase content and continue
3067       (progn
3068         (write-region "" nil prolog-temporary-file-name nil 'silent)
3069         prolog-temporary-file-name)
3070     ;; Actually create the file and set `prolog-temporary-file-name'
3071     ;; accordingly.
3072     (setq prolog-temporary-file-name
3073           (make-temp-file "prolcomp" nil ".pl"))))
3074
3075 (defun prolog-goto-prolog-process-buffer ()
3076   "Switch to the prolog process buffer and go to its end."
3077   (switch-to-buffer-other-window "*prolog*")
3078   (goto-char (point-max))
3079 )
3080
3081 (defun prolog-enable-sicstus-sd ()
3082   "Enable the source level debugging facilities of SICStus 3.7 and later."
3083   (interactive)
3084   (require 'pltrace)  ; Load the SICStus debugger code
3085   ;; Turn on the source level debugging by default
3086   (add-hook 'prolog-inferior-mode-hook 'pltrace-on)
3087   (if (not prolog-use-sicstus-sd)
3088       (progn
3089         ;; If there is a *prolog* buffer, then call pltrace-on
3090         (if (get-buffer "*prolog*")
3091             ;; Avoid compilation warnings by using eval
3092             (eval '(pltrace-on)))
3093         (setq prolog-use-sicstus-sd t)
3094         )))
3095
3096 (defun prolog-disable-sicstus-sd ()
3097   "Disable the source level debugging facilities of SICStus 3.7 and later."
3098   (interactive)
3099   (setq prolog-use-sicstus-sd nil)
3100   ;; Remove the hook
3101   (remove-hook 'prolog-inferior-mode-hook 'pltrace-on)
3102   ;; If there is a *prolog* buffer, then call pltrace-off
3103   (if (get-buffer "*prolog*")
3104       ;; Avoid compile warnings by using eval
3105       (eval '(pltrace-off))))
3106
3107 (defun prolog-toggle-sicstus-sd ()
3108   ;; FIXME: Use define-minor-mode.
3109   "Toggle the source level debugging facilities of SICStus 3.7 and later."
3110   (interactive)
3111   (if prolog-use-sicstus-sd
3112       (prolog-disable-sicstus-sd)
3113     (prolog-enable-sicstus-sd)))
3114
3115 (defun prolog-debug-on (&optional arg)
3116   "Enable debugging.
3117 When called with prefix argument ARG, disable debugging instead."
3118   (interactive "P")
3119   (if arg
3120       (prolog-debug-off)
3121     (prolog-process-insert-string (get-process "prolog")
3122                                   prolog-debug-on-string)
3123     (process-send-string "prolog" prolog-debug-on-string)))
3124
3125 (defun prolog-debug-off ()
3126   "Disable debugging."
3127   (interactive)
3128   (prolog-process-insert-string (get-process "prolog")
3129                                 prolog-debug-off-string)
3130   (process-send-string "prolog" prolog-debug-off-string))
3131
3132 (defun prolog-trace-on (&optional arg)
3133   "Enable tracing.
3134 When called with prefix argument ARG, disable tracing instead."
3135   (interactive "P")
3136   (if arg
3137       (prolog-trace-off)
3138     (prolog-process-insert-string (get-process "prolog")
3139                                   prolog-trace-on-string)
3140     (process-send-string "prolog" prolog-trace-on-string)))
3141
3142 (defun prolog-trace-off ()
3143   "Disable tracing."
3144   (interactive)
3145   (prolog-process-insert-string (get-process "prolog")
3146                                 prolog-trace-off-string)
3147   (process-send-string "prolog" prolog-trace-off-string))
3148
3149 (defun prolog-zip-on (&optional arg)
3150   "Enable zipping (for SICStus 3.7 and later).
3151 When called with prefix argument ARG, disable zipping instead."
3152   (interactive "P")
3153   (if (not (and (eq prolog-system 'sicstus)
3154                 (prolog-atleast-version '(3 . 7))))
3155       (error "Only works for SICStus 3.7 and later"))
3156   (if arg
3157       (prolog-zip-off)
3158     (prolog-process-insert-string (get-process "prolog")
3159                                   prolog-zip-on-string)
3160     (process-send-string "prolog" prolog-zip-on-string)))
3161
3162 (defun prolog-zip-off ()
3163   "Disable zipping (for SICStus 3.7 and later)."
3164   (interactive)
3165   (prolog-process-insert-string (get-process "prolog")
3166                                 prolog-zip-off-string)
3167   (process-send-string "prolog" prolog-zip-off-string))
3168
3169 ;; (defun prolog-create-predicate-index ()
3170 ;;   "Create an index for all predicates in the buffer."
3171 ;;   (let ((predlist '())
3172 ;;         clauseinfo
3173 ;;         object
3174 ;;         pos
3175 ;;         )
3176 ;;     (goto-char (point-min))
3177 ;;     ;; Replace with prolog-clause-start!
3178 ;;     (while (re-search-forward "^.+:-" nil t)
3179 ;;       (setq pos (match-beginning 0))
3180 ;;       (setq clauseinfo (prolog-clause-info))
3181 ;;       (setq object (prolog-in-object))
3182 ;;       (setq predlist (append
3183 ;;                       predlist
3184 ;;                       (list (cons
3185 ;;                              (if (and (eq prolog-system 'sicstus)
3186 ;;                                       (prolog-in-object))
3187 ;;                                  (format "%s::%s/%d"
3188 ;;                                          object
3189 ;;                                          (nth 0 clauseinfo)
3190 ;;                                          (nth 1 clauseinfo))
3191 ;;                                (format "%s/%d"
3192 ;;                                        (nth 0 clauseinfo)
3193 ;;                                        (nth 1 clauseinfo)))
3194 ;;                              pos
3195 ;;                              ))))
3196 ;;       (prolog-end-of-predicate))
3197 ;;     predlist))
3198
3199 (defun prolog-get-predspec ()
3200   (save-excursion
3201     (let ((state (prolog-clause-info))
3202           (object (prolog-in-object)))
3203       (if (or (equal (nth 0 state) "") (equal (prolog-in-string-or-comment) 'cmt))
3204           nil
3205         (if (and (eq prolog-system 'sicstus)
3206                  object)
3207             (format "%s::%s/%d"
3208                     object
3209                     (nth 0 state)
3210                     (nth 1 state))
3211           (format "%s/%d"
3212                   (nth 0 state)
3213                   (nth 1 state)))
3214         ))))
3215
3216 ;; For backward compatibility. Stolen from custom.el.
3217 (or (fboundp 'match-string)
3218     ;; Introduced in Emacs 19.29.
3219     (defun match-string (num &optional string)
3220   "Return string of text matched by last search.
3221 NUM specifies which parenthesized expression in the last regexp.
3222  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
3223 Zero means the entire text matched by the whole regexp or whole string.
3224 STRING should be given if the last search was by `string-match' on STRING."
3225   (if (match-beginning num)
3226       (if string
3227           (substring string (match-beginning num) (match-end num))
3228         (buffer-substring (match-beginning num) (match-end num))))))
3229
3230 (defun prolog-pred-start ()
3231   "Return the starting point of the first clause of the current predicate."
3232   (save-excursion
3233     (goto-char (prolog-clause-start))
3234     ;; Find first clause, unless it was a directive
3235     (if (and (not (looking-at "[:?]-"))
3236              (not (looking-at "[ \t]*[%/]"))  ; Comment
3237
3238              )
3239         (let* ((pinfo (prolog-clause-info))
3240                (predname (nth 0 pinfo))
3241                (arity (nth 1 pinfo))
3242                (op (point)))
3243           (while (and (re-search-backward
3244                        (format "^%s\\([(\\.]\\| *%s\\)"
3245                                predname prolog-head-delimiter) nil t)
3246                       (= arity (nth 1 (prolog-clause-info)))
3247                       )
3248             (setq op (point)))
3249           (if (eq prolog-system 'mercury)
3250               ;; Skip to the beginning of declarations of the predicate
3251               (progn
3252                 (goto-char (prolog-beginning-of-clause))
3253                 (while (and (not (eq (point) op))
3254                             (looking-at
3255                              (format ":-[ \t]*\\(pred\\|mode\\)[ \t]+%s"
3256                                      predname)))
3257                   (setq op (point))
3258                   (goto-char (prolog-beginning-of-clause)))))
3259           op)
3260       (point))))
3261
3262 (defun prolog-pred-end ()
3263   "Return the position at the end of the last clause of the current predicate."
3264   (save-excursion
3265     (goto-char (prolog-clause-end))        ; if we are before the first predicate
3266     (goto-char (prolog-clause-start))
3267     (let* ((pinfo (prolog-clause-info))
3268           (predname (nth 0 pinfo))
3269           (arity (nth 1 pinfo))
3270           oldp
3271           (notdone t)
3272           (op (point)))
3273       (if (looking-at "[:?]-")
3274           ;; This was a directive
3275           (progn
3276             (if (and (eq prolog-system 'mercury)
3277                      (looking-at
3278                       (format ":-[ \t]*\\(pred\\|mode\\)[ \t]+\\(%s+\\)"
3279                               prolog-atom-regexp)))
3280                 ;; Skip predicate declarations
3281                 (progn
3282                   (setq predname (buffer-substring-no-properties
3283                                   (match-beginning 2) (match-end 2)))
3284                   (while (re-search-forward
3285                           (format
3286                            "\n*\\(:-[ \t]*\\(pred\\|mode\\)[ \t]+\\)?%s[( \t]"
3287                            predname)
3288                           nil t))))
3289             (goto-char (prolog-clause-end))
3290             (setq op (point)))
3291         ;; It was not a directive, find the last clause
3292         (while (and notdone
3293                     (re-search-forward
3294                      (format "^%s\\([(\\.]\\| *%s\\)"
3295                              predname prolog-head-delimiter) nil t)
3296                     (= arity (nth 1 (prolog-clause-info))))
3297           (setq oldp (point))
3298           (setq op (prolog-clause-end))
3299           (if (>= oldp op)
3300               ;; End of clause not found.
3301               (setq notdone nil)
3302             ;; Continue while loop
3303             (goto-char op))))
3304       op)))
3305
3306 (defun prolog-clause-start (&optional not-allow-methods)
3307   "Return the position at the start of the head of the current clause.
3308 If NOTALLOWMETHODS is non-nil then do not match on methods in
3309 objects (relevant only if 'prolog-system' is set to 'sicstus)."
3310   (save-excursion
3311     (let ((notdone t)
3312           (retval (point-min)))
3313       (end-of-line)
3314
3315       ;; SICStus object?
3316       (if (and (not not-allow-methods)
3317                (eq prolog-system 'sicstus)
3318                (prolog-in-object))
3319           (while (and
3320                   notdone
3321                   ;; Search for a head or a fact
3322                   (re-search-backward
3323                    ;; If in object, then find method start.
3324                    ;; "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\|,\\)"
3325                    "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\)" ; The comma causes
3326                                         ; problems since we cannot assume
3327                                         ; that the line starts at column 0,
3328                                         ; thus we don't know if the line
3329                                         ; is a head or a subgoal
3330                    (point-min) t))
3331             (if (>= (prolog-paren-balance) 0) ; To no match on "   a) :-"
3332                 ;; Start of method found
3333                 (progn
3334                   (setq retval (point))
3335                   (setq notdone nil)))
3336             )                                ; End of while
3337
3338         ;; Not in object
3339         (while (and
3340                 notdone
3341                 ;; Search for a text at beginning of a line
3342                 ;; ######
3343                 ;; (re-search-backward "^[a-z$']" nil t))
3344                 (let ((case-fold-search nil))
3345                   (re-search-backward
3346                    ;; (format "^[%s$']" prolog-lower-case-string)
3347                    ;; FIXME: Use [:lower:]
3348                    (format "^\\([%s$']\\|[:?]-\\)" prolog-lower-case-string)
3349                    nil t)))
3350           (let ((bal (prolog-paren-balance)))
3351             (cond
3352              ((> bal 0)
3353               ;; Start of clause found
3354               (progn
3355                 (setq retval (point))
3356                 (setq notdone nil)))
3357              ((and (= bal 0)
3358                    (looking-at
3359                     (format ".*\\(\\.\\|%s\\|!,\\)[ \t]*\\(%%.*\\|\\)$"
3360                             prolog-head-delimiter)))
3361               ;; Start of clause found if the line ends with a '.' or
3362               ;; a prolog-head-delimiter
3363               (progn
3364                 (setq retval (point))
3365                 (setq notdone nil))
3366               )
3367              (t nil) ; Do nothing
3368              ))))
3369
3370         retval)))
3371
3372 (defun prolog-clause-end (&optional not-allow-methods)
3373   "Return the position at the end of the current clause.
3374 If NOTALLOWMETHODS is non-nil then do not match on methods in
3375 objects (relevant only if 'prolog-system' is set to 'sicstus)."
3376   (save-excursion
3377     (beginning-of-line) ; Necessary since we use "^...." for the search.
3378     (if (re-search-forward
3379          (if (and (not not-allow-methods)
3380                   (eq prolog-system 'sicstus)
3381                   (prolog-in-object))
3382              (format
3383               "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*&[ \t]*\\(\\|%%.*\\)$\\|[ \t]*}"
3384               prolog-quoted-atom-regexp prolog-string-regexp)
3385            (format
3386             "^\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\.[ \t]*\\(\\|%%.*\\)$"
3387             prolog-quoted-atom-regexp prolog-string-regexp))
3388          nil t)
3389         (if (and (prolog-in-string-or-comment)
3390                  (not (eobp)))
3391             (progn
3392               (forward-char)
3393               (prolog-clause-end))
3394           (point))
3395       (point))))
3396
3397 (defun prolog-clause-info ()
3398   "Return a (name arity) list for the current clause."
3399   (save-excursion
3400     (goto-char (prolog-clause-start))
3401     (let* ((op (point))
3402            (predname
3403             (if (looking-at prolog-atom-char-regexp)
3404                 (progn
3405                   (skip-chars-forward "^ (\\.")
3406                   (buffer-substring op (point)))
3407               ""))
3408            (arity 0))
3409       ;; Retrieve the arity.
3410       (if (looking-at prolog-left-paren)
3411           (let ((endp (save-excursion
3412                         (prolog-forward-list) (point))))
3413             (setq arity 1)
3414             (forward-char 1)            ; Skip the opening paren.
3415             (while (progn
3416                      (skip-chars-forward "^[({,'\"")
3417                      (< (point) endp))
3418               (if (looking-at ",")
3419                   (progn
3420                     (setq arity (1+ arity))
3421                     (forward-char 1)    ; Skip the comma.
3422                     )
3423                 ;; We found a string, list or something else we want
3424                 ;; to skip over. Always use prolog-tokenize,
3425                 ;; parse-partial-sexp does not have a 'skipover mode.
3426                 (goto-char (nth 5 (prolog-tokenize (point) endp 'skipover))))
3427               )))
3428       (list predname arity))))
3429
3430 (defun prolog-in-object ()
3431   "Return object name if the point is inside a SICStus object definition."
3432   ;; Return object name if the last line that starts with a character
3433   ;; that is neither white space nor a comment start
3434   (save-excursion
3435     (if (save-excursion
3436           (beginning-of-line)
3437           (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{"))
3438         ;; We were in the head of the object
3439         (match-string 1)
3440       ;; We were not in the head
3441       (if (and (re-search-backward "^[a-z$'}]" nil t)
3442                (looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{"))
3443           (match-string 1)
3444         nil))))
3445
3446 (defun prolog-forward-list ()
3447   "Move the point to the matching right parenthesis."
3448   (interactive)
3449   (if prolog-use-prolog-tokenizer-flag
3450       (let ((state (prolog-tokenize (point) (point-max) 'zerodepth)))
3451         (goto-char (nth 5 state)))
3452     (forward-list)))
3453
3454 ;; NB: This could be done more efficiently!
3455 (defun prolog-backward-list ()
3456   "Move the point to the matching left parenthesis."
3457   (interactive)
3458   (if prolog-use-prolog-tokenizer-flag
3459       (let ((bal 0)
3460             (paren-regexp (concat prolog-left-paren "\\|" prolog-right-paren))
3461             (notdone t))
3462         ;; FIXME: Doesn't this incorrectly count 0'( and 0') ?
3463         (while (and notdone (re-search-backward paren-regexp nil t))
3464           (cond
3465            ((looking-at prolog-left-paren)
3466             (if (not (prolog-in-string-or-comment))
3467                 (setq bal (1+ bal)))
3468             (if (= bal 0)
3469                 (setq notdone nil)))
3470            ((looking-at prolog-right-paren)
3471             (if (not (prolog-in-string-or-comment))
3472                 (setq bal (1- bal))))
3473            )))
3474     (backward-list)))
3475
3476 (defun prolog-beginning-of-clause ()
3477   "Move to the beginning of current clause.
3478 If already at the beginning of clause, move to previous clause."
3479   (interactive)
3480   (let ((point (point))
3481         (new-point (prolog-clause-start)))
3482     (if (and (>= new-point point)
3483              (> point 1))
3484         (progn
3485           (goto-char (1- point))
3486           (goto-char (prolog-clause-start)))
3487       (goto-char new-point)
3488       (skip-chars-forward " \t"))))
3489
3490 ;; (defun prolog-previous-clause ()
3491 ;;   "Move to the beginning of the previous clause."
3492 ;;   (interactive)
3493 ;;   (forward-char -1)
3494 ;;   (prolog-beginning-of-clause))
3495
3496 (defun prolog-end-of-clause ()
3497   "Move to the end of clause.
3498 If already at the end of clause, move to next clause."
3499   (interactive)
3500   (let ((point (point))
3501         (new-point (prolog-clause-end)))
3502     (if (and (<= new-point point)
3503              (not (eq new-point (point-max))))
3504         (progn
3505           (goto-char (1+ point))
3506           (goto-char (prolog-clause-end)))
3507       (goto-char new-point))))
3508
3509 ;; (defun prolog-next-clause ()
3510 ;;   "Move to the beginning of the next clause."
3511 ;;   (interactive)
3512 ;;   (prolog-end-of-clause)
3513 ;;   (forward-char)
3514 ;;   (prolog-end-of-clause)
3515 ;;   (prolog-beginning-of-clause))
3516
3517 (defun prolog-beginning-of-predicate ()
3518   "Go to the nearest beginning of predicate before current point.
3519 Return the final point or nil if no such a beginning was found."
3520   (interactive)
3521   (let ((op (point))
3522         (pos (prolog-pred-start)))
3523     (if pos
3524         (if (= op pos)
3525             (if (not (bobp))
3526                 (progn
3527                   (goto-char pos)
3528                   (backward-char 1)
3529                   (setq pos (prolog-pred-start))
3530                   (if pos
3531                       (progn
3532                         (goto-char pos)
3533                         (point)))))
3534           (goto-char pos)
3535           (point)))))
3536
3537 (defun prolog-end-of-predicate ()
3538   "Go to the end of the current predicate."
3539   (interactive)
3540   (let ((op (point)))
3541     (goto-char (prolog-pred-end))
3542     (if (= op (point))
3543         (progn
3544           (forward-line 1)
3545           (prolog-end-of-predicate)))))
3546
3547 (defun prolog-insert-predspec ()
3548   "Insert the predspec for the current predicate."
3549   (interactive)
3550   (let* ((pinfo (prolog-clause-info))
3551          (predname (nth 0 pinfo))
3552          (arity (nth 1 pinfo)))
3553     (insert (format "%s/%d" predname arity))))
3554
3555 (defun prolog-view-predspec ()
3556   "Insert the predspec for the current predicate."
3557   (interactive)
3558   (let* ((pinfo (prolog-clause-info))
3559          (predname (nth 0 pinfo))
3560          (arity (nth 1 pinfo)))
3561     (message (format "%s/%d" predname arity))))
3562
3563 (defun prolog-insert-predicate-template ()
3564   "Insert the template for the current clause."
3565   (interactive)
3566   (let* ((n 1)
3567          oldp
3568          (pinfo (prolog-clause-info))
3569          (predname (nth 0 pinfo))
3570          (arity (nth 1 pinfo)))
3571     (insert predname)
3572     (if (> arity 0)
3573         (progn
3574           (insert "(")
3575           (when prolog-electric-dot-full-predicate-template
3576             (setq oldp (point))
3577             (while (< n arity)
3578               (insert ",")
3579               (setq n (1+ n)))
3580             (insert ")")
3581             (goto-char oldp))
3582           ))
3583   ))
3584
3585 (defun prolog-insert-next-clause ()
3586   "Insert newline and the name of the current clause."
3587   (interactive)
3588   (insert "\n")
3589   (prolog-insert-predicate-template))
3590
3591 (defun prolog-insert-module-modeline ()
3592   "Insert a modeline for module specification.
3593 This line should be first in the buffer.
3594 The module name should be written manually just before the semi-colon."
3595   (interactive)
3596   (insert "%%% -*- Module: ; -*-\n")
3597   (backward-char 6))
3598
3599 (defalias 'prolog-uncomment-region
3600   (if (fboundp 'uncomment-region) #'uncomment-region
3601     (lambda (beg end)
3602       "Uncomment the region between BEG and END."
3603       (interactive "r")
3604       (comment-region beg end -1))))
3605
3606 (defun prolog-goto-comment-column (&optional nocreate)
3607   "Move comments on the current line to the correct position.
3608 If NOCREATE is nil (or omitted) and there is no comment on the line, then
3609 a new comment is created."
3610   (interactive)
3611   (beginning-of-line)
3612   (if (or (not nocreate)
3613           (and
3614            (re-search-forward
3615             (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)%% *"
3616                     prolog-quoted-atom-regexp prolog-string-regexp)
3617             (line-end-position) 'limit)
3618            (progn
3619              (goto-char (match-beginning 0))
3620              (not (eq (prolog-in-string-or-comment) 'txt)))))
3621       (indent-for-comment)))
3622
3623 (defun prolog-indent-predicate ()
3624   "Indent the current predicate."
3625   (interactive)
3626   (indent-region (prolog-pred-start) (prolog-pred-end) nil))
3627
3628 (defun prolog-indent-buffer ()
3629   "Indent the entire buffer."
3630   (interactive)
3631   (indent-region (point-min) (point-max) nil))
3632
3633 (defun prolog-mark-clause ()
3634   "Put mark at the end of this clause and move point to the beginning."
3635   (interactive)
3636   (let ((pos (point)))
3637     (goto-char (prolog-clause-end))
3638     (forward-line 1)
3639     (beginning-of-line)
3640     (set-mark (point))
3641     (goto-char pos)
3642     (goto-char (prolog-clause-start))))
3643
3644 (defun prolog-mark-predicate ()
3645   "Put mark at the end of this predicate and move point to the beginning."
3646   (interactive)
3647   (goto-char (prolog-pred-end))
3648   (let ((pos (point)))
3649     (forward-line 1)
3650     (beginning-of-line)
3651     (set-mark (point))
3652     (goto-char pos)
3653     (goto-char (prolog-pred-start))))
3654
3655 ;; Stolen from `cc-mode.el':
3656 (defun prolog-electric-delete (arg)
3657   "Delete preceding character or whitespace.
3658 If `prolog-hungry-delete-key-flag' is non-nil, then all preceding whitespace is
3659 consumed.  If however an ARG is supplied, or `prolog-hungry-delete-key-flag' is
3660 nil, or point is inside a literal then the function in the variable
3661 `backward-delete-char' is called."
3662   (interactive "P")
3663   (if (or (not prolog-hungry-delete-key-flag)
3664           arg
3665           (prolog-in-string-or-comment))
3666       (funcall 'backward-delete-char (prefix-numeric-value arg))
3667     (let ((here (point)))
3668       (skip-chars-backward " \t\n")
3669       (if (/= (point) here)
3670           (delete-region (point) here)
3671         (funcall 'backward-delete-char 1)
3672         ))))
3673
3674 ;; For XEmacs compatibility (suggested by Per Mildner)
3675 (put 'prolog-electric-delete 'pending-delete 'supersede)
3676
3677 (defun prolog-electric-if-then-else (arg)
3678   "If `prolog-electric-if-then-else-flag' is non-nil, indent if-then-else constructs.
3679 Bound to the >, ; and ( keys."
3680   (interactive "P")
3681   (self-insert-command (prefix-numeric-value arg))
3682   (if prolog-electric-if-then-else-flag (prolog-insert-spaces-after-paren)))
3683
3684 (defun prolog-electric-colon (arg)
3685   "If `prolog-electric-colon-flag' is non-nil, insert the electric `:' construct.
3686 That is, insert space (if appropriate), `:-' and newline if colon is pressed
3687 at the end of a line that starts in the first column (i.e., clause
3688 heads)."
3689   (interactive "P")
3690   (if (and prolog-electric-colon-flag
3691            (null arg)
3692            (eolp)
3693            ;(not (string-match "^\\s " (thing-at-point 'line))))
3694            (not (string-match "^\\(\\s \\|%\\)" (thing-at-point 'line))))
3695       (progn
3696         (unless (save-excursion (backward-char 1) (looking-at "\\s "))
3697           (insert " "))
3698         (insert ":-\n")
3699         (prolog-indent-line))
3700     (self-insert-command (prefix-numeric-value arg))))
3701
3702 (defun prolog-electric-dash (arg)
3703   "If `prolog-electric-dash-flag' is non-nil, insert the electric `-' construct.
3704 that is, insert space (if appropriate), `-->' and newline if dash is pressed
3705 at the end of a line that starts in the first column (i.e., DCG
3706 heads)."
3707   (interactive "P")
3708   (if (and prolog-electric-dash-flag
3709            (null arg)
3710            (eolp)
3711            ;(not (string-match "^\\s " (thing-at-point 'line))))
3712            (not (string-match "^\\(\\s \\|%\\)" (thing-at-point 'line))))
3713       (progn
3714         (unless (save-excursion (backward-char 1) (looking-at "\\s "))
3715           (insert " "))
3716         (insert "-->\n")
3717         (prolog-indent-line))
3718     (self-insert-command (prefix-numeric-value arg))))
3719
3720 (defun prolog-electric-dot (arg)
3721   "Insert dot and newline or a head of a new clause.
3722
3723 If `prolog-electric-dot-flag' is nil, then simply insert dot.
3724 Otherwise::
3725 When invoked at the end of nonempty line, insert dot and newline.
3726 When invoked at the end of an empty line, insert a recursive call to
3727 the current predicate.
3728 When invoked at the beginning of line, insert a head of a new clause
3729 of the current predicate.
3730
3731 When called with prefix argument ARG, insert just dot."
3732   (interactive "P")
3733   ;; Check for situations when the electricity should not be active
3734   (if (or (not prolog-electric-dot-flag)
3735           arg
3736           (prolog-in-string-or-comment)
3737           ;; Do not be electric in a floating point number or an operator
3738           (not
3739            (or
3740             ;; (re-search-backward
3741             ;; ######
3742             ;; "\\(^\\|[])}a-zA-Z_!'0-9]+\\)[ \t]*\\=" nil t)))
3743             (save-excursion
3744               (re-search-backward
3745                ;; "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" nil t)))
3746                "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\="
3747                nil t))
3748             (save-excursion
3749               (re-search-backward
3750                ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t)))
3751                (format "\\(^\\|[])}%s]+\\)[ \t]*\\="
3752                        prolog-lower-case-string) ;FIXME: [:lower:]
3753                nil t))
3754               (save-excursion
3755               (re-search-backward
3756                ;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t)))
3757                (format "\\(^\\|[])}%s]+\\)[ \t]*\\="
3758                        prolog-upper-case-string) ;FIXME: [:upper:]
3759                nil t))
3760              )
3761             )
3762           ;; Do not be electric if inside a parenthesis pair.
3763           (not (= (prolog-region-paren-balance (prolog-clause-start) (point))
3764                   0))
3765           )
3766       (funcall 'self-insert-command (prefix-numeric-value arg))
3767     (cond
3768      ;; Beginning of line
3769      ((bolp)
3770       (prolog-insert-predicate-template))
3771      ;; At an empty line with at least one whitespace
3772      ((save-excursion
3773         (beginning-of-line)
3774         (looking-at "[ \t]+$"))
3775       (prolog-insert-predicate-template)
3776       (when prolog-electric-dot-full-predicate-template
3777         (save-excursion
3778           (end-of-line)
3779           (insert ".\n"))))
3780      ;; Default
3781      (t
3782       (insert ".\n"))
3783      )))
3784
3785 (defun prolog-electric-underscore ()
3786   "Replace variable with an underscore.
3787 If `prolog-electric-underscore-flag' is non-nil and the point is
3788 on a variable then replace the variable with underscore and skip
3789 the following comma and whitespace, if any.
3790 If the point is not on a variable then insert underscore."
3791   (interactive)
3792   (if prolog-electric-underscore-flag
3793       (let (;start
3794             (case-fold-search nil)
3795             (oldp (point)))
3796         ;; ######
3797         ;;(skip-chars-backward "a-zA-Z_")
3798         (skip-chars-backward
3799          (format "%s%s_"
3800                  ;; FIXME: Why not "a-zA-Z"?
3801                  prolog-lower-case-string
3802                  prolog-upper-case-string))
3803
3804         ;(setq start (point))
3805         (if (and (not (prolog-in-string-or-comment))
3806                  ;; ######
3807                  ;; (looking-at "\\<[_A-Z][a-zA-Z_0-9]*\\>"))
3808                  (looking-at (format "\\<[_%s][%s%s_0-9]*\\>"
3809                                      ;; FIXME: Use [:upper:] and friends.
3810                                      prolog-upper-case-string
3811                                      prolog-lower-case-string
3812                                      prolog-upper-case-string)))
3813             (progn
3814               (replace-match "_")
3815               (skip-chars-forward ", \t\n"))
3816           (goto-char oldp)
3817           (self-insert-command 1))
3818         )
3819     (self-insert-command 1))
3820   )
3821
3822
3823 (defun prolog-find-term (functor arity &optional prefix)
3824   "Go to the position at the start of the next occurrence of a term.
3825 The term is specified with FUNCTOR and ARITY.  The optional argument
3826 PREFIX is the prefix of the search regexp."
3827   (let* (;; If prefix is not set then use the default "\\<"
3828          (prefix (if (not prefix)
3829                      "\\<"
3830                    prefix))
3831          (regexp (concat prefix functor))
3832          (i 1))
3833
3834     ;; Build regexp for the search if the arity is > 0
3835     (if (= arity 0)
3836         ;; Add that the functor must be at the end of a word. This
3837         ;; does not work if the arity is > 0 since the closing )
3838         ;; is not a word constituent.
3839         (setq regexp (concat regexp "\\>"))
3840       ;; Arity is > 0, add parens and commas
3841       (setq regexp (concat regexp "("))
3842       (while (< i arity)
3843         (setq regexp (concat regexp ".+,"))
3844         (setq i (1+ i)))
3845       (setq regexp (concat regexp ".+)")))
3846
3847     ;; Search, and return position
3848     (if (re-search-forward regexp nil t)
3849         (goto-char (match-beginning 0))
3850       (error "Term not found"))
3851     ))
3852
3853 (defun prolog-variables-to-anonymous (beg end)
3854   "Replace all variables within a region BEG to END by anonymous variables."
3855   (interactive "r")
3856   (save-excursion
3857     (let ((case-fold-search nil))
3858       (goto-char end)
3859       (while (re-search-backward "\\<[A-Z_][a-zA-Z_0-9]*\\>" beg t)
3860         (progn
3861           (replace-match "_")
3862           (backward-char)))
3863       )))
3864
3865
3866 (defun prolog-set-atom-regexps ()
3867   "Set the `prolog-atom-char-regexp' and `prolog-atom-regexp' variables.
3868 Must be called after `prolog-build-case-strings'."
3869   (setq prolog-atom-char-regexp
3870         (format "[%s%s0-9_$]"
3871                 ;; FIXME: why not a-zA-Z?
3872                 prolog-lower-case-string
3873                 prolog-upper-case-string))
3874   (setq prolog-atom-regexp
3875         (format "[%s$]%s*"
3876                 prolog-lower-case-string
3877                 prolog-atom-char-regexp))
3878   )
3879
3880 (defun prolog-build-case-strings ()
3881   "Set `prolog-upper-case-string' and `prolog-lower-case-string'.
3882 Uses the current case-table for extracting the relevant information."
3883   (let ((up_string "")
3884         (low_string ""))
3885     ;; Use `map-char-table' if it is defined. Otherwise enumerate all
3886     ;; numbers between 0 and 255. `map-char-table' is probably safer.
3887     ;;
3888     ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
3889     ;; while loop seems to do its job well (Ryszard Szopa)
3890     ;;
3891     ;;(if (and (not (featurep 'xemacs))
3892     ;;          (fboundp 'map-char-table))
3893     ;;    (map-char-table
3894     ;;     (lambda (key value)
3895     ;;       (cond
3896     ;;        ((and
3897     ;;          (eq (prolog-int-to-char key) (downcase key))
3898     ;;          (eq (prolog-int-to-char key) (upcase key)))
3899     ;;         ;; Do nothing if upper and lower case are the same
3900     ;;         )
3901     ;;        ((eq (prolog-int-to-char key) (downcase key))
3902     ;;         ;; The char is lower case
3903     ;;         (setq low_string (format "%s%c" low_string key)))
3904     ;;        ((eq (prolog-int-to-char key) (upcase key))
3905     ;;         ;; The char is upper case
3906     ;;         (setq up_string (format "%s%c" up_string key)))
3907     ;;        ))
3908     ;;     (current-case-table))
3909       ;; `map-char-table' was undefined.
3910       (let ((key 0))
3911         (while (< key 256)
3912           (cond
3913            ((and
3914              (eq (prolog-int-to-char key) (downcase key))
3915              (eq (prolog-int-to-char key) (upcase key)))
3916             ;; Do nothing if upper and lower case are the same
3917             )
3918            ((eq (prolog-int-to-char key) (downcase key))
3919             ;; The char is lower case
3920             (setq low_string (format "%s%c" low_string key)))
3921            ((eq (prolog-int-to-char key) (upcase key))
3922             ;; The char is upper case
3923             (setq up_string (format "%s%c" up_string key)))
3924            )
3925           (setq key (1+ key))))
3926       ;; )
3927       ;; The strings are single-byte strings
3928       (setq prolog-upper-case-string (prolog-dash-letters up_string))
3929       (setq prolog-lower-case-string (prolog-dash-letters low_string))
3930       ))
3931
3932 ;(defun prolog-regexp-dash-continuous-chars (chars)
3933 ;  (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
3934 ;        (beg 0)
3935 ;        (end 0))
3936 ;    (if (null ints)
3937 ;        chars
3938 ;      (while (and (< (+ beg 1) (length chars))
3939 ;                  (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
3940 ;                           (= (nth beg ints) (nth (+ beg 1) ints)))))
3941 ;        (setq beg (+ beg 1)))
3942 ;      (setq beg (+ beg 1)
3943 ;            end beg)
3944 ;      (while (and (< (+ end 1) (length chars))
3945 ;                  (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
3946 ;                      (= (nth end ints) (nth (+ end 1) ints))))
3947 ;        (setq end (+ end 1)))
3948 ;      (if (equal (substring chars end) "")
3949 ;          (substring chars 0 beg)
3950 ;        (concat (substring chars 0 beg) "-"
3951 ;                (prolog-regexp-dash-continuous-chars (substring chars end))))
3952 ;    )))
3953
3954 (defun prolog-ints-intervals (ints)
3955   "Return a list of intervals (from . to) covering INTS."
3956   (when ints
3957     (setq ints (sort ints '<))
3958     (let ((prev (car ints))
3959           (interval-start (car ints))
3960           intervals)
3961       (while ints
3962         (let ((next (car ints)))
3963           (when (> next (1+ prev))      ; start of new interval
3964               (setq intervals (cons (cons interval-start prev) intervals))
3965               (setq interval-start next))
3966           (setq prev next)
3967           (setq ints (cdr ints))))
3968       (setq intervals (cons (cons interval-start prev) intervals))
3969       (reverse intervals))))
3970
3971 (defun prolog-dash-letters (string)
3972   "Return a condensed regexp covering all letters in STRING."
3973   (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
3974                                                  (string-to-list string))))
3975         codes)
3976     (while intervals
3977       (let* ((i (car intervals))
3978              (from (car i))
3979              (to (cdr i))
3980              (c (cond ((= from to) `(,from))
3981                       ((= (1+ from) to) `(,from ,to))
3982                       (t `(,from ?- ,to)))))
3983         (setq codes (cons c codes)))
3984       (setq intervals (cdr intervals)))
3985     (apply 'concat (reverse codes))))
3986
3987 ;(defun prolog-condense-character-sets (regexp)
3988 ;  "Condense adjacent characters in character sets of REGEXP."
3989 ;  (let ((next -1))
3990 ;    (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
3991 ;      (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
3992 ;                                 t t regexp 1))))
3993 ;  regexp)
3994
3995 ;; GNU Emacs compatibility: GNU Emacs does not differentiate between
3996 ;; ints and chars, or at least these two are interchangeable.
3997 (defalias 'prolog-int-to-char
3998   (if (fboundp 'int-to-char) #'int-to-char #'identity))
3999
4000 (defalias 'prolog-char-to-int
4001   (if (fboundp 'char-to-int) #'char-to-int #'identity))
4002 \f
4003 ;;-------------------------------------------------------------------
4004 ;; Menu stuff (both for the editing buffer and for the inferior
4005 ;; prolog buffer)
4006 ;;-------------------------------------------------------------------
4007
4008 (unless (fboundp 'region-exists-p)
4009   (defun region-exists-p ()
4010     "Non-nil iff the mark is set.  Lobotomized version for Emacsen that do not provide their own."
4011     (mark)))
4012
4013
4014 ;; GNU Emacs ignores `easy-menu-add' so the order in which the menus
4015 ;; are defined _is_ important!
4016
4017 (easy-menu-define
4018   prolog-menu-help (list prolog-mode-map prolog-inferior-mode-map)
4019   "Help menu for the Prolog mode."
4020   ;; FIXME: Does it really deserve a whole menu to itself?
4021   `(,(if (featurep 'xemacs) "Help"
4022        ;; Not sure it's worth the trouble.  --Stef
4023        ;; (add-to-list 'menu-bar-final-items
4024        ;;         (easy-menu-intern "Prolog-Help"))
4025        "Prolog-help")
4026     ["On predicate" prolog-help-on-predicate prolog-help-function-i]
4027     ["Apropos" prolog-help-apropos (eq prolog-system 'swi)]
4028     "---"
4029     ["Describe mode" describe-mode t]))
4030
4031 (easy-menu-define
4032   prolog-edit-menu-runtime prolog-mode-map
4033   "Runtime Prolog commands available from the editing buffer"
4034   ;; FIXME: Don't use a whole menu for just "Run Mercury".  --Stef
4035   `("System"
4036     ;; Runtime menu name.
4037     ,@(unless (featurep 'xemacs)
4038         '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe")
4039                        ((eq prolog-system 'mercury) "Mercury")
4040                        (t "System"))))
4041
4042     ;; Consult items, NIL for mercury.
4043     ["Consult file" prolog-consult-file
4044      :included (not (eq prolog-system 'mercury))]
4045     ["Consult buffer" prolog-consult-buffer
4046      :included (not (eq prolog-system 'mercury))]
4047     ["Consult region" prolog-consult-region :active (region-exists-p)
4048      :included (not (eq prolog-system 'mercury))]
4049     ["Consult predicate" prolog-consult-predicate
4050      :included (not (eq prolog-system 'mercury))]
4051
4052     ;; Compile items, NIL for everything but SICSTUS.
4053     ,(if (featurep 'xemacs) "---"
4054        ["---" nil :included (eq prolog-system 'sicstus)])
4055     ["Compile file" prolog-compile-file
4056      :included (eq prolog-system 'sicstus)]
4057     ["Compile buffer" prolog-compile-buffer
4058      :included (eq prolog-system 'sicstus)]
4059     ["Compile region" prolog-compile-region :active (region-exists-p)
4060      :included (eq prolog-system 'sicstus)]
4061     ["Compile predicate" prolog-compile-predicate
4062      :included (eq prolog-system 'sicstus)]
4063
4064     ;; Debug items, NIL for Mercury.
4065     ,(if (featurep 'xemacs) "---"
4066        ["---" nil :included (not (eq prolog-system 'mercury))])
4067     ;; FIXME: Could we use toggle or radio buttons?  --Stef
4068     ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))]
4069     ["Debug off" prolog-debug-off
4070      ;; In SICStus, these are pairwise disjunctive,
4071      ;; so it's enough with a single "off"-command
4072      :included (not (memq prolog-system '(mercury sicstus)))]
4073     ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))]
4074     ["Trace off" prolog-trace-off
4075      :included (not (memq prolog-system '(mercury sicstus)))]
4076     ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus)
4077                                         (prolog-atleast-version '(3 . 7)))]
4078     ["All debug off" prolog-debug-off
4079      :included (eq prolog-system 'sicstus)]
4080     ["Source level debugging"
4081      prolog-toggle-sicstus-sd
4082      :included (and (eq prolog-system 'sicstus)
4083                     (prolog-atleast-version '(3 . 7)))
4084      :style toggle
4085      :selected prolog-use-sicstus-sd]
4086
4087     "---"
4088     ["Run" run-prolog
4089      :suffix (cond ((eq prolog-system 'eclipse) "ECLiPSe")
4090                    ((eq prolog-system 'mercury) "Mercury")
4091                    (t "Prolog"))]))
4092
4093 (easy-menu-define
4094   prolog-edit-menu-insert-move prolog-mode-map
4095   "Commands for Prolog code manipulation."
4096   '("Prolog"
4097     ["Comment region" comment-region (region-exists-p)]
4098     ["Uncomment region" prolog-uncomment-region (region-exists-p)]
4099     ["Add comment/move to comment" indent-for-comment t]
4100     ["Convert variables in region to '_'" prolog-variables-to-anonymous
4101      :active (region-exists-p) :included (not (eq prolog-system 'mercury))]
4102     "---"
4103     ["Insert predicate template" prolog-insert-predicate-template t]
4104     ["Insert next clause head" prolog-insert-next-clause t]
4105     ["Insert predicate spec" prolog-insert-predspec t]
4106     ["Insert module modeline" prolog-insert-module-modeline t]
4107     "---"
4108     ["Beginning of clause" prolog-beginning-of-clause t]
4109     ["End of clause" prolog-end-of-clause t]
4110     ["Beginning of predicate" prolog-beginning-of-predicate t]
4111     ["End of predicate" prolog-end-of-predicate t]
4112     "---"
4113     ["Indent line" prolog-indent-line t]
4114     ["Indent region" indent-region (region-exists-p)]
4115     ["Indent predicate" prolog-indent-predicate t]
4116     ["Indent buffer" prolog-indent-buffer t]
4117     ["Align region" align (region-exists-p)]
4118     "---"
4119     ["Mark clause" prolog-mark-clause t]
4120     ["Mark predicate" prolog-mark-predicate t]
4121     ["Mark paragraph" mark-paragraph t]
4122     ;;"---"
4123     ;;["Fontify buffer" font-lock-fontify-buffer t]
4124     ))
4125
4126 (defun prolog-menu ()
4127   "Add the menus for the Prolog editing buffers."
4128
4129   (easy-menu-add prolog-edit-menu-insert-move)
4130   (easy-menu-add prolog-edit-menu-runtime)
4131
4132   ;; Add predicate index menu
4133   (set (make-local-variable 'imenu-create-index-function)
4134        'imenu-default-create-index-function)
4135   ;;Milan (this has problems with object methods...)  ###### Does it? (Stefan)
4136   (setq imenu-prev-index-position-function 'prolog-beginning-of-predicate)
4137   (setq imenu-extract-index-name-function 'prolog-get-predspec)
4138
4139   (if (and prolog-imenu-flag
4140            (< (count-lines (point-min) (point-max)) prolog-imenu-max-lines))
4141       (imenu-add-to-menubar "Predicates"))
4142
4143   (easy-menu-add prolog-menu-help))
4144
4145 (easy-menu-define
4146   prolog-inferior-menu-all prolog-inferior-mode-map
4147   "Menu for the inferior Prolog buffer."
4148   `("Prolog"
4149     ;; Runtime menu name.
4150     ,@(unless (featurep 'xemacs)
4151         '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe")
4152                        ((eq prolog-system 'mercury) "Mercury")
4153                        (t "Prolog"))))
4154
4155     ;; Debug items, NIL for Mercury.
4156     ,(if (featurep 'xemacs) "---"
4157        ["---" nil :included (not (eq prolog-system 'mercury))])
4158     ;; FIXME: Could we use toggle or radio buttons?  --Stef
4159     ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))]
4160     ["Debug off" prolog-debug-off
4161      ;; In SICStus, these are pairwise disjunctive,
4162      ;; so it's enough with a single "off"-command
4163      :included (not (memq prolog-system '(mercury sicstus)))]
4164     ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))]
4165     ["Trace off" prolog-trace-off
4166      :included (not (memq prolog-system '(mercury sicstus)))]
4167     ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus)
4168                                         (prolog-atleast-version '(3 . 7)))]
4169     ["All debug off" prolog-debug-off
4170      :included (eq prolog-system 'sicstus)]
4171     ["Source level debugging"
4172      prolog-toggle-sicstus-sd
4173      :included (and (eq prolog-system 'sicstus)
4174                     (prolog-atleast-version '(3 . 7)))
4175      :style toggle
4176      :selected prolog-use-sicstus-sd]
4177
4178     ;; Runtime.
4179     "---"
4180     ["Interrupt Prolog" comint-interrupt-subjob t]
4181     ["Quit Prolog" comint-quit-subjob t]
4182     ["Kill Prolog" comint-kill-subjob t]))
4183
4184
4185 (defun prolog-inferior-menu ()
4186   "Create the menus for the Prolog inferior buffer.
4187 This menu is dynamically created because one may change systems during
4188 the life of an Emacs session."
4189   (easy-menu-add prolog-inferior-menu-all)
4190   (easy-menu-add prolog-menu-help))
4191
4192 (defun prolog-mode-version ()
4193   "Echo the current version of Prolog mode in the minibuffer."
4194   (interactive)
4195   (message "Using Prolog mode version %s" prolog-mode-version))
4196
4197 (provide 'prolog)
4198
4199 ;;; prolog.el ends here