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-grammar
 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 (defun prolog-smie-rules (kind token)
 177   (pcase (cons kind token)
 178     (`(:elem . basic) prolog-indent-width)
 179     (`(:after . ".") 0) ;; To work around smie-closer-alist.
 180     (`(:after . ,(or `":-" `"->")) prolog-indent-width)))
 181
 182 (defun prolog-mode-variables ()
 183   (set (make-local-variable 'paragraph-separate) (concat "%%\\|$\\|" page-delimiter)) ;'%%..'
 184   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
 185   (set (make-local-variable 'imenu-generic-expression) '((nil "^\\sw+" 0)))
 186
 187   ;; Setup SMIE.
 188   (smie-setup prolog-smie-grammar #'prolog-smie-rules
 189               :forward-token #'prolog-smie-forward-token
 190               :backward-token #'prolog-smie-backward-token)
 191   (set (make-local-variable 'smie-blink-matching-triggers) '(?.))
 192   (set (make-local-variable 'smie-closer-alist) '((t . ".")))
 193   (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local)
 194   ;; There's no real closer in Prolog anyway.
 195   (set (make-local-variable 'smie-blink-matching-inners) t)
 196
 197   (set (make-local-variable 'comment-start) "%")
 198   (set (make-local-variable 'comment-start-skip) "\\(?:%+\\|/\\*+\\)[ \t]*")
 199   (set (make-local-variable 'comment-end-skip) "[ \t]*\\(\n\\|\\*+/\\)")
 200   (set (make-local-variable 'comment-column) 48))
 201
 202 (defvar prolog-mode-map
 203   (let ((map (make-sparse-keymap)))
 204     (define-key map "\e\C-x" 'prolog-consult-region)
 205     (define-key map "\C-c\C-l" 'inferior-prolog-load-file)
 206     (define-key map "\C-c\C-z" 'switch-to-prolog)
 207     map))
 208
 209 (easy-menu-define prolog-mode-menu prolog-mode-map "Menu for Prolog mode."
 210   ;; Mostly copied from scheme-mode's menu.
 211   ;; Not tremendously useful, but it's a start.
 212   '("Prolog"
 213     ["Indent line" indent-according-to-mode t]
 214     ["Indent region" indent-region t]
 215     ["Comment region" comment-region t]
 216     ["Uncomment region" uncomment-region t]
 217     "--"
 218     ["Run interactive Prolog session" run-prolog t]
 219     ))
 220
 221 ;;;###autoload
 222 (define-derived-mode prolog-mode prog-mode "Prolog"
 223   "Major mode for editing Prolog code for Prologs.
 224 Blank lines and `%%...' separate paragraphs.  `%'s start comments.
 225 Commands:
 226 \\{prolog-mode-map}
 227 Entry to this mode calls the value of `prolog-mode-hook'
 228 if that value is non-nil."
 229   (prolog-mode-variables)
 230   (set (make-local-variable 'comment-add) 1)
 231   (setq font-lock-defaults '(prolog-font-lock-keywords
 232                              nil nil nil
 233                              beginning-of-line)))
 234
 235 (defun end-of-prolog-clause ()
 236   "Go to end of clause in this line."
 237   (beginning-of-line 1)
 238   (let* ((eolpos (line-end-position)))
 239     (if (re-search-forward comment-start-skip eolpos 'move)
 240         (goto-char (match-beginning 0)))
 241     (skip-chars-backward " \t")))
 242 \f
 243 ;;;
 244 ;;; Inferior prolog mode
 245 ;;;
 246 (defvar inferior-prolog-mode-map
 247   (let ((map (make-sparse-keymap)))
 248     ;; This map will inherit from `comint-mode-map' when entering
 249     ;; inferior-prolog-mode.
 250     (define-key map [remap self-insert-command]
 251       'inferior-prolog-self-insert-command)
 252     map))
 253
 254 (defvar inferior-prolog-mode-syntax-table prolog-mode-syntax-table)
 255 (defvar inferior-prolog-mode-abbrev-table prolog-mode-abbrev-table)
 256
 257 (defvar inferior-prolog-error-regexp-alist
 258   ;; GNU Prolog used to not follow the GNU standard format.
 259   '(("^\\(.*?\\):\\([0-9]+\\) error: .*(char:\\([0-9]+\\)" 1 2 3)
 260     gnu))
 261
 262 (declare-function comint-mode "comint")
 263 (declare-function comint-send-string "comint" (process string))
 264 (declare-function comint-send-region "comint" (process start end))
 265 (declare-function comint-send-eof "comint" ())
 266 (defvar compilation-error-regexp-alist)
 267
 268 (define-derived-mode inferior-prolog-mode comint-mode "Inferior Prolog"
 269   "Major mode for interacting with an inferior Prolog process.
 270
 271 The following commands are available:
 272 \\{inferior-prolog-mode-map}
 273
 274 Entry to this mode calls the value of `prolog-mode-hook' with no arguments,
 275 if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
 276 `prolog-mode-hook' is called after `comint-mode-hook'.
 277
 278 You can send text to the inferior Prolog from other buffers using the commands
 279 `process-send-region', `process-send-string' and \\[prolog-consult-region].
 280
 281 Commands:
 282 Tab indents for Prolog; with argument, shifts rest
 283  of expression rigidly with the current line.
 284 Paragraphs are separated only by blank lines and '%%'.
 285 '%'s start comments.
 286
 287 Return at end of buffer sends line as input.
 288 Return not at end copies rest of line to end and sends it.
 289 \\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
 290 \\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
 291 \\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal."
 292   (setq comint-prompt-regexp "^| [ ?][- ] *")
 293   (set (make-local-variable 'compilation-error-regexp-alist)
 294        inferior-prolog-error-regexp-alist)
 295   (compilation-shell-minor-mode)
 296   (prolog-mode-variables))
 297
 298 (defvar inferior-prolog-buffer nil)
 299
 300 (defvar inferior-prolog-flavor 'unknown
 301   "Either a symbol or a buffer position offset by one.
 302 If a buffer position, the flavor has not been determined yet and
 303 it is expected that the process's output has been or will
 304 be inserted at that position plus one.")
 305
 306 (defun inferior-prolog-run (&optional name)
 307   (with-current-buffer (make-comint "prolog" (or name prolog-program-name))
 308     (inferior-prolog-mode)
 309     (setq-default inferior-prolog-buffer (current-buffer))
 310     (make-local-variable 'inferior-prolog-buffer)
 311     (when (and name (not (equal name prolog-program-name)))
 312       (set (make-local-variable 'prolog-program-name) name))
 313     (set (make-local-variable 'inferior-prolog-flavor)
 314          ;; Force re-detection.
 315          (let* ((proc (get-buffer-process (current-buffer)))
 316                 (pmark (and proc (marker-position (process-mark proc)))))
 317            (cond
 318             ((null pmark) (1- (point-min)))
 319             ;; The use of insert-before-markers in comint.el together with
 320             ;; the potential use of comint-truncate-buffer in the output
 321             ;; filter, means that it's difficult to reliably keep track of
 322             ;; the buffer position where the process's output started.
 323             ;; If possible we use a marker at "start - 1", so that
 324             ;; insert-before-marker at `start' won't shift it.  And if not,
 325             ;; we fall back on using a plain integer.
 326             ((> pmark (point-min)) (copy-marker (1- pmark)))
 327             (t (1- pmark)))))
 328     (add-hook 'comint-output-filter-functions
 329               'inferior-prolog-guess-flavor nil t)))
 330
 331 (defun inferior-prolog-process (&optional dontstart)
 332   (or (and (buffer-live-p inferior-prolog-buffer)
 333            (get-buffer-process inferior-prolog-buffer))
 334       (unless dontstart
 335         (inferior-prolog-run)
 336         ;; Try again.
 337         (inferior-prolog-process))))
 338
 339 (defun inferior-prolog-guess-flavor (&optional ignored)
 340   (save-excursion
 341     (goto-char (1+ inferior-prolog-flavor))
 342     (setq inferior-prolog-flavor
 343           (cond
 344            ((looking-at "GNU Prolog") 'gnu)
 345            ((looking-at "Welcome to SWI-Prolog") 'swi)
 346            ((looking-at ".*\n") 'unknown) ;There's at least one line.
 347            (t inferior-prolog-flavor))))
 348   (when (symbolp inferior-prolog-flavor)
 349     (remove-hook 'comint-output-filter-functions
 350                  'inferior-prolog-guess-flavor t)
 351     (if (eq inferior-prolog-flavor 'gnu)
 352         (set (make-local-variable 'comint-process-echoes) t))))
 353
 354 ;;;###autoload
 355 (defalias 'run-prolog 'switch-to-prolog)
 356 ;;;###autoload
 357 (defun switch-to-prolog (&optional name)
 358   "Run an inferior Prolog process, input and output via buffer *prolog*.
 359 With prefix argument \\[universal-prefix], prompt for the program to use."
 360   (interactive
 361    (list (when current-prefix-arg
 362            (let ((proc (inferior-prolog-process 'dontstart)))
 363              (if proc
 364                  (if (yes-or-no-p "Kill current process before starting new one? ")
 365                      (kill-process proc)
 366                    (error "Abort")))
 367              (read-string "Run Prolog: " prolog-program-name)))))
 368   (unless (inferior-prolog-process 'dontstart)
 369     (inferior-prolog-run name))
 370   (pop-to-buffer inferior-prolog-buffer))
 371
 372 (defun inferior-prolog-self-insert-command ()
 373   "Insert the char in the buffer or pass it directly to the process."
 374   (interactive)
 375   (let* ((proc (get-buffer-process (current-buffer)))
 376          (pmark (and proc (marker-position (process-mark proc)))))
 377     (if (and (eq inferior-prolog-flavor 'gnu)
 378              pmark
 379              (null current-prefix-arg)
 380              (eobp)
 381              (eq (point) pmark)
 382              (save-excursion
 383                (goto-char (- pmark 3))
 384                (looking-at " \\? ")))
 385         ;; This is GNU prolog waiting to know whether you want more answers
 386         ;; or not (or abort, etc...).  The answer is a single char, not
 387         ;; a line, so pass this char directly rather than wait for RET to
 388         ;; send a whole line.
 389         (comint-send-string proc (string last-command-event))
 390       (call-interactively 'self-insert-command))))
 391
 392 (defun prolog-consult-region (compile beg end)
 393   "Send the region to the Prolog process made by \"M-x run-prolog\".
 394 If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
 395   (interactive "P\nr")
 396   (let ((proc (inferior-prolog-process)))
 397     (comint-send-string proc
 398                         (if compile prolog-compile-string
 399                           prolog-consult-string))
 400     (comint-send-region proc beg end)
 401     (comint-send-string proc "\n")              ;May be unnecessary
 402     (if prolog-eof-string
 403         (comint-send-string proc prolog-eof-string)
 404       (with-current-buffer (process-buffer proc)
 405         (comint-send-eof))))) ;Send eof to prolog process.
 406
 407 (defun prolog-consult-region-and-go (compile beg end)
 408   "Send the region to the inferior Prolog, and switch to *prolog* buffer.
 409 If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
 410   (interactive "P\nr")
 411   (prolog-consult-region compile beg end)
 412   (pop-to-buffer inferior-prolog-buffer))
 413
 414 ;; inferior-prolog-mode uses the autoloaded compilation-shell-minor-mode.
 415 (declare-function compilation-forget-errors "compile" ())
 416
 417 (defun inferior-prolog-load-file ()
 418   "Pass the current buffer's file to the inferior prolog process."
 419   (interactive)
 420   (save-buffer)
 421   (let ((file buffer-file-name)
 422         (proc (inferior-prolog-process)))
 423     (with-current-buffer (process-buffer proc)
 424       (compilation-forget-errors)
 425       (comint-send-string proc (concat "['" (file-relative-name file) "'].\n"))
 426       (pop-to-buffer (current-buffer)))))
 427
 428 (provide 'prolog)
 429
 430 ;;; prolog.el ends here