ediprolog.el 0.9t -- Emacs does Interactive Prolog

[Markus Triska]

New:

    *) more robust detection of queries, prompt and coding system

Project page:

    http://stud4.tuwien.ac.at/~e0225855/ediprolog/ediprolog.html


;;; ediprolog.el --- Emacs does Interactive Prolog

;; Copyright (C) 2006, 2007  Markus Triska

;; Author: Markus Triska <address@hidden>
;; Keywords: languages, processes

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; These definitions let you transparently interact with SWI Prolog in
;; all buffers.  You can load and syntax-check Prolog programs and
;; evaluate queries with minimal exposure to the toplevel.  Queries
;; start with `?-' or `:-', possibly preceded by `%' and whitespace.

;; Copy ediprolog.el to your load-path and add to your .emacs:

;;     (require 'ediprolog)
;;     (global-set-key [f10] 'ediprolog-dwim)

;; Restart Emacs and press F10 in a Prolog program to load it (point
;; is moved to first error, if there are any).  Press F10 on a query
;; in the program to evaluate it. Query results are inserted into the
;; buffer, and you interact with SWI Prolog as on a terminal.

;; Tested with SWI Prolog 5.6.24 + Emacs 21.4 and 22.0.

;;; Code:

(defconst ediprolog-version "0.9t")

(defgroup ediprolog nil
  "Transparent interaction with SWI Prolog."
  :group 'languages
  :group 'processes)

;;;###autoload
(defcustom ediprolog-prefix "%@ "
  "String to prepend when inserting output from the Prolog
process into the buffer."
  :group 'ediprolog
  :type 'string)

;;;###autoload
(defcustom ediprolog-program-switches nil
  "List of switches passed to the Prolog process. Example:
'(\"-G128M\" \"-O\")"
  :group 'ediprolog
  :type 'sexp)

;;;###autoload
(defcustom ediprolog-program "swipl"
  "Program name of the Prolog executable."
  :group 'ediprolog
  :type 'string)

(defvar ediprolog-more-solutions        nil)
(defvar ediprolog-process               nil)
(defvar ediprolog-first-error-line      nil)
(defvar ediprolog-consult-output        nil)
(defvar ediprolog-seen-prompt           nil)
(defvar ediprolog-read-term             nil)
(defvar ediprolog-indent-prefix          "")
(defvar ediprolog-temp-file             nil)

(defmacro ediprolog-wait-for-prompt-after (form)
  "Evaluate FORM and wait for prompt."
  `(progn
     (setq ediprolog-seen-prompt nil)
     ,form
     (set-process-filter ediprolog-process 'ediprolog-wait-for-prompt-filter)
     (while (and (ediprolog-running) (not ediprolog-seen-prompt))
       (if (ediprolog-emacs-geq-22)
           (accept-process-output ediprolog-process 0.1)
         (accept-process-output ediprolog-process)))))

(defun ediprolog-emacs-geq-22 () (>= emacs-major-version 22))

(defun ediprolog-run-prolog ()
  ;; If the Emacs version supports it (>= 22), the invocation buffer
  ;; is stored as a process property, and the process's buffer is nil
  ;; to avoid spurious messages like "Process killed." in the buffer.
  (ediprolog-wait-for-prompt-after
   (setq ediprolog-process
         (apply #'start-process "ediprolog"
                (if (ediprolog-emacs-geq-22)
                    nil
                  (current-buffer))
                ediprolog-program "-q" "-g" "'$set_prompt'('?- ')"
                ediprolog-program-switches)))
  (unless (ediprolog-running)
    (error "Couldn't start Prolog process."))
  (let ((lang (getenv "LANG")))
    (when (or (null lang) (string= lang ""))
      (set-process-coding-system
       ediprolog-process buffer-file-coding-system buffer-file-coding-system)))
  (ediprolog-update-process-buffer))

(defun ediprolog-kill-prolog ()
  (when (ediprolog-running)
    (unless (ediprolog-emacs-geq-22)
      (set-process-buffer ediprolog-process nil))
    (kill-process ediprolog-process)
    (setq ediprolog-process nil)))

(defun ediprolog-update-process-buffer ()
  (if (ediprolog-emacs-geq-22)
      (process-put ediprolog-process :invocation-buffer (current-buffer))
    (set-process-buffer ediprolog-process (current-buffer))))

(defun ediprolog-wait-for-response ()
  (accept-process-output ediprolog-process))

(defun ediprolog-wait-for-prompt-filter (proc string)
  ;; This filter knows a bit about the syntax of ERROR messages
  ;; and stores the line of the first error.
  (let ((lines (split-string string "\n")))
    (dolist (el '("Yes" ""))
      (setq lines (delete el lines)))
    (dolist (str lines)
      (if (string= str "?- ")
          (setq ediprolog-seen-prompt t)
        (princ (format "%s\n" str))
        (setq ediprolog-consult-output t)
        (when (and (not ediprolog-first-error-line)
                   (string-match (concat "^ERROR: (?" ediprolog-temp-file
                                         ":\\([0-9]+\\)") str))
          (setq ediprolog-first-error-line
                (string-to-number (match-string 1 str))))))))


;;;###autoload
(defun ediprolog-dwim (&optional arg)
  "Load current buffer into Prolog or post query (Do What I Mean).
If invoked on a line starting with `:-' or `?-', possibly
preceded by `%' and whitespace, call `ediprolog-interact' with
the query as argument. Otherwise, call `ediprolog-consult'.

With prefix argument 0, kill the Prolog process. With prefix 1,
equivalent to `ediprolog-consult'. With prefix 2, equivalent to
`ediprolog-consult' with argument t. With just C-u, first call
`ediprolog-consult' and then, if point is on a query, call
`ediprolog-interact' with it as argument. Analogously, C-u C-u
for `ediprolog-consult' with argument t. With other prefix
arguments, equivalent to `ediprolog-remove-interactions'."
  (interactive "P")
  (when (eq arg 0)
    (if (ediprolog-running)
        (progn
          (ediprolog-kill-prolog)
          (message "Prolog process killed."))
      (message "No Prolog process running.")))
  (unless (or (null arg) (equal arg '(4)) (equal arg '(16))
              (eq arg 0) (eq arg 1) (eq arg 2))
    (ediprolog-remove-interactions)
    (message "Interactions removed."))
  (when (or (equal arg '(4)) (equal arg '(16)) (eq arg 1) (eq arg 2))
    (ediprolog-consult (or (eq arg 2) (equal arg '(16)))))
  (when (or (null arg) (equal arg '(4)) (equal arg '(16)))
    (if (and (not (and transient-mark-mode mark-active))
             (save-excursion
               (beginning-of-line)
               (looking-at "\\([\t ]*\\)%*[\t ]*[:?]-")))
        (progn
          (setq ediprolog-indent-prefix (match-string 1))
          (let* ((from (goto-char (match-end 0)))
                 (to (or (re-search-forward "\\.[\t ]*?\\(?:%.*\\)?$" nil t)
                         (error "Missing `.' at the end of this query")))
                 (query (buffer-substring-no-properties from to)))
            (ediprolog-interact
             (format "%s\n" (apply #'concat (split-string query "\n"))))))
      (unless arg (ediprolog-consult)))))

;;;###autoload
(defun ediprolog-interact (query)
  "Send QUERY to Prolog process and interact as on a terminal."
  (unless (ediprolog-running) (ediprolog-run-prolog))
  (ediprolog-update-process-buffer)
  ;; set more verbose mode for time/1 and other messages
  (ediprolog-wait-for-prompt-after
   (process-send-string ediprolog-process
                        "set_prolog_flag(verbose,normal).\n"))
  (set-process-filter ediprolog-process 'ediprolog-interact-filter)
  (setq ediprolog-more-solutions t
        ediprolog-read-term nil)
  (process-send-string ediprolog-process query)
  (ediprolog-wait-for-response)
  ;; If timeout options for process interactions aren't available
  ;; (Emacs < 22), we give the process a bit more time to respond.
  (unless (ediprolog-emacs-geq-22) (sit-for 0.1))
  (while (ediprolog-more-solutions)
    (let (string char)
      (if ediprolog-read-term
          (setq string (concat (read-string "Input: ") "\n"))
        (while (and (ediprolog-more-solutions) (not (char-valid-p char)))
          (setq char (if (ediprolog-emacs-geq-22)
                         (read-event nil nil 0.1)
                       (read-event nil nil)))
          (if (char-valid-p char)
              (progn
                (insert char)
                (setq string (char-to-string char)))
            (when char (message "Press h for help.")))))
      (setq ediprolog-read-term nil)
      (when (ediprolog-more-solutions)
        (process-send-string ediprolog-process string))
      (when (ediprolog-more-solutions)  ; *still* more solutions?
        (ediprolog-wait-for-response)
        (unless (ediprolog-emacs-geq-22) (sit-for 0.1)))))
  (when (ediprolog-running)
    (ediprolog-wait-for-prompt-after
     (process-send-string ediprolog-process
                          "set_prolog_flag(verbose,silent).\n"))))

;;;###autoload
(defun ediprolog-remove-interactions ()
  "Remove all lines starting with `ediprolog-prefix' from buffer.

In transient mark mode, the function operates on the region if it
is active."
  (interactive)
  (save-excursion
    (save-restriction
      (when (and transient-mark-mode mark-active)
        (narrow-to-region (region-beginning) (region-end)))
      (goto-char (point-min))
      (flush-lines (concat "^[\t ]*" (regexp-quote ediprolog-prefix))))))


;;;###autoload
(defun ediprolog-consult (&optional new-process)
  "Buffer is loaded into a Prolog process. If NEW-PROCESS is
non-nil, start a new process. Otherwise use the existing process,
if any. All output from the process not equal `Yes' or `?- ' is
displayed. In case of errors, point is moved to the position of
the first error, and the mark is left at the previous position.

In transient mark mode, the function operates on the region if it
is active."
  (interactive)
  (when new-process (ediprolog-kill-prolog))
  (unless (ediprolog-running) (ediprolog-run-prolog))
  (ediprolog-update-process-buffer)
  (if ediprolog-temp-file
      (write-region "" nil ediprolog-temp-file nil 'silent)
    (setq ediprolog-temp-file (make-temp-file "ediprolog")))
  (let ((start (if (and transient-mark-mode mark-active)
                   (region-beginning) (point-min)))
        (end (if (and transient-mark-mode mark-active)
                 (region-end) (point-max))))
    (write-region start end ediprolog-temp-file nil 'silent)
    (setq ediprolog-consult-output nil
          ediprolog-first-error-line nil)
    (ediprolog-wait-for-prompt-after
     (process-send-string ediprolog-process
                          (format "['%s'].\n" ediprolog-temp-file)))
    (if ediprolog-first-error-line
        (unless (and transient-mark-mode mark-active)
          (push-mark (point) t)
          (goto-line ediprolog-first-error-line))
      (unless ediprolog-consult-output
        (message "%s consulted." (if (and transient-mark-mode mark-active)
                                     "Region" "Buffer"))))))

(defun ediprolog-running ()
  (and (processp ediprolog-process)
       (eq (process-status ediprolog-process) 'run)))

(defun ediprolog-more-solutions ()
  (and ediprolog-more-solutions (ediprolog-running)))

(defun ediprolog-interact-filter (proc string)
  (let ((lines (split-string string "\n"))
        (buffer (if (ediprolog-emacs-geq-22)
                    (process-get proc :invocation-buffer)
                  (process-buffer proc))))
    (when (member "?- " lines)
      (setq ediprolog-more-solutions nil))
    (when (member "|: " lines)
      (setq ediprolog-read-term t))
    (dolist (el '("" ";" "[print]" "[write]" "?- " " " "|: "))
      (setq lines (delete el lines)))
    (dolist (l lines)
      (when (buffer-live-p buffer)
        (with-current-buffer buffer
          (end-of-line)
          (insert "\n" ediprolog-indent-prefix ediprolog-prefix l))))))

;;;###autoload
(defun ediprolog-version ()
  "Display version of ediprolog."
  (interactive)
  (message "Using ediprolog version %s" ediprolog-version))

(defun ediprolog-map-variables (func)
  (mapc func '(ediprolog-more-solutions
               ediprolog-process
               ediprolog-first-error-line
               ediprolog-consult-output
               ediprolog-seen-prompt
               ediprolog-read-term
               ediprolog-indent-prefix
               ediprolog-temp-file)))

;;;###autoload
(defun ediprolog-localize ()
  "After `ediprolog-localize', any Prolog process started from
this buffer becomes buffer-local."
  (interactive)
  (ediprolog-map-variables #'make-local-variable)
  (setq ediprolog-temp-file nil
        ediprolog-process nil))

;;;###autoload
(defun ediprolog-unlocalize ()
  "Revert the effect of `ediprolog-localize'."
  (interactive)
  (ediprolog-kill-prolog)
  (ediprolog-map-variables #'kill-local-variable))

(provide 'ediprolog)

;;; ediprolog.el ends here