;;; prolog.el --- major mode for editing and running Prolog (and Mercury) code
-;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011
+;; Copyright (C) 1986-1987, 1997-1999, 2002-2003, 2011-2012
;; Free Software Foundation, Inc.
;; Authors: Emil Åström <emil_astrom(at)hotmail(dot)com>
;; Milan Zamazal <pdm(at)freesoft(dot)cz>
-;; Stefan Bruda <stefan(at)bruda(dot)ca> (current maintainer)
+;; Stefan Bruda <stefan(at)bruda(dot)ca>
;; * See below for more details
+;; Maintainer: Stefan Bruda <stefan(at)bruda(dot)ca>
;; Keywords: prolog major mode sicstus swi mercury
(defvar prolog-mode-version "1.22"
;; Some ideas and also a few lines of code have been borrowed (not stolen ;-)
;; from Oz.el, the Emacs major mode for the Oz programming language,
;; Copyright (C) 1993 DFKI GmbH, Germany, with permission.
-;; Authors: Ralf Scheidhauer and Michael Mehl ([scheidhr|mehl](at)dfki(dot)uni-sb(dot)de)
+;; Authored by Ralf Scheidhauer and Michael Mehl
+;; ([scheidhr|mehl](at)dfki(dot)uni-sb(dot)de)
;;
;; More ideas and code have been taken from the SICStus debugger mode
;; (http://www.csd.uu.se/~perm/source_debug/index.shtml -- broken link
;; Version 1.22:
;; o Allowed both 'swipl' and 'pl' as names for the SWI Prolog
;; interpreter.
-;; o Atoms that start a line are not blindly coloured as
+;; o Atoms that start a line are not blindly colored as
;; predicates. Instead we check that they are followed by ( or
;; :- first. Patch suggested by Guy Wiener.
;; Version 1.21:
;; o Introduced three new customizable variables: electric colon
;; (`prolog-electric-colon-flag', default nil), electric dash
;; (`prolog-electric-dash-flag', default nil), and a possibility
-;; to prevent the predicate template insertion from adding commata
+;; to prevent the predicate template insertion from adding commas
;; (`prolog-electric-dot-full-predicate-template', defaults to t
-;; since it seems quicker to me to just type those commata). A
+;; since it seems quicker to me to just type those commas). A
;; trivial adaptation of a patch by Markus Triska.
-;; o Improved the behaviour of electric if-then-else to only skip
+;; o Improved the behavior of electric if-then-else to only skip
;; forward if the parenthesis/semicolon is preceded by
;; whitespace. Once more a trivial adaptation of a patch by
;; Markus Triska.
;; with the original form). My code on the matter was improved
;; considerably by Markus Triska.
;; o Fixed `prolog-insert-spaces-after-paren' (which used an
-;; unitialized variable).
+;; uninitialized variable).
;; o Minor changes to clean up the code and avoid some implicit
;; package requirements.
;; Version 1.13:
;; o Removed the use of `map-char-table' in `prolog-build-case-strings'
-;; which appears to cause prblems in (at least) Emacs 23.0.0.1.
+;; which appears to cause problems in (at least) Emacs 23.0.0.1.
;; o Added if-then-else indentation + corresponding electric
;; characters. New customization: `prolog-electric-if-then-else-flag'
;; o Align support (requires `align'). New customization:
;;; Code:
(eval-when-compile
- (require 'compile)
(require 'font-lock)
;; We need imenu everywhere because of the predicate index!
(require 'imenu)
(defgroup prolog nil
- "Major modes for editing and running Prolog and Mercury files."
+ "Editing and running Prolog and Mercury files."
:group 'languages)
(defgroup prolog-faces nil
;; General configuration
(defcustom prolog-system nil
- "*Prolog interpreter/compiler used.
+ "Prolog interpreter/compiler used.
The value of this variable is nil or a symbol.
If it is a symbol, it determines default values of other configuration
variables with respect to properties of the specified Prolog
sicstus - SICStus Prolog
swi - SWI Prolog
gnu - GNU Prolog"
+ :version "24.1"
:group 'prolog
:type '(choice (const :tag "SICStus" :value sicstus)
(const :tag "SWI Prolog" :value swi)
+ (const :tag "GNU Prolog" :value gnu)
+ (const :tag "ECLiPSe Prolog" :value eclipse)
+ ;; Mercury shouldn't be needed since we have a separate
+ ;; major mode for it.
(const :tag "Default" :value nil)))
(make-variable-buffer-local 'prolog-system)
(mercury (0 . 0))
(eclipse (3 . 7))
(gnu (0 . 0)))
- "*Alist of Prolog system versions.
+ ;; FIXME: This should be auto-detected instead of user-provided.
+ "Alist of Prolog system versions.
The version numbers are of the format (Major . Minor)."
+ :version "24.1"
+ :type '(repeat (list (symbol :tag "System")
+ (cons :tag "Version numbers" (integer :tag "Major")
+ (integer :tag "Minor"))))
:group 'prolog)
;; Indentation
(defcustom prolog-indent-width 4
- "*The indentation width used by the editing buffer."
+ "The indentation width used by the editing buffer."
:group 'prolog-indentation
:type 'integer)
(defcustom prolog-align-comments-flag t
- "*Non-nil means automatically align comments when indenting."
+ "Non-nil means automatically align comments when indenting."
+ :version "24.1"
:group 'prolog-indentation
:type 'boolean)
(defcustom prolog-indent-mline-comments-flag t
- "*Non-nil means indent contents of /* */ comments.
+ "Non-nil means indent contents of /* */ comments.
Otherwise leave such lines as they are."
+ :version "24.1"
:group 'prolog-indentation
:type 'boolean)
(defcustom prolog-object-end-to-0-flag t
- "*Non-nil means indent closing '}' in SICStus object definitions to level 0.
+ "Non-nil means indent closing '}' in SICStus object definitions to level 0.
Otherwise indent to `prolog-indent-width'."
+ :version "24.1"
:group 'prolog-indentation
:type 'boolean)
(defcustom prolog-left-indent-regexp "\\(;\\|\\*?->\\)"
- "*Regexp for character sequences after which next line is indented.
-Next line after such a regexp is indented to the opening paranthesis level."
+ "Regexp for character sequences after which next line is indented.
+Next line after such a regexp is indented to the opening parenthesis level."
+ :version "24.1"
:group 'prolog-indentation
:type 'regexp)
(defcustom prolog-paren-indent-p nil
- "*If non-nil, increase indentation for parenthesis expressions.
+ "If non-nil, increase indentation for parenthesis expressions.
The second and subsequent line in a parenthesis expression other than
a compound term can either be indented `prolog-paren-indent' to the
right (if this variable is non-nil) or in the same way as for compound
terms (if this variable is nil, default)."
+ :version "24.1"
:group 'prolog-indentation
:type 'boolean)
(defcustom prolog-paren-indent 4
- "*The indentation increase for parenthesis expressions.
+ "The indentation increase for parenthesis expressions.
Only used in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
+ :version "24.1"
:group 'prolog-indentation
:type 'integer)
(defcustom prolog-parse-mode 'beg-of-clause
- "*The parse mode used (decides from which point parsing is done).
+ "The parse mode used (decides from which point parsing is done).
Legal values:
'beg-of-line - starts parsing at the beginning of a line, unless the
previous line ends with a backslash. Fast, but has
problems detecting multiline /* */ comments.
'beg-of-clause - starts parsing at the beginning of the current clause.
Slow, but copes better with /* */ comments."
+ :version "24.1"
:group 'prolog-indentation
:type '(choice (const :value beg-of-line)
(const :value beg-of-clause)))
(t
;; FIXME: Shouldn't we just use the union of all the above here?
("dynamic" "module")))
- "*Alist of Prolog keywords which is used for font locking of directives."
+ "Alist of Prolog keywords which is used for font locking of directives."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
'((mercury
("char" "float" "int" "io__state" "string" "univ"))
(t nil))
- "*Alist of Prolog types used by font locking."
+ "Alist of Prolog types used by font locking."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
'((mercury
("bound" "di" "free" "ground" "in" "mdi" "mui" "muo" "out" "ui" "uo"))
(t nil))
- "*Alist of Prolog mode specificators used by font locking."
+ "Alist of Prolog mode specificators used by font locking."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
("cc_multi" "cc_nondet" "det" "erroneous" "failure" "multi" "nondet"
"semidet"))
(t nil))
- "*Alist of Prolog determinism specificators used by font locking."
+ "Alist of Prolog determinism specificators used by font locking."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
'((mercury
("^#[0-9]+"))
(t nil))
- "*Alist of Prolog source code directives used by font locking."
+ "Alist of Prolog source code directives used by font locking."
+ :version "24.1"
:group 'prolog-font-lock
:type 'sexp)
;; Keyboard
(defcustom prolog-electric-newline-flag (not (fboundp 'electric-indent-mode))
- "*Non-nil means automatically indent the next line when the user types RET."
+ "Non-nil means automatically indent the next line when the user types RET."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-hungry-delete-key-flag nil
- "*Non-nil means delete key consumes all preceding spaces."
+ "Non-nil means delete key consumes all preceding spaces."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-dot-flag nil
- "*Non-nil means make dot key electric.
+ "Non-nil means make dot key electric.
Electric dot appends newline or inserts head of a new clause.
If dot is pressed at the end of a line where at least one white space
precedes the point, it inserts a recursive call to the current predicate.
of a new clause for the current predicate. It does not apply in strings
and comments.
It does not apply in strings and comments."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-dot-full-predicate-template nil
- "*If nil, electric dot inserts only the current predicate's name and `('
+ "If nil, electric dot inserts only the current predicate's name and `('
for recursive calls or new clause heads. Non-nil means to also
-insert enough commata to cover the predicate's arity and `)',
+insert enough commas to cover the predicate's arity and `)',
and dot and newline for recursive calls."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-underscore-flag nil
- "*Non-nil means make underscore key electric.
+ "Non-nil means make underscore key electric.
Electric underscore replaces the current variable with underscore.
If underscore is pressed not on a variable then it behaves as usual."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-tab-flag nil
- "*Non-nil means make TAB key electric.
+ "Non-nil means make TAB key electric.
Electric TAB inserts spaces after parentheses, ->, and ;
in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-if-then-else-flag nil
- "*Non-nil makes `(', `>' and `;' electric
+ "Non-nil makes `(', `>' and `;' electric
to automatically indent if-then-else constructs."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-colon-flag nil
- "*Makes `:' electric (inserts `:-' on a new line).
+ "Makes `:' electric (inserts `:-' on a new line).
If non-nil, pressing `:' at the end of a line that starts in
the first column (i.e., clause heads) inserts ` :-' and newline."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-electric-dash-flag nil
- "*Makes `-' electric (inserts a `-->' on a new line).
+ "Makes `-' electric (inserts a `-->' on a new line).
If non-nil, pressing `-' at the end of a line that starts in
the first column (i.e., DCG heads) inserts ` -->' and newline."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(defcustom prolog-old-sicstus-keys-flag nil
- "*Non-nil means old SICStus Prolog mode keybindings are used."
+ "Non-nil means old SICStus Prolog mode keybindings are used."
+ :version "24.1"
:group 'prolog-keyboard
:type 'boolean)
(not (executable-find (car names))))
(setq names (cdr names)))
(or (car names) "prolog"))))
- "*Alist of program names for invoking an inferior Prolog with `run-prolog'."
+ "Alist of program names for invoking an inferior Prolog with `run-prolog'."
:group 'prolog-inferior
:type 'sexp)
+(defun prolog-program-name ()
+ (prolog-find-value-by-system prolog-program-name))
(defcustom prolog-program-switches
'((sicstus ("-i"))
(t nil))
- "*Alist of switches given to inferior Prolog run with `run-prolog'."
+ "Alist of switches given to inferior Prolog run with `run-prolog'."
+ :version "24.1"
:group 'prolog-inferior
:type 'sexp)
+(defun prolog-program-switches ()
+ (prolog-find-value-by-system prolog-program-switches))
(defcustom prolog-consult-string
'((eclipse "[%f].")
(swi "[%f].")
(gnu "[%f].")
(t "reconsult(%f)."))
- "*Alist of strings defining predicate for reconsulting.
+ "Alist of strings defining predicate for reconsulting.
Some parts of the string are replaced:
`%f' by the name of the consulted file (can be a temporary file)
the region."
:group 'prolog-inferior
:type 'sexp)
+(defun prolog-consult-string ()
+ (prolog-find-value-by-system prolog-consult-string))
(defcustom prolog-compile-string
'((eclipse "[%f].")
"prolog:zap_file(%m,%b,compile).")))
(swi "[%f].")
(t "compile(%f)."))
- "*Alist of strings and lists defining predicate for recompilation.
+ "Alist of strings and lists defining predicate for recompilation.
Some parts of the string are replaced:
`%f' by the name of the compiled file (can be a temporary file)
If `prolog-program-name' is nil, it is an argument to the `compile' function."
:group 'prolog-inferior
:type 'sexp)
+(defun prolog-compile-string ()
+ (prolog-find-value-by-system prolog-compile-string))
(defcustom prolog-eof-string "end_of_file.\n"
- "*Alist of strings that represent end of file for prolog.
+ "Alist of strings that represent end of file for prolog.
nil means send actual operating system end of file."
:group 'prolog-inferior
:type 'sexp)
'((eclipse "^[a-zA-Z0-9()]* *\\?- \\|^\\[[a-zA-Z]* [0-9]*\\]:")
(sicstus "| [ ?][- ] *")
(swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +")
- (t "^ *\\?-"))
- "*Alist of prompts of the prolog system command line."
+ (gnu "^| \\?-")
+ (t "^|? *\\?-"))
+ "Alist of prompts of the prolog system command line."
+ :version "24.1"
:group 'prolog-inferior
:type 'sexp)
+(defun prolog-prompt-regexp ()
+ (prolog-find-value-by-system prolog-prompt-regexp))
-(defcustom prolog-continued-prompt-regexp
- '((sicstus "^\\(| +\\| +\\)")
- (t "^|: +"))
- "*Alist of regexps matching the prompt when consulting `user'."
- :group 'prolog-inferior
- :type 'sexp)
+;; (defcustom prolog-continued-prompt-regexp
+;; '((sicstus "^\\(| +\\| +\\)")
+;; (t "^|: +"))
+;; "Alist of regexps matching the prompt when consulting `user'."
+;; :group 'prolog-inferior
+;; :type 'sexp)
(defcustom prolog-debug-on-string "debug.\n"
- "*Predicate for enabling debug mode."
+ "Predicate for enabling debug mode."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-debug-off-string "nodebug.\n"
- "*Predicate for disabling debug mode."
+ "Predicate for disabling debug mode."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-trace-on-string "trace.\n"
- "*Predicate for enabling tracing."
+ "Predicate for enabling tracing."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-trace-off-string "notrace.\n"
- "*Predicate for disabling tracing."
+ "Predicate for disabling tracing."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-zip-on-string "zip.\n"
- "*Predicate for enabling zip mode for SICStus."
+ "Predicate for enabling zip mode for SICStus."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-zip-off-string "nozip.\n"
- "*Predicate for disabling zip mode for SICStus."
+ "Predicate for disabling zip mode for SICStus."
+ :version "24.1"
:group 'prolog-inferior
:type 'string)
(defcustom prolog-use-standard-consult-compile-method-flag t
- "*Non-nil means use the standard compilation method.
+ "Non-nil means use the standard compilation method.
Otherwise the new compilation method will be used. This
-utilises a special compilation buffer with the associated
+utilizes a special compilation buffer with the associated
features such as parsing of error messages and automatically
jumping to the source code responsible for the error.
Warning: the new method is so far only experimental and
does contain bugs. The recommended setting for the novice user
is non-nil for this variable."
+ :version "24.1"
:group 'prolog-inferior
:type 'boolean)
(defcustom prolog-use-prolog-tokenizer-flag
(not (fboundp 'syntax-propertize-rules))
- "*Non-nil means use the internal prolog tokenizer for indentation etc.
+ "Non-nil means use the internal prolog tokenizer for indentation etc.
Otherwise use `parse-partial-sexp' which is faster but sometimes incorrect."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
(defcustom prolog-imenu-flag t
- "*Non-nil means add a clause index menu for all prolog files."
+ "Non-nil means add a clause index menu for all prolog files."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
(defcustom prolog-imenu-max-lines 3000
- "*The maximum number of lines of the file for imenu to be enabled.
+ "The maximum number of lines of the file for imenu to be enabled.
Relevant only when `prolog-imenu-flag' is non-nil."
+ :version "24.1"
:group 'prolog-other
:type 'integer)
(defcustom prolog-info-predicate-index
"(sicstus)Predicate Index"
- "*The info node for the SICStus predicate index."
+ "The info node for the SICStus predicate index."
+ :version "24.1"
:group 'prolog-other
:type 'string)
(defcustom prolog-underscore-wordchar-flag nil
- "*Non-nil means underscore (_) is a word-constituent character."
+ "Non-nil means underscore (_) is a word-constituent character."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
(defcustom prolog-use-sicstus-sd nil
- "*If non-nil, use the source level debugger of SICStus 3#7 and later."
+ "If non-nil, use the source level debugger of SICStus 3#7 and later."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
(defcustom prolog-char-quote-workaround nil
- "*If non-nil, declare 0 as a quote character to handle 0'<char>.
+ "If non-nil, declare 0 as a quote character to handle 0'<char>.
This is really kludgy, and unneeded (i.e. obsolete) in Emacs>=24."
+ :version "24.1"
:group 'prolog-other
:type 'boolean)
)
table))
(defvar prolog-mode-abbrev-table nil)
-(defvar prolog-upper-case-string ""
- "A string containing all upper case characters.
-Set by prolog-build-case-strings.")
-(defvar prolog-lower-case-string ""
- "A string containing all lower case characters.
-Set by prolog-build-case-strings.")
-
-(defvar prolog-atom-char-regexp ""
- "Set by prolog-set-atom-regexps.")
-;; "Regexp specifying characters which constitute atoms without quoting.")
-(defvar prolog-atom-regexp ""
- "Set by prolog-set-atom-regexps.")
-
-(defconst prolog-left-paren "[[({]"
+
+(if (eval-when-compile
+ (and (string-match "[[:upper:]]" "A")
+ (with-temp-buffer
+ (insert "A") (skip-chars-backward "[:upper:]") (bolp))))
+ (progn
+ (defconst prolog-upper-case-string "[:upper:]"
+ "A string containing a char-range matching all upper case characters.")
+ (defconst prolog-lower-case-string "[:lower:]"
+ "A string containing a char-range matching all lower case characters."))
+
+ ;; GNU Emacs compatibility: GNU Emacs does not differentiate between
+ ;; ints and chars, or at least these two are interchangeable.
+ (defalias 'prolog-int-to-char
+ (if (fboundp 'int-to-char) #'int-to-char #'identity))
+
+ (defalias 'prolog-char-to-int
+ (if (fboundp 'char-to-int) #'char-to-int #'identity))
+
+ (defun prolog-ints-intervals (ints)
+ "Return a list of intervals (from . to) covering INTS."
+ (when ints
+ (setq ints (sort ints '<))
+ (let ((prev (car ints))
+ (interval-start (car ints))
+ intervals)
+ (while ints
+ (let ((next (car ints)))
+ (when (> next (1+ prev)) ; start of new interval
+ (setq intervals (cons (cons interval-start prev) intervals))
+ (setq interval-start next))
+ (setq prev next)
+ (setq ints (cdr ints))))
+ (setq intervals (cons (cons interval-start prev) intervals))
+ (reverse intervals))))
+
+ (defun prolog-dash-letters (string)
+ "Return a condensed regexp covering all letters in STRING."
+ (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
+ (string-to-list string))))
+ codes)
+ (while intervals
+ (let* ((i (car intervals))
+ (from (car i))
+ (to (cdr i))
+ (c (cond ((= from to) `(,from))
+ ((= (1+ from) to) `(,from ,to))
+ (t `(,from ?- ,to)))))
+ (setq codes (cons c codes)))
+ (setq intervals (cdr intervals)))
+ (apply 'concat (reverse codes))))
+
+ (let ((up_string "")
+ (low_string ""))
+ ;; Use `map-char-table' if it is defined. Otherwise enumerate all
+ ;; numbers between 0 and 255. `map-char-table' is probably safer.
+ ;;
+ ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
+ ;; while loop seems to do its job well (Ryszard Szopa)
+ ;;
+ ;;(if (and (not (featurep 'xemacs))
+ ;; (fboundp 'map-char-table))
+ ;; (map-char-table
+ ;; (lambda (key value)
+ ;; (cond
+ ;; ((and
+ ;; (eq (prolog-int-to-char key) (downcase key))
+ ;; (eq (prolog-int-to-char key) (upcase key)))
+ ;; ;; Do nothing if upper and lower case are the same
+ ;; )
+ ;; ((eq (prolog-int-to-char key) (downcase key))
+ ;; ;; The char is lower case
+ ;; (setq low_string (format "%s%c" low_string key)))
+ ;; ((eq (prolog-int-to-char key) (upcase key))
+ ;; ;; The char is upper case
+ ;; (setq up_string (format "%s%c" up_string key)))
+ ;; ))
+ ;; (current-case-table))
+ ;; `map-char-table' was undefined.
+ (let ((key 0))
+ (while (< key 256)
+ (cond
+ ((and
+ (eq (prolog-int-to-char key) (downcase key))
+ (eq (prolog-int-to-char key) (upcase key)))
+ ;; Do nothing if upper and lower case are the same
+ )
+ ((eq (prolog-int-to-char key) (downcase key))
+ ;; The char is lower case
+ (setq low_string (format "%s%c" low_string key)))
+ ((eq (prolog-int-to-char key) (upcase key))
+ ;; The char is upper case
+ (setq up_string (format "%s%c" up_string key)))
+ )
+ (setq key (1+ key))))
+ ;; )
+ ;; The strings are single-byte strings.
+ (defconst prolog-upper-case-string (prolog-dash-letters up_string)
+ "A string containing a char-range matching all upper case characters.")
+ (defconst prolog-lower-case-string (prolog-dash-letters low_string)
+ "A string containing a char-range matching all lower case characters.")
+ ))
+
+(defconst prolog-atom-char-regexp
+ (if (string-match "[[:alnum:]]" "0")
+ "[[:alnum:]_$]"
+ (format "[%s%s0-9_$]" prolog-lower-case-string prolog-upper-case-string))
+ "Regexp specifying characters which constitute atoms without quoting.")
+(defconst prolog-atom-regexp
+ (format "[%s$]%s*" prolog-lower-case-string prolog-atom-char-regexp))
+
+(defconst prolog-left-paren "[[({]" ;FIXME: Why not \\s(?
"The characters used as left parentheses for the indentation code.")
-(defconst prolog-right-paren "[])}]"
+(defconst prolog-right-paren "[])}]" ;FIXME: Why not \\s)?
"The characters used as right parentheses for the indentation code.")
(defconst prolog-quoted-atom-regexp
(defvar prolog-mode-specificators-i nil)
(defvar prolog-determinism-specificators-i nil)
(defvar prolog-directives-i nil)
-(defvar prolog-program-name-i nil)
-(defvar prolog-program-switches-i nil)
-(defvar prolog-consult-string-i nil)
-(defvar prolog-compile-string-i nil)
(defvar prolog-eof-string-i nil)
-(defvar prolog-prompt-regexp-i nil)
-(defvar prolog-continued-prompt-regexp-i nil)
+;; (defvar prolog-continued-prompt-regexp-i nil)
(defvar prolog-help-function-i nil)
(defvar prolog-align-rules
'(("dcg" . "-->") ("rule" . ":-") ("simplification" . "<=>")
("propagation" . "==>")))))
+;; SMIE support
+
+(require 'smie)
+
+(defvar prolog-use-smie t)
+
+(defun prolog-smie-forward-token ()
+ ;; FIXME: Add support for 0'<char>, if needed after adding it to
+ ;; syntax-propertize-functions.
+ (forward-comment (point-max))
+ (buffer-substring-no-properties
+ (point)
+ (progn (cond
+ ((looking-at "[!;]") (forward-char 1))
+ ((not (zerop (skip-chars-forward "#&*+-./:<=>?@\\^`~"))))
+ ((not (zerop (skip-syntax-forward "w_'"))))
+ ;; In case of non-ASCII punctuation.
+ ((not (zerop (skip-syntax-forward ".")))))
+ (point))))
+
+(defun prolog-smie-backward-token ()
+ ;; FIXME: Add support for 0'<char>, if needed after adding it to
+ ;; syntax-propertize-functions.
+ (forward-comment (- (point-max)))
+ (buffer-substring-no-properties
+ (point)
+ (progn (cond
+ ((memq (char-before) '(?! ?\;)) (forward-char -1))
+ ((not (zerop (skip-chars-backward "#&*+-./:<=>?@\\^`~"))))
+ ((not (zerop (skip-syntax-backward "w_'"))))
+ ;; In case of non-ASCII punctuation.
+ ((not (zerop (skip-syntax-backward ".")))))
+ (point))))
+
+(defconst prolog-smie-grammar
+ ;; Rather than construct the operator levels table from the BNF,
+ ;; we directly provide the operator precedences from GNU Prolog's
+ ;; manual (7.14.10 op/3). The only problem is that GNU Prolog's
+ ;; manual uses precedence levels in the opposite sense (higher
+ ;; numbers bind less tightly) than SMIE, so we use negative numbers.
+ '(("." -10000 -10000)
+ (":-" -1200 -1200)
+ ("-->" -1200 -1200)
+ (";" -1100 -1100)
+ ("->" -1050 -1050)
+ ("," -1000 -1000)
+ ("\\+" -900 -900)
+ ("=" -700 -700)
+ ("\\=" -700 -700)
+ ("=.." -700 -700)
+ ("==" -700 -700)
+ ("\\==" -700 -700)
+ ("@<" -700 -700)
+ ("@=<" -700 -700)
+ ("@>" -700 -700)
+ ("@>=" -700 -700)
+ ("is" -700 -700)
+ ("=:=" -700 -700)
+ ("=\\=" -700 -700)
+ ("<" -700 -700)
+ ("=<" -700 -700)
+ (">" -700 -700)
+ (">=" -700 -700)
+ (":" -600 -600)
+ ("+" -500 -500)
+ ("-" -500 -500)
+ ("/\\" -500 -500)
+ ("\\/" -500 -500)
+ ("*" -400 -400)
+ ("/" -400 -400)
+ ("//" -400 -400)
+ ("rem" -400 -400)
+ ("mod" -400 -400)
+ ("<<" -400 -400)
+ (">>" -400 -400)
+ ("**" -200 -200)
+ ("^" -200 -200)
+ ;; Prefix
+ ;; ("+" 200 200)
+ ;; ("-" 200 200)
+ ;; ("\\" 200 200)
+ (:smie-closer-alist (t . "."))
+ )
+ "Precedence levels of infix operators.")
+
+(defun prolog-smie-rules (kind token)
+ (pcase (cons kind token)
+ (`(:elem . basic) prolog-indent-width)
+ (`(:after . ".") '(column . 0)) ;; To work around smie-closer-alist.
+ (`(:after . ,(or `":-" `"->" `"-->")) prolog-indent-width)))
\f
;;-------------------------------------------------------------------
(defun prolog-find-value-by-system (alist)
"Get value from ALIST according to `prolog-system'."
- (if (listp alist)
- (let (result
- id)
- (while alist
- (setq id (car (car alist)))
- (if (or (eq id prolog-system)
- (eq id t)
- (and (listp id)
- (eval id)))
- (progn
- (setq result (car (cdr (car alist))))
- (if (and (listp result)
- (eq (car result) 'eval))
- (setq result (eval (car (cdr result)))))
- (setq alist nil))
- (setq alist (cdr alist))))
- result)
- alist))
+ (let ((system (or prolog-system
+ (let ((infbuf (prolog-inferior-buffer 'dont-run)))
+ (when infbuf
+ (buffer-local-value 'prolog-system infbuf))))))
+ (if (listp alist)
+ (let (result
+ id)
+ (while alist
+ (setq id (car (car alist)))
+ (if (or (eq id system)
+ (eq id t)
+ (and (listp id)
+ (eval id)))
+ (progn
+ (setq result (car (cdr (car alist))))
+ (if (and (listp result)
+ (eq (car result) 'eval))
+ (setq result (eval (car (cdr result)))))
+ (setq alist nil))
+ (setq alist (cdr alist))))
+ result)
+ alist)))
(defconst prolog-syntax-propertize-function
(when (fboundp 'syntax-propertize-rules)
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
(set (make-local-variable 'normal-auto-fill-function) 'prolog-do-auto-fill)
- (set (make-local-variable 'indent-line-function) 'prolog-indent-line)
(set (make-local-variable 'comment-start) "%")
(set (make-local-variable 'comment-end) "")
(set (make-local-variable 'comment-add) 1)
;; inside quoted atoms or strings
(format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)"
prolog-quoted-atom-regexp prolog-string-regexp))
- (set (make-local-variable 'comment-indent-function) 'prolog-comment-indent)
(set (make-local-variable 'parens-require-spaces) nil)
;; Initialize Prolog system specific variables
(dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
prolog-determinism-specificators prolog-directives
- prolog-program-name prolog-program-switches
- prolog-consult-string prolog-compile-string prolog-eof-string
- prolog-prompt-regexp prolog-continued-prompt-regexp
+ prolog-eof-string
+ ;; prolog-continued-prompt-regexp
prolog-help-function))
(set (intern (concat (symbol-name var) "-i"))
(prolog-find-value-by-system (symbol-value var))))
- (when (null prolog-program-name-i)
- (set (make-local-variable 'compile-command) prolog-compile-string-i))
+ (when (null (prolog-program-name))
+ (set (make-local-variable 'compile-command) (prolog-compile-string)))
(set (make-local-variable 'font-lock-defaults)
'(prolog-font-lock-keywords nil nil ((?_ . "w"))))
(set (make-local-variable 'syntax-propertize-function)
prolog-syntax-propertize-function)
+
+ (if prolog-use-smie
+ ;; Setup SMIE.
+ (smie-setup prolog-smie-grammar #'prolog-smie-rules
+ :forward-token #'prolog-smie-forward-token
+ :backward-token #'prolog-smie-backward-token)
+ (set (make-local-variable 'indent-line-function) 'prolog-indent-line))
)
(defun prolog-mode-keybindings-common (map)
(define-key map "\C-c/" 'prolog-help-apropos)
(define-key map "\C-c\C-d" 'prolog-debug-on)
(define-key map "\C-c\C-t" 'prolog-trace-on)
- (if (and (eq prolog-system 'sicstus)
- (prolog-atleast-version '(3 . 7)))
- (define-key map "\C-c\C-z" 'prolog-zip-on))
+ (define-key map "\C-c\C-z" 'prolog-zip-on)
(define-key map "\C-c\r" 'run-prolog))
(defun prolog-mode-keybindings-edit (map)
(define-key map "\C-c\C-l" 'prolog-consult-file)
(define-key map "\C-c\C-z" 'switch-to-prolog))
-(defun prolog-mode-keybindings-inferior (map)
+(defun prolog-mode-keybindings-inferior (_map)
"Define keybindings for inferior Prolog mode in MAP."
;; No inferior mode specific keybindings now.
)
(defvar prolog-mode-hook nil
- "List of functions to call after the prolog mode has initialised.")
+ "List of functions to call after the prolog mode has initialized.")
(unless (fboundp 'prog-mode)
(defalias 'prog-mode 'fundamental-mode))
((eq prolog-system 'gnu) "[GNU]")
(t ""))))
(prolog-mode-variables)
- (prolog-build-case-strings)
- (prolog-set-atom-regexps)
(dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar))
- ;; imenu entry moved to the appropriate hook for consistency
+ ;; `imenu' entry moved to the appropriate hook for consistency.
;; Load SICStus debugger if suitable
(if (and (eq prolog-system 'sicstus)
(let ((map (make-sparse-keymap)))
(prolog-mode-keybindings-common map)
(prolog-mode-keybindings-inferior map)
+ (define-key map [remap self-insert-command]
+ 'prolog-inferior-self-insert-command)
map))
(defvar prolog-inferior-mode-hook nil
- "List of functions to call after the inferior prolog mode has initialised.")
+ "List of functions to call after the inferior prolog mode has initialized.")
+
+(defvar prolog-inferior-error-regexp-alist
+ '(;; GNU Prolog used to not follow the GNU standard format.
+ ;; ("^\\(.*?\\):\\([0-9]+\\) error: .*(char:\\([0-9]+\\)" 1 2 3)
+ ;; SWI-Prolog.
+ ("^\\(?:\\?- *\\)?\\(\\(?:ERROR\\|\\(W\\)arning\\): *\\(.*?\\):\\([1-9][0-9]*\\):\\(?:\\([0-9]*\\):\\)?\\)\\(?:$\\| \\)"
+ 3 4 5 (2 . nil) 1)
+ ;; GNU-Prolog now uses the GNU standard format.
+ gnu))
+
+(defun prolog-inferior-self-insert-command ()
+ "Insert the char in the buffer or pass it directly to the process."
+ (interactive)
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (and proc (marker-position (process-mark proc)))))
+ ;; FIXME: the same treatment would be needed for SWI-Prolog, but I can't
+ ;; seem to find any way for Emacs to figure out when to use it because
+ ;; SWI doesn't include a " ? " or some such recognizable marker.
+ (if (and (eq prolog-system 'gnu)
+ pmark
+ (null current-prefix-arg)
+ (eobp)
+ (eq (point) pmark)
+ (save-excursion
+ (goto-char (- pmark 3))
+ ;; FIXME: check this comes from the process's output, maybe?
+ (looking-at " \\? ")))
+ ;; This is GNU prolog waiting to know whether you want more answers
+ ;; or not (or abort, etc...). The answer is a single char, not
+ ;; a line, so pass this char directly rather than wait for RET to
+ ;; send a whole line.
+ (comint-send-string proc (string last-command-event))
+ (call-interactively 'self-insert-command))))
+
+(declare-function 'compilation-shell-minor-mode "compile" (&optional arg))
+(defvar compilation-error-regexp-alist)
(define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog"
"Major mode for interacting with an inferior Prolog process.
To find out what version of Prolog mode you are running, enter
`\\[prolog-mode-version]'."
+ (require 'compile)
(setq comint-input-filter 'prolog-input-filter)
(setq mode-line-process '(": %s"))
(prolog-mode-variables)
- (setq comint-prompt-regexp prolog-prompt-regexp-i)
+ (setq comint-prompt-regexp (prolog-prompt-regexp))
(set (make-local-variable 'shell-dirstack-query) "pwd.")
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ prolog-inferior-error-regexp-alist)
+ (compilation-shell-minor-mode)
(prolog-inferior-menu))
(defun prolog-input-filter (str)
(cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace
- ((not (eq major-mode 'prolog-inferior-mode)) t)
+ ((not (derived-mode-p 'prolog-inferior-mode)) t)
((= (length str) 1) nil) ;one character
((string-match "\\`[rf] *[0-9]*\\'" str) nil) ;r(edo) or f(ail)
(t t)))
"Run an inferior Prolog process, input and output via buffer *prolog*.
With prefix argument ARG, restart the Prolog process if running before."
(interactive "P")
+ ;; FIXME: It should be possible to interactively specify the command to use
+ ;; to run prolog.
(if (and arg (get-process "prolog"))
(progn
(process-send-string "prolog" "halt.\n")
(prolog-ensure-process)
))
+(defun prolog-inferior-guess-flavor (&optional ignored)
+ (setq prolog-system
+ (when (or (numberp prolog-system) (markerp prolog-system))
+ (save-excursion
+ (goto-char (1+ prolog-system))
+ (cond
+ ((looking-at "GNU Prolog") 'gnu)
+ ((looking-at "Welcome to SWI-Prolog\\|%.*\\<swi_") 'swi)
+ ((looking-at ".*\n") nil) ;There's at least one line.
+ (t prolog-system)))))
+ (when (symbolp prolog-system)
+ (remove-hook 'comint-output-filter-functions
+ 'prolog-inferior-guess-flavor t)
+ (when prolog-system
+ (setq comint-prompt-regexp (prolog-prompt-regexp))
+ (if (eq prolog-system 'gnu)
+ (set (make-local-variable 'comint-process-echoes) t)))))
+
(defun prolog-ensure-process (&optional wait)
"If Prolog process is not running, run it.
If the optional argument WAIT is non-nil, wait for Prolog prompt specified by
the variable `prolog-prompt-regexp'."
- (if (null prolog-program-name-i)
+ (if (null (prolog-program-name))
(error "This Prolog system has defined no interpreter."))
(if (comint-check-proc "*prolog*")
()
- (apply 'make-comint "prolog" prolog-program-name-i nil
- prolog-program-switches-i)
- (with-current-buffer "*prolog*"
+ (with-current-buffer (get-buffer-create "*prolog*")
(prolog-inferior-mode)
+ (apply 'make-comint-in-buffer "prolog" (current-buffer)
+ (prolog-program-name) nil (prolog-program-switches))
+ (unless prolog-system
+ ;; Setup auto-detection.
+ (set (make-local-variable 'prolog-system)
+ ;; Force re-detection.
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (and proc (marker-position (process-mark proc)))))
+ (cond
+ ((null pmark) (1- (point-min)))
+ ;; The use of insert-before-markers in comint.el together with
+ ;; the potential use of comint-truncate-buffer in the output
+ ;; filter, means that it's difficult to reliably keep track of
+ ;; the buffer position where the process's output started.
+ ;; If possible we use a marker at "start - 1", so that
+ ;; insert-before-marker at `start' won't shift it. And if not,
+ ;; we fall back on using a plain integer.
+ ((> pmark (point-min)) (copy-marker (1- pmark)))
+ (t (1- pmark)))))
+ (add-hook 'comint-output-filter-functions
+ 'prolog-inferior-guess-flavor nil t))
(if wait
(progn
(goto-char (point-max))
(save-excursion
(not
(re-search-backward
- (concat "\\(" prolog-prompt-regexp-i "\\)" "\\=")
+ (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
nil t)))
(sit-for 0.1)))))))
+(defun prolog-inferior-buffer (&optional dont-run)
+ (or (get-buffer "*prolog*")
+ (unless dont-run
+ (prolog-ensure-process)
+ (get-buffer "*prolog*"))))
+
(defun prolog-process-insert-string (process string)
"Insert STRING into inferior Prolog buffer running PROCESS."
;; Copied from elisp manual, greek to me
;; Old consulting and compiling functions
;;------------------------------------------------------------
+(declare-function compilation-forget-errors "compile" ())
+(declare-function compilation-fake-loc "compile"
+ (marker file &optional line col))
+
(defun prolog-old-process-region (compilep start end)
"Process the region limited by START and END positions.
If COMPILEP is non-nil then use compilation, otherwise consulting."
(prolog-ensure-process)
;(let ((tmpfile prolog-temp-filename)
- (let ((tmpfile (prolog-bsts (prolog-temporary-file)))
+ (let ((tmpfile (prolog-temporary-file))
;(process (get-process "prolog"))
(first-line (1+ (count-lines
(point-min)
(goto-char start)
(point))))))
(write-region start end tmpfile)
+ (setq start (copy-marker start))
+ (with-current-buffer (prolog-inferior-buffer)
+ (compilation-forget-errors)
+ (compilation-fake-loc start tmpfile))
(process-send-string
"prolog" (prolog-build-prolog-command
compilep tmpfile (prolog-bsts buffer-file-name)
If COMPILEP is non-nil then use compilation, otherwise consulting."
(save-some-buffers)
(prolog-ensure-process)
- (let ((filename (prolog-bsts buffer-file-name)))
+ (with-current-buffer (prolog-inferior-buffer)
+ (compilation-forget-errors))
(process-send-string
"prolog" (prolog-build-prolog-command
- compilep filename filename))
- (prolog-goto-prolog-process-buffer)))
+ compilep buffer-file-name
+ (prolog-bsts buffer-file-name)))
+ (prolog-goto-prolog-process-buffer))
\f
;;------------------------------------------------------------
;; Consulting and compiling
;;------------------------------------------------------------
-;;; Interactive interface functions, used by both the standard
-;;; and the experimental consultation and compilation functions
+;; Interactive interface functions, used by both the standard
+;; and the experimental consultation and compilation functions
(defun prolog-consult-file ()
"Consult file of current buffer."
(interactive)
"Make Prolog command for FILE compilation/consulting.
If COMPILEP is non-nil, consider compilation, otherwise consulting."
(let* ((compile-string
- (if compilep prolog-compile-string-i prolog-consult-string-i))
+ ;; FIXME: If the process is not running yet, the auto-detection of
+ ;; prolog-system won't help here, so we should make sure
+ ;; we first run Prolog and then build the command.
+ (if compilep (prolog-compile-string) (prolog-consult-string)))
(module (prolog-buffer-module))
- (file-name (concat "'" file "'"))
+ (file-name (concat "'" (prolog-bsts file) "'"))
(module-name (if module (concat "'" module "'")))
(module-file (if module
(concat module-name ":" file-name)
(setq compile-string (concat strbeg (format "%d" lineoffset) strend)))
(concat compile-string "\n")))
-;;; The rest of this page is experimental code!
+;; The rest of this page is experimental code!
;; Global variables for process filter function
(defvar prolog-process-flag nil
(defvar prolog-consult-compile-real-file nil
"The file name of the buffer to compile/consult.")
+(defvar compilation-parse-errors-function)
+
(defun prolog-consult-compile (compilep file &optional first-line)
"Consult/compile FILE.
If COMPILEP is non-nil, perform compilation, otherwise perform CONSULTING.
(old-filter (process-filter process)))
(with-current-buffer buffer
(delete-region (point-min) (point-max))
+ ;; FIXME: Wasn't this supposed to use prolog-inferior-mode?
(compilation-mode)
+ ;; FIXME: This doesn't seem to cooperate well with new(ish) compile.el.
;; Setting up font-locking for this buffer
(set (make-local-variable 'font-lock-defaults)
'(prolog-font-lock-keywords nil nil ((?_ . "w"))))
(if (eq prolog-system 'sicstus)
- (progn
+ ;; FIXME: This looks really problematic: not only is this using
+ ;; the old compilation-parse-errors-function, but
+ ;; prolog-parse-sicstus-compilation-errors only accepts one argument
+ ;; whereas compile.el calls it with 2 (and did so at least since
+ ;; Emacs-20).
(set (make-local-variable 'compilation-parse-errors-function)
- 'prolog-parse-sicstus-compilation-errors)))
- (toggle-read-only 0)
+ 'prolog-parse-sicstus-compilation-errors))
+ (setq buffer-read-only nil)
(insert command-string "\n"))
(save-selected-window
(pop-to-buffer buffer))
"\nConsulted.\n"))
(set-process-filter process old-filter))))
+(defvar compilation-error-list)
+
(defun prolog-parse-sicstus-compilation-errors (limit)
"Parse the prolog compilation buffer for errors.
Argument LIMIT is a buffer position limiting searching.
limit t)
(setq filepath (match-string 2)))
- ;; ###### Does this work with SICStus under Windows (i.e. backslahes and stuff?)
+ ;; ###### Does this work with SICStus under Windows
+ ;; (i.e. backslashes and stuff?)
(if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath)
(progn
(setq dir (match-string 1 filepath))
;; If temporary files were used, then we change the error
;; messages to point to the original source file.
+ ;; FIXME: Use compilation-fake-loc instead.
(cond
;; If the prolog process was in trace mode then it requires
(insert output)))
;; If the prompt is visible, then the task is finished
- (if (string-match prolog-prompt-regexp-i prolog-consult-compile-output)
+ (if (string-match (prolog-prompt-regexp) prolog-consult-compile-output)
(setq prolog-process-flag nil)))
(defun prolog-consult-compile-file (compilep)
(write-region beg end file nil 'no-message)
(write-region "\n" nil file t 'no-message)
(prolog-consult-compile compilep file
- (if (looking-at "^") (1+ lines) lines))
+ (if (bolp) (1+ lines) lines))
(delete-file file)))
(defun prolog-consult-compile-predicate (compilep)
;; Font-lock stuff
;;-------------------------------------------------------------------
-;; Auxilliary functions
+;; Auxiliary functions
(defun prolog-make-keywords-regexp (keywords &optional protect)
"Create regexp from the list of strings KEYWORDS.
If PROTECT is non-nil, surround the result regexp by word breaks."
(defface prolog-builtin-face
'((((class color) (background light)) (:foreground "Purple"))
(((class color) (background dark)) (:foreground "Cyan"))
- (((class grayscale) (background light)) (:foreground "LightGray" :bold t))
+ (((class grayscale) (background light))
+ :foreground "LightGray" :bold t)
(((class grayscale) (background dark)) (:foreground "DimGray" :bold t))
(t (:bold t)))
"Face name to use for compiler warnings."
0 'prolog-warning-face)))
;; Inferior mode specific patterns
(prompt
- (list prolog-prompt-regexp-i 0 'font-lock-keyword-face))
+ ;; FIXME: Should be handled by comint already.
+ (list (prolog-prompt-regexp) 0 'font-lock-keyword-face))
(trace-exit
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
(cond
((eq prolog-system 'sicstus)
'("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exit\\):"
'("[ \t]*\\(Exit\\):[ \t]*([ \t0-9]*)" 1 prolog-exit-face))
(t nil)))
(trace-fail
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
(cond
((eq prolog-system 'sicstus)
'("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Fail\\):"
'("[ \t]*\\(Fail\\):[ \t]*([ \t0-9]*)" 1 prolog-warning-face))
(t nil)))
(trace-redo
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
(cond
((eq prolog-system 'sicstus)
'("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Redo\\):"
'("[ \t]*\\(Redo\\):[ \t]*([ \t0-9]*)" 1 prolog-redo-face))
(t nil)))
(trace-call
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
(cond
((eq prolog-system 'sicstus)
'("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Call\\):"
1 font-lock-function-name-face))
(t nil)))
(trace-exception
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
(cond
((eq prolog-system 'sicstus)
'("[ \t]*[0-9]+[ \t]+[0-9]+[ \t]*\\(Exception\\):"
1 prolog-exception-face))
(t nil)))
(error-message-identifier
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
(cond
((eq prolog-system 'sicstus)
'("{\\([A-Z]* ?ERROR:\\)" 1 prolog-exception-face prepend))
'("^[[]\\(WARNING:\\)" 1 prolog-builtin-face prepend))
(t nil)))
(error-whole-messages
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
(cond
((eq prolog-system 'sicstus)
'("{\\([A-Z]* ?ERROR:.*\\)}[ \t]*$"
'("^[[]WARNING:[^]]*[]]$" 0 font-lock-comment-face append))
(t nil)))
(error-warning-messages
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
;; Mostly errors that SICStus asks the user about how to solve,
;; such as "NAME CLASH:" for example.
(cond
'("^[A-Z ]*[A-Z]+:" 0 prolog-warning-face))
(t nil)))
(warning-messages
+ ;; FIXME: Add to compilation-error-regexp-alist instead.
(cond
((eq prolog-system 'sicstus)
'("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$"
;; NB: This function *MUST* have this optional argument since XEmacs
;; assumes it. This does not mean we have to use it...
-(defun prolog-indent-line (&optional whole-exp)
+(defun prolog-indent-line (&optional _whole-exp)
"Indent current line as Prolog code.
With argument, indent any additional lines of the same clause
rigidly along with this one (not yet)."
(interactive "p")
(let ((indent (prolog-indent-level))
- (pos (- (point-max) (point))) beg)
+ (pos (- (point-max) (point))))
(beginning-of-line)
- (setq beg (point))
(skip-chars-forward " \t")
(indent-line-to indent)
(if (> (- (point-max) pos) (point))
(prolog-insert-spaces-after-paren))
))
-(defun prolog-comment-indent ()
- "Compute prolog comment indentation."
- ;; FIXME: Only difference with default behavior is that %%% is not
- ;; flushed to column 0 but just left where the user put it.
- (cond ((looking-at "%%%") (prolog-indentation-level-of-line))
- ((looking-at "%%") (prolog-indent-level))
- (t
- (save-excursion
- (skip-chars-backward " \t")
- ;; Insert one space at least, except at left margin.
- (max (+ (current-column) (if (bolp) 0 1))
- comment-column)))
- ))
-
(defun prolog-indent-level ()
"Compute prolog indentation level."
(save-excursion
"Enable zipping (for SICStus 3.7 and later).
When called with prefix argument ARG, disable zipping instead."
(interactive "P")
+ (if (not (and (eq prolog-system 'sicstus)
+ (prolog-atleast-version '(3 . 7))))
+ (error "Only works for SICStus 3.7 and later"))
(if arg
(prolog-zip-off)
(prolog-process-insert-string (get-process "prolog")
(save-excursion
(let ((state (prolog-clause-info))
(object (prolog-in-object)))
- (if (or (equal (nth 0 state) "") (equal (prolog-in-string-or-comment) 'cmt))
+ (if (or (equal (nth 0 state) "")
+ (equal (prolog-in-string-or-comment) 'cmt))
nil
(if (and (eq prolog-system 'sicstus)
object)
(defun prolog-pred-start ()
"Return the starting point of the first clause of the current predicate."
+ ;; FIXME: Use SMIE.
(save-excursion
(goto-char (prolog-clause-start))
;; Find first clause, unless it was a directive
(defun prolog-pred-end ()
"Return the position at the end of the last clause of the current predicate."
+ ;; FIXME: Use SMIE.
(save-excursion
- (goto-char (prolog-clause-end)) ; if we are before the first predicate
+ (goto-char (prolog-clause-end)) ; If we are before the first predicate.
(goto-char (prolog-clause-start))
(let* ((pinfo (prolog-clause-info))
(predname (nth 0 pinfo))
(defun prolog-clause-start (&optional not-allow-methods)
"Return the position at the start of the head of the current clause.
If NOTALLOWMETHODS is non-nil then do not match on methods in
-objects (relevent only if 'prolog-system' is set to 'sicstus)."
+objects (relevant only if 'prolog-system' is set to 'sicstus)."
(save-excursion
(let ((notdone t)
(retval (point-min)))
(defun prolog-clause-end (&optional not-allow-methods)
"Return the position at the end of the current clause.
If NOTALLOWMETHODS is non-nil then do not match on methods in
-objects (relevent only if 'prolog-system' is set to 'sicstus)."
+objects (relevant only if 'prolog-system' is set to 'sicstus)."
(save-excursion
(beginning-of-line) ; Necessary since we use "^...." for the search.
(if (re-search-forward
(defun prolog-beginning-of-predicate ()
"Go to the nearest beginning of predicate before current point.
Return the final point or nil if no such a beginning was found."
+ ;; FIXME: Hook into beginning-of-defun.
(interactive)
(let ((op (point))
(pos (prolog-pred-start)))
(defun prolog-end-of-predicate ()
"Go to the end of the current predicate."
+ ;; FIXME: Hook into end-of-defun.
(interactive)
(let ((op (point)))
(goto-char (prolog-pred-end))
(indent-for-comment)))
(defun prolog-indent-predicate ()
- "*Indent the current predicate."
+ "Indent the current predicate."
(interactive)
(indent-region (prolog-pred-start) (prolog-pred-end) nil))
(defun prolog-indent-buffer ()
- "*Indent the entire buffer."
+ "Indent the entire buffer."
(interactive)
(indent-region (point-min) (point-max) nil))
"Delete preceding character or whitespace.
If `prolog-hungry-delete-key-flag' is non-nil, then all preceding whitespace is
consumed. If however an ARG is supplied, or `prolog-hungry-delete-key-flag' is
-nil, or point is inside a literal then the function in the variable
+nil, or point is inside a literal then the function
`backward-delete-char' is called."
(interactive "P")
(if (or (not prolog-hungry-delete-key-flag)
(defun prolog-electric-if-then-else (arg)
"If `prolog-electric-if-then-else-flag' is non-nil, indent if-then-else constructs.
Bound to the >, ; and ( keys."
+ ;; FIXME: Use post-self-insert-hook or electric-indent-mode.
(interactive "P")
(self-insert-command (prefix-numeric-value arg))
(if prolog-electric-if-then-else-flag (prolog-insert-spaces-after-paren)))
That is, insert space (if appropriate), `:-' and newline if colon is pressed
at the end of a line that starts in the first column (i.e., clause
heads)."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
(if (and prolog-electric-colon-flag
(null arg)
(unless (save-excursion (backward-char 1) (looking-at "\\s "))
(insert " "))
(insert ":-\n")
- (prolog-indent-line))
+ (indent-according-to-mode))
(self-insert-command (prefix-numeric-value arg))))
(defun prolog-electric-dash (arg)
that is, insert space (if appropriate), `-->' and newline if dash is pressed
at the end of a line that starts in the first column (i.e., DCG
heads)."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
(if (and prolog-electric-dash-flag
(null arg)
(unless (save-excursion (backward-char 1) (looking-at "\\s "))
(insert " "))
(insert "-->\n")
- (prolog-indent-line))
+ (indent-according-to-mode))
(self-insert-command (prefix-numeric-value arg))))
(defun prolog-electric-dot (arg)
of the current predicate.
When called with prefix argument ARG, insert just dot."
+ ;; FIXME: Use post-self-insert-hook.
(interactive "P")
;; Check for situations when the electricity should not be active
(if (or (not prolog-electric-dot-flag)
on a variable then replace the variable with underscore and skip
the following comma and whitespace, if any.
If the point is not on a variable then insert underscore."
+ ;; FIXME: Use post-self-insert-hook.
(interactive)
(if prolog-electric-underscore-flag
(let (;start
(defun prolog-find-term (functor arity &optional prefix)
- "Go to the position at the start of the next occurance of a term.
+ "Go to the position at the start of the next occurrence of a term.
The term is specified with FUNCTOR and ARITY. The optional argument
PREFIX is the prefix of the search regexp."
(let* (;; If prefix is not set then use the default "\\<"
(backward-char)))
)))
+;;(defun prolog-regexp-dash-continuous-chars (chars)
+;; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
+;; (beg 0)
+;; (end 0))
+;; (if (null ints)
+;; chars
+;; (while (and (< (+ beg 1) (length chars))
+;; (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
+;; (= (nth beg ints) (nth (+ beg 1) ints)))))
+;; (setq beg (+ beg 1)))
+;; (setq beg (+ beg 1)
+;; end beg)
+;; (while (and (< (+ end 1) (length chars))
+;; (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
+;; (= (nth end ints) (nth (+ end 1) ints))))
+;; (setq end (+ end 1)))
+;; (if (equal (substring chars end) "")
+;; (substring chars 0 beg)
+;; (concat (substring chars 0 beg) "-"
+;; (prolog-regexp-dash-continuous-chars (substring chars end))))
+;; )))
+
+;;(defun prolog-condense-character-sets (regexp)
+;; "Condense adjacent characters in character sets of REGEXP."
+;; (let ((next -1))
+;; (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
+;; (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
+;; t t regexp 1))))
+;; regexp)
-(defun prolog-set-atom-regexps ()
- "Set the `prolog-atom-char-regexp' and `prolog-atom-regexp' variables.
-Must be called after `prolog-build-case-strings'."
- (setq prolog-atom-char-regexp
- (format "[%s%s0-9_$]"
- ;; FIXME: why not a-zA-Z?
- prolog-lower-case-string
- prolog-upper-case-string))
- (setq prolog-atom-regexp
- (format "[%s$]%s*"
- prolog-lower-case-string
- prolog-atom-char-regexp))
- )
-
-(defun prolog-build-case-strings ()
- "Set `prolog-upper-case-string' and `prolog-lower-case-string'.
-Uses the current case-table for extracting the relevant information."
- (let ((up_string "")
- (low_string ""))
- ;; Use `map-char-table' if it is defined. Otherwise enumerate all
- ;; numbers between 0 and 255. `map-char-table' is probably safer.
- ;;
- ;; `map-char-table' causes problems under Emacs 23.0.0.1, the
- ;; while loop seems to do its job well (Ryszard Szopa)
- ;;
- ;;(if (and (not (featurep 'xemacs))
- ;; (fboundp 'map-char-table))
- ;; (map-char-table
- ;; (lambda (key value)
- ;; (cond
- ;; ((and
- ;; (eq (prolog-int-to-char key) (downcase key))
- ;; (eq (prolog-int-to-char key) (upcase key)))
- ;; ;; Do nothing if upper and lower case are the same
- ;; )
- ;; ((eq (prolog-int-to-char key) (downcase key))
- ;; ;; The char is lower case
- ;; (setq low_string (format "%s%c" low_string key)))
- ;; ((eq (prolog-int-to-char key) (upcase key))
- ;; ;; The char is upper case
- ;; (setq up_string (format "%s%c" up_string key)))
- ;; ))
- ;; (current-case-table))
- ;; `map-char-table' was undefined.
- (let ((key 0))
- (while (< key 256)
- (cond
- ((and
- (eq (prolog-int-to-char key) (downcase key))
- (eq (prolog-int-to-char key) (upcase key)))
- ;; Do nothing if upper and lower case are the same
- )
- ((eq (prolog-int-to-char key) (downcase key))
- ;; The char is lower case
- (setq low_string (format "%s%c" low_string key)))
- ((eq (prolog-int-to-char key) (upcase key))
- ;; The char is upper case
- (setq up_string (format "%s%c" up_string key)))
- )
- (setq key (1+ key))))
- ;; )
- ;; The strings are single-byte strings
- (setq prolog-upper-case-string (prolog-dash-letters up_string))
- (setq prolog-lower-case-string (prolog-dash-letters low_string))
- ))
-
-;(defun prolog-regexp-dash-continuous-chars (chars)
-; (let ((ints (mapcar #'prolog-char-to-int (string-to-list chars)))
-; (beg 0)
-; (end 0))
-; (if (null ints)
-; chars
-; (while (and (< (+ beg 1) (length chars))
-; (not (or (= (+ (nth beg ints) 1) (nth (+ beg 1) ints))
-; (= (nth beg ints) (nth (+ beg 1) ints)))))
-; (setq beg (+ beg 1)))
-; (setq beg (+ beg 1)
-; end beg)
-; (while (and (< (+ end 1) (length chars))
-; (or (= (+ (nth end ints) 1) (nth (+ end 1) ints))
-; (= (nth end ints) (nth (+ end 1) ints))))
-; (setq end (+ end 1)))
-; (if (equal (substring chars end) "")
-; (substring chars 0 beg)
-; (concat (substring chars 0 beg) "-"
-; (prolog-regexp-dash-continuous-chars (substring chars end))))
-; )))
-
-(defun prolog-ints-intervals (ints)
- "Return a list of intervals (from . to) covering INTS."
- (when ints
- (setq ints (sort ints '<))
- (let ((prev (car ints))
- (interval-start (car ints))
- intervals)
- (while ints
- (let ((next (car ints)))
- (when (> next (1+ prev)) ; start of new interval
- (setq intervals (cons (cons interval-start prev) intervals))
- (setq interval-start next))
- (setq prev next)
- (setq ints (cdr ints))))
- (setq intervals (cons (cons interval-start prev) intervals))
- (reverse intervals))))
-
-(defun prolog-dash-letters (string)
- "Return a condensed regexp covering all letters in STRING."
- (let ((intervals (prolog-ints-intervals (mapcar #'prolog-char-to-int
- (string-to-list string))))
- codes)
- (while intervals
- (let* ((i (car intervals))
- (from (car i))
- (to (cdr i))
- (c (cond ((= from to) `(,from))
- ((= (1+ from) to) `(,from ,to))
- (t `(,from ?- ,to)))))
- (setq codes (cons c codes)))
- (setq intervals (cdr intervals)))
- (apply 'concat (reverse codes))))
-
-;(defun prolog-condense-character-sets (regexp)
-; "Condense adjacent characters in character sets of REGEXP."
-; (let ((next -1))
-; (while (setq next (string-match "\\[\\(.*?\\)\\]" regexp (1+ next)))
-; (setq regexp (replace-match (prolog-dash-letters (match-string 1 regexp))
-; t t regexp 1))))
-; regexp)
-
-;; GNU Emacs compatibility: GNU Emacs does not differentiate between
-;; ints and chars, or at least these two are interchangeable.
-(defalias 'prolog-int-to-char
- (if (fboundp 'int-to-char) #'int-to-char #'identity))
-
-(defalias 'prolog-char-to-int
- (if (fboundp 'char-to-int) #'char-to-int #'identity))
-\f
;;-------------------------------------------------------------------
;; Menu stuff (both for the editing buffer and for the inferior
;; prolog buffer)
["Beginning of predicate" prolog-beginning-of-predicate t]
["End of predicate" prolog-end-of-predicate t]
"---"
- ["Indent line" prolog-indent-line t]
+ ["Indent line" indent-according-to-mode t]
["Indent region" indent-region (region-exists-p)]
["Indent predicate" prolog-indent-predicate t]
["Indent buffer" prolog-indent-buffer t]