Merge changes from emacs-23 branch
[bpt/emacs.git] / lisp / progmodes / prolog.el
1 ;;; prolog.el --- major mode for editing and running Prolog under Emacs
2
3 ;; Copyright (C) 1986, 1987, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
4 ;; 2008, 2009, 2010 Free Software Foundation, Inc.
5
6 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
7 ;; Keywords: languages
8
9 ;; This file is part of GNU Emacs.
10
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;; This package provides a major mode for editing Prolog. It knows
27 ;; about Prolog syntax and comments, and can send regions to an inferior
28 ;; Prolog interpreter process. Font locking is tuned towards GNU Prolog.
29
30 ;;; Code:
31
32 (defvar comint-prompt-regexp)
33 (defvar comint-process-echoes)
34 (require 'smie)
35
36 (defgroup prolog nil
37 "Major mode for editing and running Prolog under Emacs."
38 :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
39 :group 'languages)
40
41
42 (defcustom prolog-program-name
43 (let ((names '("prolog" "gprolog" "swipl")))
44 (while (and names
45 (not (executable-find (car names))))
46 (setq names (cdr names)))
47 (or (car names) "prolog"))
48 "Program name for invoking an inferior Prolog with `run-prolog'."
49 :type 'string
50 :group 'prolog)
51
52 (defcustom prolog-consult-string "reconsult(user).\n"
53 "(Re)Consult mode (for C-Prolog and Quintus Prolog). "
54 :type 'string
55 :group 'prolog)
56
57 (defcustom prolog-compile-string "compile(user).\n"
58 "Compile mode (for Quintus Prolog)."
59 :type 'string
60 :group 'prolog)
61
62 (defcustom prolog-eof-string "end_of_file.\n"
63 "String that represents end of file for Prolog.
64 When nil, send actual operating system end of file."
65 :type 'string
66 :group 'prolog)
67
68 (defcustom prolog-indent-width 4
69 "Level of indentation in Prolog buffers."
70 :type 'integer
71 :group 'prolog)
72
73 (defvar prolog-font-lock-keywords
74 '(("\\(#[<=]=>\\|:-\\)\\|\\(#=\\)\\|\\(#[#<>\\/][=\\/]*\\|!\\)"
75 0 font-lock-keyword-face)
76 ("\\<\\(is\\|write\\|nl\\|read_\\sw+\\)\\>"
77 1 font-lock-keyword-face)
78 ("^\\(\\sw+\\)\\s-*\\((\\(.+\\))\\)*"
79 (1 font-lock-function-name-face)
80 (3 font-lock-variable-name-face)))
81 "Font-lock keywords for Prolog mode.")
82
83 (defvar prolog-mode-syntax-table
84 (let ((table (make-syntax-table)))
85 (modify-syntax-entry ?_ "w" table)
86 (modify-syntax-entry ?\\ "\\" table)
87 (modify-syntax-entry ?/ ". 14" table)
88 (modify-syntax-entry ?* ". 23" table)
89 (modify-syntax-entry ?+ "." table)
90 (modify-syntax-entry ?- "." table)
91 (modify-syntax-entry ?= "." table)
92 (modify-syntax-entry ?% "<" table)
93 (modify-syntax-entry ?\n ">" table)
94 (modify-syntax-entry ?< "." table)
95 (modify-syntax-entry ?> "." table)
96 (modify-syntax-entry ?\' "\"" table)
97 table))
98
99 (defvar prolog-mode-abbrev-table nil)
100 (define-abbrev-table 'prolog-mode-abbrev-table ())
101
102 (defun prolog-smie-forward-token ()
103 (forward-comment (point-max))
104 (buffer-substring-no-properties
105 (point)
106 (progn (cond
107 ((looking-at "[!;]") (forward-char 1))
108 ((not (zerop (skip-chars-forward "#&*+-./:<=>?@\\^`~"))))
109 ((not (zerop (skip-syntax-forward "w_'"))))
110 ;; In case of non-ASCII punctuation.
111 ((not (zerop (skip-syntax-forward ".")))))
112 (point))))
113
114 (defun prolog-smie-backward-token ()
115 (forward-comment (- (point-max)))
116 (buffer-substring-no-properties
117 (point)
118 (progn (cond
119 ((memq (char-before) '(?! ?\;)) (forward-char -1))
120 ((not (zerop (skip-chars-backward "#&*+-./:<=>?@\\^`~"))))
121 ((not (zerop (skip-syntax-backward "w_'"))))
122 ;; In case of non-ASCII punctuation.
123 ((not (zerop (skip-syntax-backward ".")))))
124 (point))))
125
126 (defconst prolog-smie-op-levels
127 ;; Rather than construct the operator levels table from the BNF,
128 ;; we directly provide the operator precedences from GNU Prolog's
129 ;; manual (7.14.10 op/3). The only problem is that GNU Prolog's
130 ;; manual uses precedence levels in the opposite sense (higher
131 ;; numbers bind less tightly) than SMIE, so we use negative numbers.
132 '(("." -10000 -10000)
133 (":-" -1200 -1200)
134 ("-->" -1200 -1200)
135 (";" -1100 -1100)
136 ("->" -1050 -1050)
137 ("," -1000 -1000)
138 ("\\+" -900 -900)
139 ("=" -700 -700)
140 ("\\=" -700 -700)
141 ("=.." -700 -700)
142 ("==" -700 -700)
143 ("\\==" -700 -700)
144 ("@<" -700 -700)
145 ("@=<" -700 -700)
146 ("@>" -700 -700)
147 ("@>=" -700 -700)
148 ("is" -700 -700)
149 ("=:=" -700 -700)
150 ("=\\=" -700 -700)
151 ("<" -700 -700)
152 ("=<" -700 -700)
153 (">" -700 -700)
154 (">=" -700 -700)
155 (":" -600 -600)
156 ("+" -500 -500)
157 ("-" -500 -500)
158 ("/\\" -500 -500)
159 ("\\/" -500 -500)
160 ("*" -400 -400)
161 ("/" -400 -400)
162 ("//" -400 -400)
163 ("rem" -400 -400)
164 ("mod" -400 -400)
165 ("<<" -400 -400)
166 (">>" -400 -400)
167 ("**" -200 -200)
168 ("^" -200 -200)
169 ;; Prefix
170 ;; ("+" 200 200)
171 ;; ("-" 200 200)
172 ;; ("\\" 200 200)
173 )
174 "Precedence levels of infix operators.")
175
176 (defconst prolog-smie-indent-rules
177 '((":-")
178 ("->"))
179 "Prolog indentation rules.")
180
181 (defun prolog-mode-variables ()
182 (make-local-variable 'paragraph-separate)
183 (setq paragraph-separate (concat "%%\\|$\\|" page-delimiter)) ;'%%..'
184 (make-local-variable 'paragraph-ignore-fill-prefix)
185 (setq paragraph-ignore-fill-prefix t)
186 (make-local-variable 'imenu-generic-expression)
187 (setq imenu-generic-expression '((nil "^\\sw+" 0)))
188 (smie-setup prolog-smie-op-levels prolog-smie-indent-rules)
189 (set (make-local-variable 'smie-forward-token-function)
190 #'prolog-smie-forward-token)
191 (set (make-local-variable 'smie-backward-token-function)
192 #'prolog-smie-backward-token)
193 (set (make-local-variable 'forward-sexp-function)
194 'smie-forward-sexp-command)
195 (set (make-local-variable 'smie-indent-basic) prolog-indent-width)
196 (set (make-local-variable 'smie-blink-matching-triggers) '(?.))
197 (set (make-local-variable 'smie-closer-alist) '((t . ".")))
198 (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local)
199 ;; There's no real closer in Prolog anyway.
200 (set (make-local-variable 'smie-blink-matching-inners) t)
201 (make-local-variable 'comment-start)
202 (setq comment-start "%")
203 (make-local-variable 'comment-start-skip)
204 (setq comment-start-skip "\\(?:%+\\|/\\*+\\)[ \t]*")
205 (make-local-variable 'comment-end-skip)
206 (setq comment-end-skip "[ \t]*\\(\n\\|\\*+/\\)")
207 (make-local-variable 'comment-column)
208 (setq comment-column 48))
209
210 (defvar prolog-mode-map
211 (let ((map (make-sparse-keymap)))
212 (define-key map "\e\C-x" 'prolog-consult-region)
213 (define-key map "\C-c\C-l" 'inferior-prolog-load-file)
214 (define-key map "\C-c\C-z" 'switch-to-prolog)
215 map))
216
217 (easy-menu-define prolog-mode-menu prolog-mode-map "Menu for Prolog mode."
218 ;; Mostly copied from scheme-mode's menu.
219 ;; Not tremendously useful, but it's a start.
220 '("Prolog"
221 ["Indent line" indent-according-to-mode t]
222 ["Indent region" indent-region t]
223 ["Comment region" comment-region t]
224 ["Uncomment region" uncomment-region t]
225 "--"
226 ["Run interactive Prolog session" run-prolog t]
227 ))
228
229 ;;;###autoload
230 (define-derived-mode prolog-mode prog-mode "Prolog"
231 "Major mode for editing Prolog code for Prologs.
232 Blank lines and `%%...' separate paragraphs. `%'s start comments.
233 Commands:
234 \\{prolog-mode-map}
235 Entry to this mode calls the value of `prolog-mode-hook'
236 if that value is non-nil."
237 (prolog-mode-variables)
238 (set (make-local-variable 'comment-add) 1)
239 (setq font-lock-defaults '(prolog-font-lock-keywords
240 nil nil nil
241 beginning-of-line)))
242
243 (defun end-of-prolog-clause ()
244 "Go to end of clause in this line."
245 (beginning-of-line 1)
246 (let* ((eolpos (save-excursion (end-of-line) (point))))
247 (if (re-search-forward comment-start-skip eolpos 'move)
248 (goto-char (match-beginning 0)))
249 (skip-chars-backward " \t")))
250 \f
251 ;;;
252 ;;; Inferior prolog mode
253 ;;;
254 (defvar inferior-prolog-mode-map
255 (let ((map (make-sparse-keymap)))
256 ;; This map will inherit from `comint-mode-map' when entering
257 ;; inferior-prolog-mode.
258 (define-key map [remap self-insert-command]
259 'inferior-prolog-self-insert-command)
260 map))
261
262 (defvar inferior-prolog-mode-syntax-table prolog-mode-syntax-table)
263 (defvar inferior-prolog-mode-abbrev-table prolog-mode-abbrev-table)
264
265 (defvar inferior-prolog-error-regexp-alist
266 ;; GNU Prolog used to not follow the GNU standard format.
267 '(("^\\(.*?\\):\\([0-9]+\\) error: .*(char:\\([0-9]+\\)" 1 2 3)
268 gnu))
269
270 (declare-function comint-mode "comint")
271 (declare-function comint-send-string "comint" (process string))
272 (declare-function comint-send-region "comint" (process start end))
273 (declare-function comint-send-eof "comint" ())
274 (defvar compilation-error-regexp-alist)
275
276 (define-derived-mode inferior-prolog-mode comint-mode "Inferior Prolog"
277 "Major mode for interacting with an inferior Prolog process.
278
279 The following commands are available:
280 \\{inferior-prolog-mode-map}
281
282 Entry to this mode calls the value of `prolog-mode-hook' with no arguments,
283 if that value is non-nil. Likewise with the value of `comint-mode-hook'.
284 `prolog-mode-hook' is called after `comint-mode-hook'.
285
286 You can send text to the inferior Prolog from other buffers using the commands
287 `process-send-region', `process-send-string' and \\[prolog-consult-region].
288
289 Commands:
290 Tab indents for Prolog; with argument, shifts rest
291 of expression rigidly with the current line.
292 Paragraphs are separated only by blank lines and '%%'.
293 '%'s start comments.
294
295 Return at end of buffer sends line as input.
296 Return not at end copies rest of line to end and sends it.
297 \\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
298 \\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
299 \\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal."
300 (setq comint-prompt-regexp "^| [ ?][- ] *")
301 (set (make-local-variable 'compilation-error-regexp-alist)
302 inferior-prolog-error-regexp-alist)
303 (compilation-shell-minor-mode)
304 (prolog-mode-variables))
305
306 (defvar inferior-prolog-buffer nil)
307
308 (defvar inferior-prolog-flavor 'unknown
309 "Either a symbol or a buffer position offset by one.
310 If a buffer position, the flavor has not been determined yet and
311 it is expected that the process's output has been or will
312 be inserted at that position plus one.")
313
314 (defun inferior-prolog-run (&optional name)
315 (with-current-buffer (make-comint "prolog" (or name prolog-program-name))
316 (inferior-prolog-mode)
317 (setq-default inferior-prolog-buffer (current-buffer))
318 (make-local-variable 'inferior-prolog-buffer)
319 (when (and name (not (equal name prolog-program-name)))
320 (set (make-local-variable 'prolog-program-name) name))
321 (set (make-local-variable 'inferior-prolog-flavor)
322 ;; Force re-detection.
323 (let* ((proc (get-buffer-process (current-buffer)))
324 (pmark (and proc (marker-position (process-mark proc)))))
325 (cond
326 ((null pmark) (1- (point-min)))
327 ;; The use of insert-before-markers in comint.el together with
328 ;; the potential use of comint-truncate-buffer in the output
329 ;; filter, means that it's difficult to reliably keep track of
330 ;; the buffer position where the process's output started.
331 ;; If possible we use a marker at "start - 1", so that
332 ;; insert-before-marker at `start' won't shift it. And if not,
333 ;; we fall back on using a plain integer.
334 ((> pmark (point-min)) (copy-marker (1- pmark)))
335 (t (1- pmark)))))
336 (add-hook 'comint-output-filter-functions
337 'inferior-prolog-guess-flavor nil t)))
338
339 (defun inferior-prolog-process (&optional dontstart)
340 (or (and (buffer-live-p inferior-prolog-buffer)
341 (get-buffer-process inferior-prolog-buffer))
342 (unless dontstart
343 (inferior-prolog-run)
344 ;; Try again.
345 (inferior-prolog-process))))
346
347 (defun inferior-prolog-guess-flavor (&optional ignored)
348 (save-excursion
349 (goto-char (1+ inferior-prolog-flavor))
350 (setq inferior-prolog-flavor
351 (cond
352 ((looking-at "GNU Prolog") 'gnu)
353 ((looking-at "Welcome to SWI-Prolog") 'swi)
354 ((looking-at ".*\n") 'unknown) ;There's at least one line.
355 (t inferior-prolog-flavor))))
356 (when (symbolp inferior-prolog-flavor)
357 (remove-hook 'comint-output-filter-functions
358 'inferior-prolog-guess-flavor t)
359 (if (eq inferior-prolog-flavor 'gnu)
360 (set (make-local-variable 'comint-process-echoes) t))))
361
362 ;;;###autoload
363 (defalias 'run-prolog 'switch-to-prolog)
364 ;;;###autoload
365 (defun switch-to-prolog (&optional name)
366 "Run an inferior Prolog process, input and output via buffer *prolog*.
367 With prefix argument \\[universal-prefix], prompt for the program to use."
368 (interactive
369 (list (when current-prefix-arg
370 (let ((proc (inferior-prolog-process 'dontstart)))
371 (if proc
372 (if (yes-or-no-p "Kill current process before starting new one? ")
373 (kill-process proc)
374 (error "Abort")))
375 (read-string "Run Prolog: " prolog-program-name)))))
376 (unless (inferior-prolog-process 'dontstart)
377 (inferior-prolog-run name))
378 (pop-to-buffer inferior-prolog-buffer))
379
380 (defun inferior-prolog-self-insert-command ()
381 "Insert the char in the buffer or pass it directly to the process."
382 (interactive)
383 (let* ((proc (get-buffer-process (current-buffer)))
384 (pmark (and proc (marker-position (process-mark proc)))))
385 (if (and (eq inferior-prolog-flavor 'gnu)
386 pmark
387 (null current-prefix-arg)
388 (eobp)
389 (eq (point) pmark)
390 (save-excursion
391 (goto-char (- pmark 3))
392 (looking-at " \\? ")))
393 ;; This is GNU prolog waiting to know whether you want more answers
394 ;; or not (or abort, etc...). The answer is a single char, not
395 ;; a line, so pass this char directly rather than wait for RET to
396 ;; send a whole line.
397 (comint-send-string proc (string last-command-event))
398 (call-interactively 'self-insert-command))))
399
400 (defun prolog-consult-region (compile beg end)
401 "Send the region to the Prolog process made by \"M-x run-prolog\".
402 If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
403 (interactive "P\nr")
404 (let ((proc (inferior-prolog-process)))
405 (comint-send-string proc
406 (if compile prolog-compile-string
407 prolog-consult-string))
408 (comint-send-region proc beg end)
409 (comint-send-string proc "\n") ;May be unnecessary
410 (if prolog-eof-string
411 (comint-send-string proc prolog-eof-string)
412 (with-current-buffer (process-buffer proc)
413 (comint-send-eof))))) ;Send eof to prolog process.
414
415 (defun prolog-consult-region-and-go (compile beg end)
416 "Send the region to the inferior Prolog, and switch to *prolog* buffer.
417 If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
418 (interactive "P\nr")
419 (prolog-consult-region compile beg end)
420 (pop-to-buffer inferior-prolog-buffer))
421
422 ;; inferior-prolog-mode uses the autoloaded compilation-shell-minor-mode.
423 (declare-function compilation-forget-errors "compile" ())
424
425 (defun inferior-prolog-load-file ()
426 "Pass the current buffer's file to the inferior prolog process."
427 (interactive)
428 (save-buffer)
429 (let ((file buffer-file-name)
430 (proc (inferior-prolog-process)))
431 (with-current-buffer (process-buffer proc)
432 (compilation-forget-errors)
433 (comint-send-string proc (concat "['" (file-relative-name file) "'].\n"))
434 (pop-to-buffer (current-buffer)))))
435
436 (provide 'prolog)
437
438 ;; arch-tag: f3ec6748-1272-4ab6-8826-c50cb1607636
439 ;;; prolog.el ends here