: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)))
+ ;; FIXME: This should be auto-detected instead of user-provided.
"*Alist of Prolog system versions.
The version numbers are of the format (Major . Minor)."
:group '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"))
"*Alist of switches given to inferior Prolog run with `run-prolog'."
:group 'prolog-inferior
:type 'sexp)
+(defun prolog-program-switches ()
+ (prolog-find-value-by-system prolog-program-switches))
(defcustom prolog-consult-string
'((eclipse "[%f].")
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].")
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.
'((eclipse "^[a-zA-Z0-9()]* *\\?- \\|^\\[[a-zA-Z]* [0-9]*\\]:")
(sicstus "| [ ?][- ] *")
(swi "^\\(\\[[a-zA-Z]*\\] \\)?[1-9]?[0-9]*[ ]?\\?- \\|^| +")
- (t "^ *\\?-"))
+ (gnu "^| \\?-")
+ (t "^|? *\\?-"))
"*Alist of prompts of the prolog system command line."
: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."
(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
+ (buffer-local-value 'prolog-system
+ (prolog-inferior-buffer 'dont-run)))))
+ (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)
;; Initialize Prolog system specific variables
(dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
prolog-determinism-specificators prolog-directives
- prolog-program-name prolog-program-switches
- prolog-consult-string prolog-compile-string prolog-eof-string
- prolog-prompt-regexp prolog-continued-prompt-regexp
+ prolog-eof-string
+ ;; prolog-continued-prompt-regexp
prolog-help-function))
(set (intern (concat (symbol-name var) "-i"))
(prolog-find-value-by-system (symbol-value var))))
- (when (null prolog-program-name-i)
- (set (make-local-variable 'compile-command) prolog-compile-string-i))
+ (when (null (prolog-program-name))
+ (set (make-local-variable 'compile-command) (prolog-compile-string)))
(set (make-local-variable 'font-lock-defaults)
'(prolog-font-lock-keywords nil nil ((?_ . "w"))))
(set (make-local-variable 'syntax-propertize-function)
(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)
(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.")
+(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))))
+
+
(define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog"
"Major mode for interacting with an inferior Prolog process.
(setq comint-input-filter 'prolog-input-filter)
(setq mode-line-process '(": %s"))
(prolog-mode-variables)
- (setq comint-prompt-regexp prolog-prompt-regexp-i)
+ (setq comint-prompt-regexp (prolog-prompt-regexp))
(set (make-local-variable 'shell-dirstack-query) "pwd.")
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ prolog-inferior-error-regexp-alist)
+ (compilation-shell-minor-mode)
(prolog-inferior-menu))
(defun prolog-input-filter (str)
(cond ((string-match "\\`\\s *\\'" str) nil) ;whitespace
- ((not (eq major-mode 'prolog-inferior-mode)) t)
+ ((not (derived-mode-p 'prolog-inferior-mode)) t)
((= (length str) 1) nil) ;one character
((string-match "\\`[rf] *[0-9]*\\'" str) nil) ;r(edo) or f(ail)
(t t)))
"Run an inferior Prolog process, input and output via buffer *prolog*.
With prefix argument ARG, restart the Prolog process if running before."
(interactive "P")
+ ;; FIXME: It should be possible to interactively specify the command to use
+ ;; to run prolog.
(if (and arg (get-process "prolog"))
(progn
(process-send-string "prolog" "halt.\n")
(prolog-ensure-process)
))
+(defun prolog-inferior-guess-flavor (&optional ignored)
+ (setq prolog-system
+ (when (or (numberp prolog-system) (markerp prolog-system))
+ (save-excursion
+ (goto-char (1+ prolog-system))
+ (cond
+ ((looking-at "GNU Prolog") 'gnu)
+ ((looking-at "Welcome to SWI-Prolog\\|%.*\\<swi_") 'swi)
+ ((looking-at ".*\n") nil) ;There's at least one line.
+ (t prolog-system)))))
+ (when (symbolp prolog-system)
+ (remove-hook 'comint-output-filter-functions
+ 'prolog-inferior-guess-flavor t)
+ (when prolog-system
+ (setq comint-prompt-regexp (prolog-prompt-regexp))
+ (if (eq prolog-system 'gnu)
+ (set (make-local-variable 'comint-process-echoes) t)))))
+
(defun prolog-ensure-process (&optional wait)
"If Prolog process is not running, run it.
If the optional argument WAIT is non-nil, wait for Prolog prompt specified by
the variable `prolog-prompt-regexp'."
- (if (null prolog-program-name-i)
+ (if (null (prolog-program-name))
(error "This Prolog system has defined no interpreter."))
(if (comint-check-proc "*prolog*")
()
- (apply 'make-comint "prolog" prolog-program-name-i nil
- prolog-program-switches-i)
- (with-current-buffer "*prolog*"
+ (with-current-buffer (get-buffer-create "*prolog*")
(prolog-inferior-mode)
+ (apply 'make-comint-in-buffer "prolog" (current-buffer)
+ (prolog-program-name) nil (prolog-program-switches))
+ (unless prolog-system
+ ;; Setup auto-detection.
+ (set (make-local-variable 'prolog-system)
+ ;; Force re-detection.
+ (let* ((proc (get-buffer-process (current-buffer)))
+ (pmark (and proc (marker-position (process-mark proc)))))
+ (cond
+ ((null pmark) (1- (point-min)))
+ ;; The use of insert-before-markers in comint.el together with
+ ;; the potential use of comint-truncate-buffer in the output
+ ;; filter, means that it's difficult to reliably keep track of
+ ;; the buffer position where the process's output started.
+ ;; If possible we use a marker at "start - 1", so that
+ ;; insert-before-marker at `start' won't shift it. And if not,
+ ;; we fall back on using a plain integer.
+ ((> pmark (point-min)) (copy-marker (1- pmark)))
+ (t (1- pmark)))))
+ (add-hook 'comint-output-filter-functions
+ 'prolog-inferior-guess-flavor nil t))
(if wait
(progn
(goto-char (point-max))
(save-excursion
(not
(re-search-backward
- (concat "\\(" prolog-prompt-regexp-i "\\)" "\\=")
+ (concat "\\(" (prolog-prompt-regexp) "\\)" "\\=")
nil t)))
(sit-for 0.1)))))))
+(defun prolog-inferior-buffer (&optional dont-run)
+ (or (get-buffer "*prolog*")
+ (unless dont-run
+ (prolog-ensure-process)
+ (get-buffer "*prolog*"))))
+
(defun prolog-process-insert-string (process string)
"Insert STRING into inferior Prolog buffer running PROCESS."
;; Copied from elisp manual, greek to me
If COMPILEP is non-nil then use compilation, otherwise consulting."
(prolog-ensure-process)
;(let ((tmpfile prolog-temp-filename)
- (let ((tmpfile (prolog-bsts (prolog-temporary-file)))
+ (let ((tmpfile (prolog-temporary-file))
;(process (get-process "prolog"))
(first-line (1+ (count-lines
(point-min)
(goto-char start)
(point))))))
(write-region start end tmpfile)
+ (setq start (copy-marker start))
+ (with-current-buffer (prolog-inferior-buffer)
+ (compilation-forget-errors)
+ (compilation-fake-loc start tmpfile))
(process-send-string
"prolog" (prolog-build-prolog-command
compilep tmpfile (prolog-bsts buffer-file-name)
If COMPILEP is non-nil then use compilation, otherwise consulting."
(save-some-buffers)
(prolog-ensure-process)
- (let ((filename (prolog-bsts buffer-file-name)))
+ (with-current-buffer (prolog-inferior-buffer)
+ (compilation-forget-errors))
(process-send-string
"prolog" (prolog-build-prolog-command
- compilep filename filename))
- (prolog-goto-prolog-process-buffer)))
+ compilep buffer-file-name
+ (prolog-bsts buffer-file-name)))
+ (prolog-goto-prolog-process-buffer))
\f
;;------------------------------------------------------------
;; Consulting and compiling
;;------------------------------------------------------------
-;;; Interactive interface functions, used by both the standard
-;;; and the experimental consultation and compilation functions
+;; Interactive interface functions, used by both the standard
+;; and the experimental consultation and compilation functions
(defun prolog-consult-file ()
"Consult file of current buffer."
(interactive)
"Make Prolog command for FILE compilation/consulting.
If COMPILEP is non-nil, consider compilation, otherwise consulting."
(let* ((compile-string
- (if compilep prolog-compile-string-i prolog-consult-string-i))
+ ;; FIXME: If the process is not running yet, the auto-detection of
+ ;; prolog-system won't help here, so we should make sure
+ ;; we first run Prolog and then build the command.
+ (if compilep (prolog-compile-string) (prolog-consult-string)))
(module (prolog-buffer-module))
- (file-name (concat "'" file "'"))
+ (file-name (concat "'" (prolog-bsts file) "'"))
(module-name (if module (concat "'" module "'")))
(module-file (if module
(concat module-name ":" file-name)
(setq compile-string (concat strbeg (format "%d" lineoffset) strend)))
(concat compile-string "\n")))
-;;; The rest of this page is experimental code!
+;; The rest of this page is experimental code!
;; Global variables for process filter function
(defvar prolog-process-flag nil
(old-filter (process-filter process)))
(with-current-buffer buffer
(delete-region (point-min) (point-max))
+ ;; FIXME: Wasn't this supposed to use prolog-inferior-mode?
(compilation-mode)
+ ;; FIXME: This doesn't seem to cooperate well with new(ish) compile.el.
;; Setting up font-locking for this buffer
(set (make-local-variable 'font-lock-defaults)
'(prolog-font-lock-keywords nil nil ((?_ . "w"))))
(if (eq prolog-system 'sicstus)
- (progn
+ ;; FIXME: This looks really problematic: not only is this using
+ ;; the old compilation-parse-errors-function, but
+ ;; prolog-parse-sicstus-compilation-errors only accepts one argument
+ ;; whereas compile.el calls it with 2 (and did so at least since
+ ;; Emacs-20).
(set (make-local-variable 'compilation-parse-errors-function)
- 'prolog-parse-sicstus-compilation-errors)))
+ 'prolog-parse-sicstus-compilation-errors))
(toggle-read-only 0)
(insert command-string "\n"))
(save-selected-window
;; If temporary files were used, then we change the error
;; messages to point to the original source file.
+ ;; FIXME: Use compilation-fake-loc instead.
(cond
;; If the prolog process was in trace mode then it requires
(insert output)))
;; If the prompt is visible, then the task is finished
- (if (string-match prolog-prompt-regexp-i prolog-consult-compile-output)
+ (if (string-match (prolog-prompt-regexp) prolog-consult-compile-output)
(setq prolog-process-flag nil)))
(defun prolog-consult-compile-file (compilep)
(write-region beg end file nil 'no-message)
(write-region "\n" nil file t 'no-message)
(prolog-consult-compile compilep file
- (if (looking-at "^") (1+ lines) lines))
+ (if (bolp) (1+ lines) lines))
(delete-file file)))
(defun prolog-consult-compile-predicate (compilep)
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]*$"
"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")
projects / emacs.git / commitdiff