;;; prolog.el --- major mode for editing and running Prolog (and Mercury) code
-;; Copyright (C) 1986, 1987, 1997, 1998, 1999, 2002, 2003, 2011 Free Software Foundation, Inc.
+;; 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
;; auto-mode-alist))
;;
;; where the path in the first line is the file system path to this file.
-;; MSDOS paths can be written like "d:/programs/emacs-19.34/site-lisp".
+;; MSDOS paths can be written like "d:/programs/emacs-19.34/site-lisp".
;; Note: In XEmacs, either `/usr/lib/xemacs/site-lisp' (RPM default in
;; Red Hat-based distributions) or `/usr/local/lib/xemacs/site-lisp'
;; (default when compiling from sources) are automatically added to
;;
;; % -*- Mode: Prolog -*-
;;
-;; and then the file will be open in Prolog mode no matter its
+;; and then the file will be open in Prolog mode no matter its
;; extension, or
;;
-;; o manually switch to prolog mode after opening a Prolog file, by typing
+;; o manually switch to prolog mode after opening a Prolog file, by typing
;; M-x prolog-mode.
;;
;; If the command to start the prolog process ('sicstus', 'pl' or
;; 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:
;; Version 1.19:
;; o Minimal changes for Aquamacs inclusion and in general for
;; better coping with finding the Prolog executable. Patch
-;; provided by David Reitter
+;; provided by David Reitter
;; Version 1.18:
;; o Fixed syntax highlighting for clause heads that do not begin at
;; the beginning of the line.
;; 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:
;; o Fixed dots in the end of line comments causing indentation
;; problems. The following code is now correctly indented (note
;; the dot terminating the comment):
-;; a(X) :- b(X),
+;; a(X) :- b(X),
;; c(X). % comment here.
;; a(X).
;; and so is this (and variants):
-;; a(X) :- b(X),
+;; a(X) :- b(X),
;; c(X). /* comment here. */
;; a(X).
;; Version 1.0:
;; anyway.
;; o Fixed prolog-pred-start, prolog-clause-start, prolog-clause-info.
;; o Fix for prolog-build-case-strings; now prolog-upper-case-string
-;; and prolog-lower-case-string are correctly initialized,
+;; and prolog-lower-case-string are correctly initialized,
;; o Various font-lock changes; most importantly, block comments (/*
;; ... */) are now correctly fontified in XEmacs even when they
;; extend on multiple lines.
-;; Version 0.1.36:
+;; Version 0.1.36:
;; o The debug prompt of SWI Prolog is now correctly recognized.
-;; Version 0.1.35:
+;; Version 0.1.35:
;; o Minor font-lock bug fixes.
+;;; TODO:
+
+;; Replace ":type 'sexp" with more precise Custom types.
\f
;;; 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)
+ :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)))
"ensure_loaded" "foreign" "include" "initialization" "multifile" "op"
"public" "set_prolog_flag"))
(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.
If dot is pressed at the beginning of an empty line, it inserts the head
of a new clause for the current predicate. It does not apply in strings
-and comments.
+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 `('
-for recursive calls or new clause heads. Non-nil means to also
-insert enough commata to cover the predicate's arity 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 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).
-If non-nil, pressing `:' at the end of a line that starts in
+ "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)
;; Miscellaneous
-(defcustom prolog-use-prolog-tokenizer-flag t
- "*Non-nil means use the internal prolog tokenizer for indentation etc.
+(defcustom prolog-use-prolog-tokenizer-flag
+ (not (fboundp 'syntax-propertize-rules))
+ "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
- ;; FIXME: Use syntax-propertize-function to fix it right.
- "*If non-nil, declare 0 as a quote character so that 0'<char> does not break syntax highlighting.
-This is really kludgy but I have not found any better way of handling it."
+ "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)
;;(defvar prolog-temp-filename "") ; Later set by `prolog-temporary-file'
(defvar prolog-mode-syntax-table
+ ;; The syntax accepted varies depending on the implementation used.
+ ;; Here are some of the differences:
+ ;; - SWI-Prolog accepts nested /*..*/ comments.
+ ;; - Edinburgh-style Prologs take <radix>'<number> for non-decimal number,
+ ;; whereas ISO-style Prologs use 0[obx]<number> instead.
+ ;; - In atoms \x<hex> sometimes needs a terminating \ (ISO-style)
+ ;; and sometimes not.
(let ((table (make-syntax-table)))
(if prolog-underscore-wordchar-flag
(modify-syntax-entry ?_ "w" table)
(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 "[[({]"
+(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
(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)
+ (syntax-propertize-rules
+ ;; GNU Prolog only accepts 0'\' rather than 0'', but the only
+ ;; possible meaning of 0'' is rather clear.
+ ("\\<0\\(''?\\)"
+ (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
+ (string-to-syntax "_"))))
+ ;; We could check that we're not inside an atom, but I don't think
+ ;; that 'foo 8'z could be a valid syntax anyway, so why bother?
+ ("\\<[1-9][0-9]*\\('\\)[0-9a-zA-Z]" (1 "_"))
+ ;; Supposedly, ISO-Prolog wants \NNN\ for octal and \xNNN\ for hexadecimal
+ ;; escape sequences in atoms, so be careful not to let the terminating \
+ ;; escape a subsequent quote.
+ ("\\\\[x0-7][0-9a-fA-F]*\\(\\\\\\)" (1 "_"))
+ )))
(defun prolog-mode-variables ()
"Set some common variables to Prolog code specific values."
(setq local-abbrev-table prolog-mode-abbrev-table)
- (make-local-variable 'paragraph-start)
- (setq paragraph-start (concat "[ \t]*$\\|" page-delimiter)) ;'%%..'
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate paragraph-start)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (setq paragraph-ignore-fill-prefix t)
- (make-local-variable 'normal-auto-fill-function)
- (setq normal-auto-fill-function 'prolog-do-auto-fill)
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'prolog-indent-line)
- (make-local-variable 'comment-start)
- (setq comment-start "%")
- (make-local-variable 'comment-end)
- (setq comment-end "")
- (make-local-variable 'comment-start-skip)
- ;; This complex regexp makes sure that comments cannot start
- ;; inside quoted atoms or strings
- (setq comment-start-skip
- (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)"
- prolog-quoted-atom-regexp prolog-string-regexp))
- (make-local-variable 'comment-column)
- (make-local-variable 'comment-indent-function)
- (setq comment-indent-function 'prolog-comment-indent)
- (make-local-variable 'parens-require-spaces)
- (setq parens-require-spaces nil)
+ (set (make-local-variable 'paragraph-start)
+ (concat "[ \t]*$\\|" page-delimiter)) ;'%%..'
+ (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)
+ (set (make-local-variable 'comment-start-skip)
+ ;; This complex regexp makes sure that comments cannot start
+ ;; 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
- (let ((vars '(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-help-function)))
- (while vars
- (set (intern (concat (symbol-name (car vars)) "-i"))
- (prolog-find-value-by-system (symbol-value (car vars))))
- (setq vars (cdr vars))))
- (when (null prolog-program-name-i)
- (make-local-variable 'compile-command)
- (setq compile-command prolog-compile-string-i))
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults
- '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
-)
+ (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
+ prolog-determinism-specificators prolog-directives
+ 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))
+ (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)
+ )
(defun prolog-mode-keybindings-common (map)
"Define keybindings common to both Prolog modes in 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 ">" 'prolog-electric-if-then-else)
(define-key map ":" 'prolog-electric-colon)
(define-key map "-" 'prolog-electric-dash)
- (if prolog-electric-newline-flag
+ (if prolog-electric-newline-flag
(define-key map "\r" 'newline-and-indent))
;; If we're running SICStus, then map C-c C-c e/d to enabling
(define-key map "\C-c\C-cr" 'prolog-compile-region)
(define-key map "\C-c\C-cb" 'prolog-compile-buffer)
(define-key map "\C-c\C-cf" 'prolog-compile-file))
-
+
;; Inherited from the old prolog.el.
(define-key map "\e\C-x" 'prolog-consult-region)
(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.
)
(prolog-mode-keybindings-common map)
(prolog-mode-keybindings-edit map)
map))
-
+
(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))
(dolist (ar prolog-align-rules) (add-to-list 'align-rules-list ar))
;; imenu entry moved to the appropriate hook for consistency
-
+
;; Load SICStus debugger if suitable
(if (and (eq prolog-system 'sicstus)
(prolog-atleast-version '(3 . 7))
prolog-use-sicstus-sd)
- (prolog-enable-sicstus-sd)))
+ (prolog-enable-sicstus-sd))
+
+ (prolog-menu))
(defvar mercury-mode-map
(let ((map (make-sparse-keymap)))
(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)
- (set (make-local-variable 'shell-dirstack-query) "pwd."))
+ (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)
+ (first-line (1+ (count-lines
+ (point-min)
(save-excursion
(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)))
+ "prolog" (prolog-build-prolog-command
+ 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)
(save-excursion
(goto-char (point-min))
(skip-chars-forward " \t")
- (and (search-forward "-*-" (save-excursion (end-of-line) (point)) t)
+ (and (search-forward "-*-" (line-end-position) t)
(progn
(skip-chars-forward " \t")
(setq beg (point))
- (search-forward "-*-" (save-excursion (end-of-line) (point)) t))
+ (search-forward "-*-" (line-end-position) t))
(progn
(forward-char -3)
(skip-chars-backward " \t")
(skip-chars-backward " \t")
(buffer-substring beg (point)))))))))
-(defun prolog-build-prolog-command (compilep file buffername
+(defun prolog-build-prolog-command (compilep file buffername
&optional first-line)
"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)
(if (not buffername)
(error "The buffer is not saved"))
- (if (not (string-match "^'.*'$" buffername)) ; Add quotes
+ (if (not (string-match "\\`'.*'\\'" buffername)) ; Add quotes
(setq buffername (concat "'" buffername "'")))
(while (string-match "%m" compile-string)
(setq strbeg (substring compile-string 0 (match-beginning 0)))
(setq strend (substring compile-string (match-end 0)))
(setq compile-string (concat strbeg module-file strend)))
+ ;; FIXME: The code below will %-expand any %[fbl] that appears in
+ ;; module-file.
(while (string-match "%f" compile-string)
(setq strbeg (substring compile-string 0 (match-beginning 0)))
(setq strend (substring compile-string (match-end 0)))
(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
- "Non-nil means that a prolog task (i.e. a consultation or compilation job)
+ "Non-nil means that a prolog task (i.e. a consultation or compilation job)
is running.")
(defvar prolog-consult-compile-output ""
"Hold the unprocessed output from the current prolog task.")
(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.
(prolog-ensure-process t)
(let* ((buffer (get-buffer-create prolog-compilation-buffer))
(real-file buffer-file-name)
- (command-string (prolog-build-prolog-command compilep file
+ (command-string (prolog-build-prolog-command compilep file
real-file first-line))
(process (get-process "prolog"))
(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
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults
- '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
+ (set (make-local-variable 'font-lock-defaults)
+ '(prolog-font-lock-keywords nil nil ((?_ . "w"))))
(if (eq prolog-system 'sicstus)
- (progn
- (make-local-variable 'compilation-parse-errors-function)
- (setq compilation-parse-errors-function
- 'prolog-parse-sicstus-compilation-errors)))
- (toggle-read-only 0)
+ ;; 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))
+ (setq buffer-read-only nil)
(insert command-string "\n"))
(save-selected-window
(pop-to-buffer buffer))
prolog-consult-compile-output ""
prolog-consult-compile-first-line (if first-line (1- first-line) 0)
prolog-consult-compile-file file
- prolog-consult-compile-real-file (if (string=
+ prolog-consult-compile-real-file (if (string=
file buffer-file-name)
nil
real-file))
(accept-process-output process 10)) ; 10 secs is ok?
(sit-for 0.1)
(unless (get-process "prolog")
- (setq prolog-process-flag nil)))
+ (setq prolog-process-flag nil)))
(insert (if compilep
"\nCompilation finished.\n"
"\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.
(setq compilation-error-list nil)
(message "Parsing SICStus error messages...")
(let (filepath dir file errorline)
- (while
+ (while
(re-search-backward
"{\\([a-zA-Z ]* ERROR\\|Warning\\):.* in line[s ]*\\([0-9]+\\)"
limit t)
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))
(while (and prolog-process-flag
(or
;; Trace question
- (progn
+ (progn
(setq outputtype 'trace)
(and (eq prolog-system 'sicstus)
(string-match
"^[ \t]*[0-9]+[ \t]*[0-9]+[ \t]*Call:.*? "
prolog-consult-compile-output)))
-
+
;; Match anything
- (progn
+ (progn
(setq outputtype 'normal)
(string-match "^.*\n" prolog-consult-compile-output))
))
(setq prolog-consult-compile-output
(substring prolog-consult-compile-output (length output)))
;;(message "pccf2: %s" prolog-consult-compile-output)
-
+
;; 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
;; user input
- ((and (eq prolog-system 'sicstus)
+ ((and (eq prolog-system 'sicstus)
(eq outputtype 'trace))
- (let (input)
- (setq input (concat (read-string output) "\n"))
+ (let ((input (concat (read-string output) "\n")))
(process-send-string process input)
(setq output (concat output input))))
(string-match
"\\({.*:.* in line[s ]*\\)\\([0-9]+\\)-\\([0-9]+\\)" output))
(setq output (replace-match
- ;; Adds a {processing ...} line so that
+ ;; Adds a {processing ...} line so that
;; `prolog-parse-sicstus-compilation-errors'
;; finds the real file instead of the temporary one.
;; Also fixes the line numbers.
(match-string 3 output))))
t t output)))
)
-
+
((eq prolog-system 'swi)
(if (and prolog-consult-compile-real-file
(string-match (format
(match-string 2 output))))
t t output)))
)
-
+
(t ())
)
;; Write the output in the *prolog-compilation* buffer
(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."
"Find SICStus objects method name for font lock.
Argument BOUND is a buffer position limiting searching."
(let (point
- (case-fold-search nil))
+ (case-fold-search nil))
(while (and (not point)
(re-search-forward "\\(::[ \t\n]*{\\|&\\)[ \t]*"
bound t))
(while (or (re-search-forward "\\=\n[ \t]*" bound t)
- (re-search-forward "\\=%.*" bound t)
- (and (re-search-forward "\\=/\\*" bound t)
- (re-search-forward "\\*/[ \t]*" bound t))))
+ (re-search-forward "\\=%.*" bound t)
+ (and (re-search-forward "\\=/\\*" bound t)
+ (re-search-forward "\\*/[ \t]*" bound t))))
(setq point (re-search-forward
(format "\\=\\(%s\\)" prolog-atom-regexp)
bound t)))
"Set up font lock keywords for the current Prolog system."
;(when window-system
(require 'font-lock)
-
+
;; Define Prolog faces
(defface prolog-redo-face
'((((class grayscale)) (:italic t))
(t (:bold t)))
"Face name to use for compiler warnings."
:group 'prolog-faces)
- (defvar prolog-warning-face
+ (defvar prolog-warning-face
(if (prolog-face-name-p 'font-lock-warning-face)
'font-lock-warning-face
'prolog-warning-face)
"Face name to use for built in predicates.")
- (defvar prolog-builtin-face
+ (defvar prolog-builtin-face
(if (prolog-face-name-p 'font-lock-builtin-face)
'font-lock-builtin-face
'prolog-builtin-face)
"Face name to use for exit trace lines.")
(defvar prolog-exception-face 'prolog-exception-face
"Face name to use for exception trace lines.")
-
+
;; Font Lock Patterns
(let (
;; "Native" Prolog patterns
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]*$"
+ '("\\({ ?\\(Warning\\|WARNING\\) ?:.*}\\)[ \t]*$"
2 prolog-warning-face prepend))
(t nil))))
;; 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")
- (if (zerop (- indent (current-column)))
- nil
- (delete-region beg (point))
- (indent-to indent))
+ (indent-line-to indent)
(if (> (- (point-max) pos) (point))
(goto-char (- (point-max) pos)))
-
+
;; Align comments
- (if prolog-align-comments-flag
+ (if (and prolog-align-comments-flag
+ (save-excursion
+ (line-beginning-position)
+ ;; (let ((start (comment-search-forward (line-end-position) t)))
+ ;; (and start ;There's a comment to indent.
+ ;; ;; If it's first on the line, we've indented it already
+ ;; ;; and prolog-goto-comment-column would inf-loop.
+ ;; (progn (goto-char start) (skip-chars-backward " \t")
+ ;; (not (bolp)))))))
+ (and (looking-at comment-start-skip)
+ ;; The definition of comment-start-skip used in this
+ ;; mode is unusual in that it only matches at BOL.
+ (progn (skip-chars-forward " \t")
+ (not (eq (point) (match-end 1)))))))
(save-excursion
(prolog-goto-comment-column t)))
(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
(skip-chars-forward " \t")
(cond
((looking-at "%%%") (prolog-indentation-level-of-line))
- ;Large comment starts
+ ;Large comment starts
((looking-at "%[^%]") comment-column) ;Small comment starts
- ((bobp) 0) ;Beginning of buffer
+ ((bobp) 0) ;Beginning of buffer
;; If we found '}' then we must check if it's the
;; end of an object declaration or something else.
- ((and (looking-at "}")
+ ((and (looking-at "}")
(save-excursion
(forward-char 1)
;; Goto to matching {
;; It was an object
(if prolog-object-end-to-0-flag
0
- prolog-indent-width))
+ prolog-indent-width))
;;End of /* */ comment
- ((looking-at "\\*/")
+ ((looking-at "\\*/")
(save-excursion
(prolog-find-start-of-mline-comment)
(skip-chars-backward " \t")
;; Here we check if the current line is within a /* */ pair
((and (looking-at "[^%/]")
- (eq (prolog-in-string-or-comment) 'cmt))
+ (eq (prolog-in-string-or-comment) 'cmt))
(if prolog-indent-mline-comments-flag
(prolog-find-start-of-mline-comment)
;; Same as before
(while empty
(forward-line -1)
(beginning-of-line)
- (if (= (point) (point-min))
+ (if (bobp)
(setq empty nil)
(skip-chars-forward " \t")
- (if (not (or (not (member (prolog-in-string-or-comment) '(nil txt)))
- (looking-at "%")
+ (if (not (or (not (member (prolog-in-string-or-comment)
+ '(nil txt)))
+ (looking-at "%")
(looking-at "\n")))
(setq empty nil))))
;; Store this line's indentation
- (if (= (point) (point-min))
- (setq ind 0) ;Beginning of buffer
- (setq ind (current-column))) ;Beginning of clause
+ (setq ind (if (bobp)
+ 0 ;Beginning of buffer.
+ (current-column))) ;Beginning of clause.
;; Compute the balance of the line
(setq linebal (prolog-paren-balance))
(cond
;; If the last char of the line is a '&' then set the indent level
;; to prolog-indent-width (used in SICStus objects)
- ((and (eq prolog-system 'sicstus)
+ ((and (eq prolog-system 'sicstus)
(looking-at ".+&[ \t]*\\(%.*\\|\\)$"))
(setq ind prolog-indent-width))
;; Increase indentation if the previous line was the head of a rule
;; and does not contain a '.'
- ((and (looking-at (format ".*%s[^\\.]*[ \t]*\\(%%.*\\|\\)$"
+ ((and (looking-at (format ".*%s[^\\.]*[ \t]*\\(%%.*\\|\\)$"
prolog-head-delimiter))
;; We must check that the match is at a paren balance of 0.
(save-excursion
(let ((p (point)))
(re-search-forward prolog-head-delimiter)
(>= 0 (prolog-region-paren-balance p (point))))))
- (let (headindent)
- (if (< (prolog-paren-balance) 0)
- (save-excursion
- (end-of-line)
- (setq headindent (prolog-find-indent-of-matching-paren)))
- (setq headindent (prolog-indentation-level-of-line)))
+ (let ((headindent
+ (if (< (prolog-paren-balance) 0)
+ (save-excursion
+ (end-of-line)
+ (prolog-find-indent-of-matching-paren))
+ (prolog-indentation-level-of-line))))
(setq ind (+ headindent prolog-indent-width))))
;; The previous line was the head of an object
;; If a '.' is found at the end of the previous line, then
;; decrease the indentation. (The \\(%.*\\|\\) part of the
;; regexp is for comments at the end of the line)
- ((and (looking-at "^.+\\.[ \t]*\\(%.*\\|\\)$")
+ ((and (looking-at "^.+\\.[ \t]*\\(%.*\\|\\)$")
;; Make sure that the '.' found is not in a comment or string
(save-excursion
(end-of-line)
(re-search-backward "\\.[ \t]*\\(%.*\\|\\)$" (point-min))
;; Guard against the real '.' being followed by a
;; commented '.'.
- (if (eq (prolog-in-string-or-comment) 'cmt) ;; commented out '.'
- (let ((here (save-excursion
- (beginning-of-line)
- (point))))
+ (if (eq (prolog-in-string-or-comment) 'cmt)
+ ;; commented out '.'
+ (let ((here (line-beginning-position)))
(end-of-line)
(re-search-backward "\\.[ \t]*%.*$" here t))
(not (prolog-in-string-or-comment))
;; decrease the indentation. (The /\\*.*\\*/ part of the
;; regexp is for C-like comments at the end of the
;; line--can we merge with the case above?).
- ((and (looking-at "^.+\\.[ \t]*\\(/\\*.*\\|\\)$")
+ ((and (looking-at "^.+\\.[ \t]*\\(/\\*.*\\|\\)$")
;; Make sure that the '.' found is not in a comment or string
(save-excursion
(end-of-line)
(re-search-backward "\\.[ \t]*\\(/\\*.*\\|\\)$" (point-min))
;; Guard against the real '.' being followed by a
;; commented '.'.
- (if (eq (prolog-in-string-or-comment) 'cmt) ;; commented out '.'
- (let ((here (save-excursion
- (beginning-of-line)
- (point))))
+ (if (eq (prolog-in-string-or-comment) 'cmt)
+ ;; commented out '.'
+ (let ((here (line-beginning-position)))
(end-of-line)
(re-search-backward "\\.[ \t]*/\\*.*$" here t))
(not (prolog-in-string-or-comment))
(= totbal 1)
(prolog-in-object))))
(if (looking-at
- (format "\\(%s\\|%s\\|0'.\\|[0-9]+'[0-9a-zA-Z]+\\|[^\n\'\"%%]\\)*\\(,\\|%s\\|%s\\)\[ \t]*\\(%%.*\\|\\)$"
+ (format "\\(%s\\|%s\\|0'.\\|[0-9]+'[0-9a-zA-Z]+\\|[^\n\'\"%%]\\)*\\(,\\|%s\\|%s\\)\[ \t]*\\(%%.*\\|\\)$"
prolog-quoted-atom-regexp prolog-string-regexp
prolog-left-paren prolog-left-indent-regexp))
(progn
(goto-char oldpoint)
- (setq ind (prolog-find-unmatched-paren (if prolog-paren-indent-p
- 'termdependent
- 'skipwhite)))
+ (setq ind (prolog-find-unmatched-paren
+ (if prolog-paren-indent-p
+ 'termdependent
+ 'skipwhite)))
;;(setq ind (prolog-find-unmatched-paren 'termdependent))
)
(goto-char oldpoint)
(setq ind (prolog-find-unmatched-paren nil))
))
-
+
;; Return the indentation level
ind
(skip-chars-forward " \t")
(current-column)))
-(defun prolog-first-pos-on-line ()
- "Return the first position on the current line."
- (save-excursion
- (beginning-of-line)
- (point)))
-
(defun prolog-paren-is-the-first-on-line-p ()
"Return t if the parenthesis under the point is the first one on the line.
Return nil otherwise.
Note: does not check if the point is actually at a parenthesis!"
(save-excursion
- (let ((begofline (prolog-first-pos-on-line)))
+ (let ((begofline (line-beginning-position)))
(if (= begofline (point))
t
(if (prolog-goto-next-paren begofline)
(let ((roundparen (looking-at "(")))
(if (looking-at prolog-left-paren)
- (let ((not-part-of-term
+ (let ((not-part-of-term
(save-excursion
(backward-char 1)
(looking-at "[ \t]"))))
(if (eq mode nil)
(current-column)
(if (and roundparen
- (eq mode 'termdependent)
+ (eq mode 'termdependent)
not-part-of-term)
(+ (current-column)
(if prolog-electric-tab-flag
A return value of n means n more left parentheses than right ones."
(save-excursion
(end-of-line)
- (prolog-region-paren-balance (prolog-first-pos-on-line) (point))))
+ (prolog-region-paren-balance (line-beginning-position) (point))))
(defun prolog-region-paren-balance (beg end)
"Return the summed parenthesis balance in the region.
(defun prolog-goto-next-paren (limit-pos)
"Move the point to the next parenthesis earlier in the buffer.
Return t if a match was found before LIMIT-POS. Return nil otherwise."
- (let (retval)
- (setq retval (re-search-backward
- (concat prolog-left-paren "\\|" prolog-right-paren)
- limit-pos t))
+ (let ((retval (re-search-backward
+ (concat prolog-left-paren "\\|" prolog-right-paren)
+ limit-pos t)))
;; If a match was found but it was in a string or comment, then recurse
(if (and retval (prolog-in-string-or-comment))
(end (point))
(state (if prolog-use-prolog-tokenizer-flag
(prolog-tokenize start end)
- (parse-partial-sexp start end))))
+ (if (fboundp 'syntax-ppss)
+ (syntax-ppss)
+ (parse-partial-sexp start end)))))
(cond
((nth 3 state) 'txt) ; String
((nth 4 state) 'cmt) ; Comment
(skip-chars-forward " \t")
(when (looking-at regexp)
;; Treat "( If -> " lines specially.
- ;;(if (looking-at "(.*->")
- ;; (setq incr 2)
- ;; (setq incr prolog-paren-indent))
+ ;;(setq incr (if (looking-at "(.*->")
+ ;; 2
+ ;; prolog-paren-indent))
;; work on all subsequent "->", "(", ";"
(while (looking-at regexp)
(save-restriction
;; Widen to catch comment limits correctly.
(widen)
- (setq end (save-excursion (end-of-line) (point))
- beg (save-excursion (beginning-of-line) (point)))
+ (setq end (line-end-position)
+ beg (line-beginning-position))
(save-excursion
(beginning-of-line)
(setq lit-type (if (search-forward-regexp "%" end t) 'line 'block))
(progn
(goto-char here)
(when (looking-at "/\\*") (forward-char 2))
- (when (and (looking-at "\\*") (> (point) (point-min))
+ (when (and (looking-at "\\*") (> (point) (point-min))
(forward-char -1) (looking-at "/"))
(forward-char 1))
(when (save-excursion (search-backward "/*" nil t))
(list (save-excursion (search-backward "/*") (point))
(or (search-forward "*/" nil t) (point-max)) lit-type)))
;; line comment
- (setq lit-limits-b (- (point) 1)
+ (setq lit-limits-b (- (point) 1)
lit-limits-e end)
(condition-case nil
(if (progn (goto-char lit-limits-b)
;; Go backward now
(beginning-of-line)
(while (and (zerop (setq done (forward-line -1)))
- (search-forward-regexp "^[ \t]*%" (save-excursion (end-of-line) (point)) t)
+ (search-forward-regexp "^[ \t]*%"
+ (line-end-position) t)
(= (+ 1 col) (current-column)))
(setq beg (- (point) 1)))
(when (= done 0)
(forward-line 1))
;; We may have a line with code above...
(when (and (zerop (setq done (forward-line -1)))
- (search-forward "%" (save-excursion (end-of-line) (point)) t)
+ (search-forward "%" (line-end-position) t)
(= (+ 1 col) (current-column)))
(setq beg (- (point) 1)))
(when (= done 0)
(goto-char lit-limits-b)
(beginning-of-line)
(while (and (zerop (forward-line 1))
- (search-forward-regexp "^[ \t]*%" (save-excursion (end-of-line) (point)) t)
+ (search-forward-regexp "^[ \t]*%"
+ (line-end-position) t)
(= (+ 1 col) (current-column)))
- (setq end (save-excursion (end-of-line) (point))))
+ (setq end (line-end-position)))
(list beg end lit-type))
(list lit-limits-b lit-limits-e lit-type)
)
the current entity (e.g. a list, a string, etc.) and nil.
The function returns a list with the following information:
- 0. parenthesis depth
+ 0. parenthesis depth
3. 'atm if END is inside an atom
'str if END is inside a string
'chr if END is in a character code expression (0'x)
(setq endpos (point))
(setq oldp (point)))) ; Continue tokenizing
(setq quoted 'atm)))
-
+
((looking-at "\"")
;; Find end of string
(if (re-search-forward "[^\\]\"" end2 'limit)
(setq depth (1- depth))
(if (and
(or (eq stopcond 'zerodepth)
- (and (eq stopcond 'skipover)
+ (and (eq stopcond 'skipover)
(eq skiptype 'paren)))
(= depth 0))
(progn
;; 0'char
((looking-at "0'")
(setq oldp (1+ (match-end 0)))
- (if (> oldp end)
+ (if (> oldp end)
(setq quoted 'chr)))
-
+
;; base'number
((looking-at "[0-9]+'")
(goto-char (match-end 0))
(skip-chars-forward "0-9a-zA-Z")
(setq oldp (point)))
-
+
)
(goto-char oldp)
)) ; End of while
(next-open (save-excursion (search-forward "/*" nil t)))
(prev-open (save-excursion (search-backward "/*" nil t)))
(prev-close (save-excursion (search-backward "*/" nil t)))
- (unmatched-next-close (and next-close
+ (unmatched-next-close (and next-close
(or (not next-open)
(> next-open next-close))))
(unmatched-prev-open (and prev-open
;; Otherwise, ask for the predicate name and then call the function
;; in prolog-help-function-i
(t
- (let* (word
- predicate
- ;point
- )
- (setq word (prolog-atom-under-point))
- (setq predicate (read-from-minibuffer
+ (let* ((word (prolog-atom-under-point))
+ (predicate (read-string
(format "Help on predicate%s: "
(if word
(concat " (default " word ")")
- ""))))
- (if (string= predicate "")
- (setq predicate word))
+ ""))
+ nil nil word))
+ ;;point
+ )
(if prolog-help-function-i
(funcall prolog-help-function-i predicate)
(error "Sorry, no help method defined for this Prolog system."))))
(let ((pred (prolog-read-predicate)))
(prolog-goto-predicate-info pred)))
-(defvar prolog-info-alist nil
+(defvar prolog-info-alist nil
"Alist with all builtin predicates.
Only for internal use by `prolog-find-documentation'")
(string-match "\\(.*\\)/\\([0-9]+\\).*$" predicate)
(let ((buffer (current-buffer))
(name (match-string 1 predicate))
- (arity (match-string 2 predicate))
+ (arity (string-to-number (match-string 2 predicate)))
;oldp
;(str (regexp-quote predicate))
)
- (setq arity (string-to-number arity))
(pop-to-buffer nil)
- (Info-goto-node
+ (Info-goto-node
prolog-info-predicate-index) ;; We must be in the SICStus pages
(Info-goto-node (car (cdr (assoc predicate prolog-info-alist))))
"Read a PredSpec from the user.
Returned value is a string \"FUNCTOR/ARITY\".
Interaction supports completion."
- (let ((initial (prolog-atom-under-point))
- answer)
- ;; If the predicate index is not yet built, do it now
- (if (not prolog-info-alist)
+ (let ((default (prolog-atom-under-point)))
+ ;; If the predicate index is not yet built, do it now
+ (if (not prolog-info-alist)
(prolog-build-info-alist))
- ;; Test if the initial string could be the base for completion.
+ ;; Test if the default string could be the base for completion.
;; Discard it if not.
- (if (eq (try-completion initial prolog-info-alist) nil)
- (setq initial ""))
+ (if (eq (try-completion default prolog-info-alist) nil)
+ (setq default nil))
;; Read the PredSpec from the user
- (setq answer (completing-read
- "Help on predicate: "
- prolog-info-alist nil t initial))
- (if (equal answer "")
- initial
- answer)))
+ (completing-read
+ (if (zerop (length default))
+ "Help on predicate: "
+ (concat "Help on predicate (default " default "): "))
+ prolog-info-alist nil t nil nil default)))
(defun prolog-build-info-alist (&optional verbose)
- "Build an alist of all builtins and library predicates.
+ "Build an alist of all builtins and library predicates.
Each element is of the form (\"NAME/ARITY\" . (INFO-NODE1 INFO-NODE2 ...)).
Typically there is just one Info node associated with each name
If an optional argument VERBOSE is non-nil, print messages at the beginning
info-node)
(beginning-of-line)
;; Extract the info node name
- (setq info-node (progn
+ (setq info-node (progn
(re-search-forward ":[ \t]*\\([^:]+\\).$")
(match-string 1)
))
(setq i (1+ i)))
str1))
-;(defun prolog-temporary-file ()
-; "Make temporary file name for compilation."
-; (make-temp-name
-; (concat
-; (or
-; (getenv "TMPDIR")
-; (getenv "TEMP")
-; (getenv "TMP")
-; (getenv "SYSTEMP")
-; "/tmp")
-; "/prolcomp")))
-;(setq prolog-temp-filename (prolog-bsts (prolog-temporary-file)))
+;;(defun prolog-temporary-file ()
+;; "Make temporary file name for compilation."
+;; (make-temp-name
+;; (concat
+;; (or
+;; (getenv "TMPDIR")
+;; (getenv "TEMP")
+;; (getenv "TMP")
+;; (getenv "SYSTEMP")
+;; "/tmp")
+;; "/prolcomp")))
+;;(setq prolog-temp-filename (prolog-bsts (prolog-temporary-file)))
(defun prolog-temporary-file ()
"Make temporary file name for compilation."
(progn
(write-region "" nil prolog-temporary-file-name nil 'silent)
prolog-temporary-file-name)
- ;; Actually create the file and set `prolog-temporary-file-name' accordingly
- (let* ((umask (default-file-modes))
- (temporary-file-directory (or
- (getenv "TMPDIR")
- (getenv "TEMP")
- (getenv "TMP")
- (getenv "SYSTEMP")
- "/tmp"))
- (prefix (expand-file-name "prolcomp" temporary-file-directory))
- (suffix ".pl")
- file)
- (unwind-protect
- (progn
- ;; Create temp files with strict access rights.
- (set-default-file-modes #o700)
- (while (condition-case ()
- (progn
- (setq file (concat (make-temp-name prefix) suffix))
- ;; (concat (make-temp-name "/tmp/prolcomp") ".pl")
- (unless (file-exists-p file)
- (write-region "" nil file nil 'silent))
- nil)
- (file-already-exists t))
- ;; the file was somehow created by someone else between
- ;; `make-temp-name' and `write-region', let's try again.
- nil)
- (setq prolog-temporary-file-name file))
- ;; Reset the umask.
- (set-default-file-modes umask)))
- ))
+ ;; Actually create the file and set `prolog-temporary-file-name'
+ ;; accordingly.
+ (setq prolog-temporary-file-name
+ (make-temp-file "prolcomp" nil ".pl"))))
(defun prolog-goto-prolog-process-buffer ()
"Switch to the prolog process buffer and go to its end."
;; Avoid compile warnings by using eval
(eval '(pltrace-off))))
+(defun prolog-toggle-sicstus-sd ()
+ ;; FIXME: Use define-minor-mode.
+ "Toggle the source level debugging facilities of SICStus 3.7 and later."
+ (interactive)
+ (if prolog-use-sicstus-sd
+ (prolog-disable-sicstus-sd)
+ (prolog-enable-sicstus-sd)))
+
(defun prolog-debug-on (&optional arg)
"Enable debugging.
When called with prefix argument ARG, disable debugging instead."
"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")
;; (defun prolog-create-predicate-index ()
;; "Create an index for all predicates in the buffer."
;; (let ((predlist '())
-;; clauseinfo
+;; clauseinfo
;; object
;; pos
;; )
;; (setq object (prolog-in-object))
;; (setq predlist (append
;; predlist
-;; (list (cons
+;; (list (cons
;; (if (and (eq prolog-system 'sicstus)
;; (prolog-in-object))
-;; (format "%s::%s/%d"
+;; (format "%s::%s/%d"
;; object
-;; (nth 0 clauseinfo)
+;; (nth 0 clauseinfo)
;; (nth 1 clauseinfo))
;; (format "%s/%d"
-;; (nth 0 clauseinfo)
+;; (nth 0 clauseinfo)
;; (nth 1 clauseinfo)))
;; pos
;; ))))
nil
(if (and (eq prolog-system 'sicstus)
object)
- (format "%s::%s/%d"
+ (format "%s::%s/%d"
object
- (nth 0 state)
+ (nth 0 state)
(nth 1 state))
(format "%s/%d"
- (nth 0 state)
+ (nth 0 state)
(nth 1 state)))
))))
;; Find first clause, unless it was a directive
(if (and (not (looking-at "[:?]-"))
(not (looking-at "[ \t]*[%/]")) ; Comment
-
+
)
(let* ((pinfo (prolog-clause-info))
(predname (nth 0 pinfo))
(arity (nth 1 pinfo))
(op (point)))
(while (and (re-search-backward
- (format "^%s\\([(\\.]\\| *%s\\)"
+ (format "^%s\\([(\\.]\\| *%s\\)"
predname prolog-head-delimiter) nil t)
(= arity (nth 1 (prolog-clause-info)))
)
;; It was not a directive, find the last clause
(while (and notdone
(re-search-forward
- (format "^%s\\([(\\.]\\| *%s\\)"
+ (format "^%s\\([(\\.]\\| *%s\\)"
predname prolog-head-delimiter) nil t)
(= arity (nth 1 (prolog-clause-info))))
(setq oldp (point))
(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)))
(end-of-line)
-
+
;; SICStus object?
(if (and (not not-allow-methods)
(eq prolog-system 'sicstus)
(prolog-in-object))
- (while (and
- notdone
+ (while (and
+ notdone
;; Search for a head or a fact
(re-search-backward
;; If in object, then find method start.
- ;; "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\|,\\)"
+ ;; "^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\|,\\)"
"^[ \t]+[a-z$].*\\(:-\\|&\\|:: {\\)" ; The comma causes
; problems since we cannot assume
; that the line starts at column 0,
) ; End of while
;; Not in object
- (while (and
- notdone
+ (while (and
+ notdone
;; Search for a text at beginning of a line
;; ######
;; (re-search-backward "^[a-z$']" nil t))
(setq notdone nil)))
((and (= bal 0)
(looking-at
- (format ".*\\(\\.\\|%s\\|!,\\)[ \t]*\\(%%.*\\|\\)$"
+ (format ".*\\(\\.\\|%s\\|!,\\)[ \t]*\\(%%.*\\|\\)$"
prolog-head-delimiter)))
;; Start of clause found if the line ends with a '.' or
;; a prolog-head-delimiter
)
(t nil) ; Do nothing
))))
-
+
retval)))
(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
+ (beginning-of-line) ; Necessary since we use "^...." for the search.
+ (if (re-search-forward
(if (and (not not-allow-methods)
(eq prolog-system 'sicstus)
(prolog-in-object))
(defun prolog-clause-info ()
"Return a (name arity) list for the current clause."
- (let (predname (arity 0))
- (save-excursion
- (goto-char (prolog-clause-start))
- (let ((op (point)))
- (if (looking-at prolog-atom-char-regexp)
- (progn
- (skip-chars-forward "^ (\\.")
- (setq predname (buffer-substring op (point))))
- (setq predname ""))
- ;; Retrieve the arity
- (if (looking-at prolog-left-paren)
- (let ((endp (save-excursion
- (prolog-forward-list) (point))))
- (setq arity 1)
- (forward-char 1) ; Skip the opening paren
- (while (progn
- (skip-chars-forward "^[({,'\"")
- (< (point) endp))
- (if (looking-at ",")
- (progn
- (setq arity (1+ arity))
- (forward-char 1) ; Skip the comma
- )
- ;; We found a string, list or something else we want
- ;; to skip over. Always use prolog-tokenize,
- ;; parse-partial-sexp does not have a 'skipover mode.
- (goto-char (nth 5 (prolog-tokenize (point) endp 'skipover))))
- )))
- (list predname arity)
- ))))
+ (save-excursion
+ (goto-char (prolog-clause-start))
+ (let* ((op (point))
+ (predname
+ (if (looking-at prolog-atom-char-regexp)
+ (progn
+ (skip-chars-forward "^ (\\.")
+ (buffer-substring op (point)))
+ ""))
+ (arity 0))
+ ;; Retrieve the arity.
+ (if (looking-at prolog-left-paren)
+ (let ((endp (save-excursion
+ (prolog-forward-list) (point))))
+ (setq arity 1)
+ (forward-char 1) ; Skip the opening paren.
+ (while (progn
+ (skip-chars-forward "^[({,'\"")
+ (< (point) endp))
+ (if (looking-at ",")
+ (progn
+ (setq arity (1+ arity))
+ (forward-char 1) ; Skip the comma.
+ )
+ ;; We found a string, list or something else we want
+ ;; to skip over. Always use prolog-tokenize,
+ ;; parse-partial-sexp does not have a 'skipover mode.
+ (goto-char (nth 5 (prolog-tokenize (point) endp 'skipover))))
+ )))
+ (list predname arity))))
(defun prolog-in-object ()
"Return object name if the point is inside a SICStus object definition."
;; Return object name if the last line that starts with a character
;; that is neither white space nor a comment start
(save-excursion
- (if (save-excursion
+ (if (save-excursion
(beginning-of-line)
(looking-at "\\([^\n ]+\\)[ \t]*::[ \t]*{"))
;; We were in the head of the object
(let ((bal 0)
(paren-regexp (concat prolog-left-paren "\\|" prolog-right-paren))
(notdone t))
+ ;; FIXME: Doesn't this incorrectly count 0'( and 0') ?
(while (and notdone (re-search-backward paren-regexp nil t))
(cond
((looking-at prolog-left-paren)
(beginning-of-line)
(if (or (not nocreate)
(and
- (re-search-forward
- (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)%% *"
+ (re-search-forward
+ (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)%% *"
prolog-quoted-atom-regexp prolog-string-regexp)
- (save-excursion (end-of-line) (point)) 'limit)
+ (line-end-position) 'limit)
(progn
(goto-char (match-beginning 0))
(not (eq (prolog-in-string-or-comment) 'txt)))))
(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))
(defun prolog-mark-predicate ()
"Put mark at the end of this predicate and move point to the beginning."
(interactive)
- (let (pos)
- (goto-char (prolog-pred-end))
- (setq pos (point))
+ (goto-char (prolog-pred-end))
+ (let ((pos (point)))
(forward-line 1)
(beginning-of-line)
(set-mark (point))
arg
(prolog-in-string-or-comment)
;; Do not be electric in a floating point number or an operator
- (not
+ (not
(or
;; (re-search-backward
;; ######
;; "\\(^\\|[])}a-zA-Z_!'0-9]+\\)[ \t]*\\=" nil t)))
- (save-excursion
+ (save-excursion
(re-search-backward
;; "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\=" nil t)))
- "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\="
+ "\\(^\\|[])}_!'0-9]+\\)[ \t]*\\="
nil t))
- (save-excursion
+ (save-excursion
(re-search-backward
;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t)))
- (format "\\(^\\|[])}%s]+\\)[ \t]*\\="
+ (format "\\(^\\|[])}%s]+\\)[ \t]*\\="
prolog-lower-case-string) ;FIXME: [:lower:]
nil t))
- (save-excursion
+ (save-excursion
(re-search-backward
;; "\\(^\\|[])}a-zA-Z]+\\)[ \t]*\\=" nil t)))
- (format "\\(^\\|[])}%s]+\\)[ \t]*\\="
+ (format "\\(^\\|[])}%s]+\\)[ \t]*\\="
prolog-upper-case-string) ;FIXME: [:upper:]
nil t))
)
(looking-at "[ \t]+$"))
(prolog-insert-predicate-template)
(when prolog-electric-dot-full-predicate-template
- (save-excursion
+ (save-excursion
(end-of-line)
- (insert ".\n"))))
+ (insert ".\n"))))
;; Default
(t
(insert ".\n"))
(interactive)
(if prolog-electric-underscore-flag
(let (;start
- (oldcase case-fold-search)
+ (case-fold-search nil)
(oldp (point)))
- (setq case-fold-search nil)
;; ######
;;(skip-chars-backward "a-zA-Z_")
(skip-chars-backward
(format "%s%s_"
;; FIXME: Why not "a-zA-Z"?
- prolog-lower-case-string
+ prolog-lower-case-string
prolog-upper-case-string))
;(setq start (point))
(if (and (not (prolog-in-string-or-comment))
;; ######
;; (looking-at "\\<[_A-Z][a-zA-Z_0-9]*\\>"))
- (looking-at (format "\\<[_%s][%s%s_0-9]*\\>"
+ (looking-at (format "\\<[_%s][%s%s_0-9]*\\>"
;; FIXME: Use [:upper:] and friends.
prolog-upper-case-string
prolog-lower-case-string
(skip-chars-forward ", \t\n"))
(goto-char oldp)
(self-insert-command 1))
- (setq case-fold-search oldcase)
)
(self-insert-command 1))
)
(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 "\\<"
prefix))
(regexp (concat prefix functor))
(i 1))
-
+
;; Build regexp for the search if the arity is > 0
(if (= arity 0)
;; Add that the functor must be at the end of a word. This
(setq regexp (concat regexp ".+,"))
(setq i (1+ i)))
(setq regexp (concat regexp ".+)")))
-
+
;; Search, and return position
(if (re-search-forward regexp nil t)
(goto-char (match-beginning 0))
"Replace all variables within a region BEG to END by anonymous variables."
(interactive "r")
(save-excursion
- (let ((oldcase case-fold-search))
- (setq case-fold-search nil)
+ (let ((case-fold-search nil))
(goto-char end)
(while (re-search-backward "\\<[A-Z_][a-zA-Z_0-9]*\\>" beg t)
(progn
(replace-match "_")
(backward-char)))
- (setq case-fold-search oldcase)
)))
"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_$]"
+ (format "[%s%s0-9_$]"
;; FIXME: why not a-zA-Z?
- prolog-lower-case-string
+ prolog-lower-case-string
prolog-upper-case-string))
(setq prolog-atom-regexp
- (format "[%s$]%s*"
- prolog-lower-case-string
+ (format "[%s$]%s*"
+ prolog-lower-case-string
prolog-atom-char-regexp))
)
;; 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
+ ;; `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
+ ;; (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
;; `map-char-table' was undefined.
(let ((key 0))
(while (< key 256)
- (cond
- ((and
+ (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
; (setq end (+ end 1)))
; (if (equal (substring chars end) "")
; (substring chars 0 beg)
-; (concat (substring chars 0 beg) "-"
+; (concat (substring chars 0 beg) "-"
; (prolog-regexp-dash-continuous-chars (substring chars end))))
; )))
"Non-nil iff the mark is set. Lobotomized version for Emacsen that do not provide their own."
(mark)))
+
+;; GNU Emacs ignores `easy-menu-add' so the order in which the menus
+;; are defined _is_ important!
+
+(easy-menu-define
+ prolog-menu-help (list prolog-mode-map prolog-inferior-mode-map)
+ "Help menu for the Prolog mode."
+ ;; FIXME: Does it really deserve a whole menu to itself?
+ `(,(if (featurep 'xemacs) "Help"
+ ;; Not sure it's worth the trouble. --Stef
+ ;; (add-to-list 'menu-bar-final-items
+ ;; (easy-menu-intern "Prolog-Help"))
+ "Prolog-help")
+ ["On predicate" prolog-help-on-predicate prolog-help-function-i]
+ ["Apropos" prolog-help-apropos (eq prolog-system 'swi)]
+ "---"
+ ["Describe mode" describe-mode t]))
+
+(easy-menu-define
+ prolog-edit-menu-runtime prolog-mode-map
+ "Runtime Prolog commands available from the editing buffer"
+ ;; FIXME: Don't use a whole menu for just "Run Mercury". --Stef
+ `("System"
+ ;; Runtime menu name.
+ ,@(unless (featurep 'xemacs)
+ '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe")
+ ((eq prolog-system 'mercury) "Mercury")
+ (t "System"))))
+
+ ;; Consult items, NIL for mercury.
+ ["Consult file" prolog-consult-file
+ :included (not (eq prolog-system 'mercury))]
+ ["Consult buffer" prolog-consult-buffer
+ :included (not (eq prolog-system 'mercury))]
+ ["Consult region" prolog-consult-region :active (region-exists-p)
+ :included (not (eq prolog-system 'mercury))]
+ ["Consult predicate" prolog-consult-predicate
+ :included (not (eq prolog-system 'mercury))]
+
+ ;; Compile items, NIL for everything but SICSTUS.
+ ,(if (featurep 'xemacs) "---"
+ ["---" nil :included (eq prolog-system 'sicstus)])
+ ["Compile file" prolog-compile-file
+ :included (eq prolog-system 'sicstus)]
+ ["Compile buffer" prolog-compile-buffer
+ :included (eq prolog-system 'sicstus)]
+ ["Compile region" prolog-compile-region :active (region-exists-p)
+ :included (eq prolog-system 'sicstus)]
+ ["Compile predicate" prolog-compile-predicate
+ :included (eq prolog-system 'sicstus)]
+
+ ;; Debug items, NIL for Mercury.
+ ,(if (featurep 'xemacs) "---"
+ ["---" nil :included (not (eq prolog-system 'mercury))])
+ ;; FIXME: Could we use toggle or radio buttons? --Stef
+ ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))]
+ ["Debug off" prolog-debug-off
+ ;; In SICStus, these are pairwise disjunctive,
+ ;; so it's enough with a single "off"-command
+ :included (not (memq prolog-system '(mercury sicstus)))]
+ ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))]
+ ["Trace off" prolog-trace-off
+ :included (not (memq prolog-system '(mercury sicstus)))]
+ ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus)
+ (prolog-atleast-version '(3 . 7)))]
+ ["All debug off" prolog-debug-off
+ :included (eq prolog-system 'sicstus)]
+ ["Source level debugging"
+ prolog-toggle-sicstus-sd
+ :included (and (eq prolog-system 'sicstus)
+ (prolog-atleast-version '(3 . 7)))
+ :style toggle
+ :selected prolog-use-sicstus-sd]
+
+ "---"
+ ["Run" run-prolog
+ :suffix (cond ((eq prolog-system 'eclipse) "ECLiPSe")
+ ((eq prolog-system 'mercury) "Mercury")
+ (t "Prolog"))]))
+
+(easy-menu-define
+ prolog-edit-menu-insert-move prolog-mode-map
+ "Commands for Prolog code manipulation."
+ '("Prolog"
+ ["Comment region" comment-region (region-exists-p)]
+ ["Uncomment region" prolog-uncomment-region (region-exists-p)]
+ ["Add comment/move to comment" indent-for-comment t]
+ ["Convert variables in region to '_'" prolog-variables-to-anonymous
+ :active (region-exists-p) :included (not (eq prolog-system 'mercury))]
+ "---"
+ ["Insert predicate template" prolog-insert-predicate-template t]
+ ["Insert next clause head" prolog-insert-next-clause t]
+ ["Insert predicate spec" prolog-insert-predspec t]
+ ["Insert module modeline" prolog-insert-module-modeline t]
+ "---"
+ ["Beginning of clause" prolog-beginning-of-clause t]
+ ["End of clause" prolog-end-of-clause t]
+ ["Beginning of predicate" prolog-beginning-of-predicate t]
+ ["End of predicate" prolog-end-of-predicate t]
+ "---"
+ ["Indent line" prolog-indent-line t]
+ ["Indent region" indent-region (region-exists-p)]
+ ["Indent predicate" prolog-indent-predicate t]
+ ["Indent buffer" prolog-indent-buffer t]
+ ["Align region" align (region-exists-p)]
+ "---"
+ ["Mark clause" prolog-mark-clause t]
+ ["Mark predicate" prolog-mark-predicate t]
+ ["Mark paragraph" mark-paragraph t]
+ ;;"---"
+ ;;["Fontify buffer" font-lock-fontify-buffer t]
+ ))
+
(defun prolog-menu ()
- "Create the menus for the Prolog editing buffers.
-These menus are dynamically created because one may change systems
-during the life of an Emacs session, and because GNU Emacs wants them
-so by ignoring `easy-menu-add'."
-
- ;; GNU Emacs ignores `easy-menu-add' so the order in which the menus
- ;; are defined _is_ important!
-
- (easy-menu-define
- prolog-edit-menu-help (current-local-map)
- "Help menu for the Prolog mode."
- (append
- (if (featurep 'xemacs) '("Help") '("Prolog-help"))
- (cond
- ((eq prolog-system 'sicstus)
- '(["On predicate" prolog-help-on-predicate t]
- "---"))
- ((eq prolog-system 'swi)
- '(["On predicate" prolog-help-on-predicate t]
- ["Apropos" prolog-help-apropos t]
- "---")))
- '(["Describe mode" describe-mode t])))
-
- (easy-menu-define
- prolog-edit-menu-runtime (current-local-map)
- "Runtime Prolog commands available from the editing buffer"
- (append
- ;; runtime menu name
- (list (cond ((eq prolog-system 'eclipse)
- "ECLiPSe")
- ((eq prolog-system 'mercury)
- "Mercury")
- (t
- "Prolog")))
- ;; consult items, NIL for mercury
- (unless (eq prolog-system 'mercury)
- '("---"
- ["Consult file" prolog-consult-file t]
- ["Consult buffer" prolog-consult-buffer t]
- ["Consult region" prolog-consult-region (region-exists-p)]
- ["Consult predicate" prolog-consult-predicate t]
- ))
- ;; compile items, NIL for everything but SICSTUS
- (when (eq prolog-system 'sicstus)
- '("---"
- ["Compile file" prolog-compile-file t]
- ["Compile buffer" prolog-compile-buffer t]
- ["Compile region" prolog-compile-region (region-exists-p)]
- ["Compile predicate" prolog-compile-predicate t]
- ))
- ;; debug items, NIL for mercury
- (cond
- ((eq prolog-system 'sicstus)
- ;; In SICStus, these are pairwise disjunctive,
- ;; so it's enough with one "off"-command
- (if (prolog-atleast-version '(3 . 7))
- (list "---"
- ["Debug" prolog-debug-on t]
- ["Trace" prolog-trace-on t]
- ["Zip" prolog-zip-on t]
- ["All debug off" prolog-debug-off t]
- '("Source level debugging"
- ["Enable" prolog-enable-sicstus-sd t]
- ["Disable" prolog-disable-sicstus-sd t]))
- (list "---"
- ["Debug" prolog-debug-on t]
- ["Trace" prolog-trace-on t]
- ["All debug off" prolog-debug-off t])))
- ((not (eq prolog-system 'mercury))
- '("---"
- ["Debug" prolog-debug-on t]
- ["Debug off" prolog-debug-off t]
- ["Trace" prolog-trace-on t]
- ["Trace off" prolog-trace-off t]))
- ;; default (mercury) nil
- )
- (list "---"
- (if (featurep 'xemacs)
- [(concat "Run " (cond ((eq prolog-system 'eclipse) "ECLiPSe")
- ((eq prolog-system 'mercury) "Mercury")
- (t "Prolog")))
- run-prolog t]
- ["Run Prolog" run-prolog t]))))
-
- (easy-menu-define
- prolog-edit-menu-insert-move (current-local-map)
- "Commands for Prolog code manipulation."
- (append
- (list "Code"
- ["Comment region" comment-region (region-exists-p)]
- ["Uncomment region" prolog-uncomment-region (region-exists-p)]
- ["Add comment/move to comment" indent-for-comment t])
- (unless (eq prolog-system 'mercury)
- (list ["Convert variables in region to '_'" prolog-variables-to-anonymous (region-exists-p)]))
- (list "---"
- ["Insert predicate template" prolog-insert-predicate-template t]
- ["Insert next clause head" prolog-insert-next-clause t]
- ["Insert predicate spec" prolog-insert-predspec t]
- ["Insert module modeline" prolog-insert-module-modeline t]
- "---"
- ["Beginning of clause" prolog-beginning-of-clause t]
- ["End of clause" prolog-end-of-clause t]
- ["Beginning of predicate" prolog-beginning-of-predicate t]
- ["End of predicate" prolog-end-of-predicate t]
- "---"
- ["Indent line" prolog-indent-line t]
- ["Indent region" indent-region (region-exists-p)]
- ["Indent predicate" prolog-indent-predicate t]
- ["Indent buffer" prolog-indent-buffer t]
- ["Align region" align (region-exists-p)]
- "---"
- ["Mark clause" prolog-mark-clause t]
- ["Mark predicate" prolog-mark-predicate t]
- ["Mark paragraph" mark-paragraph t]
- ;"---"
- ;["Fontify buffer" font-lock-fontify-buffer t]
- )))
+ "Add the menus for the Prolog editing buffers."
(easy-menu-add prolog-edit-menu-insert-move)
(easy-menu-add prolog-edit-menu-runtime)
;; Add predicate index menu
- ;(make-variable-buffer-local 'imenu-create-index-function)
- (make-local-variable 'imenu-create-index-function)
- (setq imenu-create-index-function 'imenu-default-create-index-function)
+ (set (make-local-variable 'imenu-create-index-function)
+ 'imenu-default-create-index-function)
;;Milan (this has problems with object methods...) ###### Does it? (Stefan)
(setq imenu-prev-index-position-function 'prolog-beginning-of-predicate)
(setq imenu-extract-index-name-function 'prolog-get-predspec)
-
+
(if (and prolog-imenu-flag
(< (count-lines (point-min) (point-max)) prolog-imenu-max-lines))
(imenu-add-to-menubar "Predicates"))
-
- (easy-menu-add prolog-edit-menu-help))
+
+ (easy-menu-add prolog-menu-help))
+
+(easy-menu-define
+ prolog-inferior-menu-all prolog-inferior-mode-map
+ "Menu for the inferior Prolog buffer."
+ `("Prolog"
+ ;; Runtime menu name.
+ ,@(unless (featurep 'xemacs)
+ '(:label (cond ((eq prolog-system 'eclipse) "ECLiPSe")
+ ((eq prolog-system 'mercury) "Mercury")
+ (t "Prolog"))))
+
+ ;; Debug items, NIL for Mercury.
+ ,(if (featurep 'xemacs) "---"
+ ["---" nil :included (not (eq prolog-system 'mercury))])
+ ;; FIXME: Could we use toggle or radio buttons? --Stef
+ ["Debug" prolog-debug-on :included (not (eq prolog-system 'mercury))]
+ ["Debug off" prolog-debug-off
+ ;; In SICStus, these are pairwise disjunctive,
+ ;; so it's enough with a single "off"-command
+ :included (not (memq prolog-system '(mercury sicstus)))]
+ ["Trace" prolog-trace-on :included (not (eq prolog-system 'mercury))]
+ ["Trace off" prolog-trace-off
+ :included (not (memq prolog-system '(mercury sicstus)))]
+ ["Zip" prolog-zip-on :included (and (eq prolog-system 'sicstus)
+ (prolog-atleast-version '(3 . 7)))]
+ ["All debug off" prolog-debug-off
+ :included (eq prolog-system 'sicstus)]
+ ["Source level debugging"
+ prolog-toggle-sicstus-sd
+ :included (and (eq prolog-system 'sicstus)
+ (prolog-atleast-version '(3 . 7)))
+ :style toggle
+ :selected prolog-use-sicstus-sd]
+
+ ;; Runtime.
+ "---"
+ ["Interrupt Prolog" comint-interrupt-subjob t]
+ ["Quit Prolog" comint-quit-subjob t]
+ ["Kill Prolog" comint-kill-subjob t]))
+
(defun prolog-inferior-menu ()
"Create the menus for the Prolog inferior buffer.
This menu is dynamically created because one may change systems during
the life of an Emacs session."
-
- (easy-menu-define
- prolog-inferior-menu-help (current-local-map)
- "Help menu for the Prolog inferior mode."
- (append
- (if (featurep 'xemacs) '("Help") '("Prolog-help"))
- (cond
- ((eq prolog-system 'sicstus)
- '(["On predicate" prolog-help-on-predicate t]
- "---"))
- ((eq prolog-system 'swi)
- '(["On predicate" prolog-help-on-predicate t]
- ["Apropos" prolog-help-apropos t]
- "---")))
- '(["Describe mode" describe-mode t])))
-
- (easy-menu-define
- prolog-inferior-menu-all (current-local-map)
- "Menu for the inferior Prolog buffer."
- (append
- ;; menu name
- (list (cond ((eq prolog-system 'eclipse)
- "ECLiPSe")
- ((eq prolog-system 'mercury)
- "Mercury")
- (t
- "Prolog")))
- ;; debug items, NIL for mercury
- (cond
- ((eq prolog-system 'sicstus)
- ;; In SICStus, these are pairwise disjunctive,
- ;; so it's enough with one "off"-command
- (if (prolog-atleast-version '(3 . 7))
- (list "---"
- ["Debug" prolog-debug-on t]
- ["Trace" prolog-trace-on t]
- ["Zip" prolog-zip-on t]
- ["All debug off" prolog-debug-off t]
- '("Source level debugging"
- ["Enable" prolog-enable-sicstus-sd t]
- ["Disable" prolog-disable-sicstus-sd t]))
- (list "---"
- ["Debug" prolog-debug-on t]
- ["Trace" prolog-trace-on t]
- ["All debug off" prolog-debug-off t])))
- ((not (eq prolog-system 'mercury))
- '("---"
- ["Debug" prolog-debug-on t]
- ["Debug off" prolog-debug-off t]
- ["Trace" prolog-trace-on t]
- ["Trace off" prolog-trace-off t]))
- ;; default (mercury) nil
- )
- ;; runtime
- '("---"
- ["Interrupt Prolog" comint-interrupt-subjob t]
- ["Quit Prolog" comint-quit-subjob t]
- ["Kill Prolog" comint-kill-subjob t])
- ))
-
(easy-menu-add prolog-inferior-menu-all)
- (easy-menu-add prolog-inferior-menu-help))
-
-(add-hook 'prolog-mode-hook 'prolog-menu) ;FIXME.
-(add-hook 'prolog-inferior-mode-hook 'prolog-inferior-menu) ;FIXME.
+ (easy-menu-add prolog-menu-help))
(defun prolog-mode-version ()
"Echo the current version of Prolog mode in the minibuffer."
HCoop / bpt / emacs.git / blobdiff