[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

ediprolog 0.9x --- Emacs does Interactive Prolog

From: Markus Triska
Subject: ediprolog 0.9x --- Emacs does Interactive Prolog
Date: Tue, 14 Oct 2008 19:25:50 +0200


   * show all error messages during compilation
   * logging of recent interactions in *ediprolog-temp* buffer

Project page:


   %?- member(X, [a,b,c]).
   %@ X = a ;
   %@ X = b ;
   %@ X = c ;
   %@ false.

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

;; Copyright (C) 2006, 2007, 2008  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
;; 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 interact with SWI-Prolog in all buffers.
;; You can load and syntax-check Prolog programs and evaluate queries
;; directly in the buffer. 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 customize ediprolog with
;;     M-x customize-group RET ediprolog RET
;; Press F10 in a Prolog program to load it (point is moved to the
;; first error, if 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. Use C-g to unblock Emacs
;; in the case of long-running queries. To resume interaction with the
;; toplevel when the query is finished, use M-x ediprolog-toplevel.

;; Use M-x ediprolog-localize before loading a program to make the
;; Prolog process buffer-local. This way, you can run distinct
;; processes simultaneously. Revert with M-x ediprolog-unlocalize.

;; Tested with SWI-Prolog 5.6.55 + Emacs 21.2, 22.2 and 23.0.60.

;;; Code:

(defconst ediprolog-version "0.9x")

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

(defcustom ediprolog-program
  (or (executable-find "swipl") (executable-find "pl") "swipl")
  "Program name of the Prolog executable."
  :group 'ediprolog
  :type 'string)

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

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

(defvar ediprolog-process               nil "A Prolog process.")

(defvar ediprolog-temp-buffer           nil)

(defvar ediprolog-seen-prompt           nil
  "Whether a prompt was (recently) emitted by the Prolog process.")

(defvar ediprolog-read-term             nil
  "Whether the Prolog process waits for the user to enter a term.")

(defvar ediprolog-indent-prefix          ""
  "Any whitespace occurring before the most recently executed query.")

(defvar ediprolog-temp-file             nil
  "File name of a temporary file used for consulting the buffer.")

(defvar ediprolog-prompt "?ediprolog- "
  "Prompt used in the Prolog session. It should differ from the
default Prolog prompt.")

(defvar ediprolog-consult-buffer "*ediprolog-consult*"
  "Buffer used to display consult output.")

(defvar ediprolog-consult-window        nil
  "Window used to show consult output.")

(defvar ediprolog-max-history 80000
  "Maximal size of log buffers storing recent interactions, or
nil to never truncate the log.")

(defmacro ediprolog-wait-for-prompt-after (&rest forms)
  "Evaluate FORMS and wait for prompt."
     (setq ediprolog-seen-prompt nil)
     (with-current-buffer ediprolog-temp-buffer
       (narrow-to-region (point-max) (point-max)))
     ;; execute forms with default-directory etc. from invocation buffer
     (unless (process-filter ediprolog-process)
       (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)
         (with-timeout (0.1)
           (accept-process-output ediprolog-process))))
     (ediprolog-widen ediprolog-temp-buffer)))

(defun ediprolog-widen (buffer)
  ;; widen, and turn overlays into text that can be saved
  (with-current-buffer buffer
    (dolist (o (overlays-in (point-min) (point-max)))
      (let ((str (overlay-get o 'after-string)))
        (goto-char (overlay-start o))
        (delete-overlay o)
        (insert str)))))

(defun ediprolog-emacs-geq-22 ()
  "Whether the major version of Emacs is greater or equal 22."
  (>= emacs-major-version 22))

(defun ediprolog-ensure-temp-buffer ()
  (unless (buffer-live-p ediprolog-temp-buffer)
    (setq ediprolog-temp-buffer (generate-new-buffer "*ediprolog-temp*"))
    (buffer-disable-undo ediprolog-temp-buffer)))

(defun ediprolog-msg (string)
  ;; highlight messages and strings that are sent to the process
  (propertize string 'face '(:background "cyan")))

(defun ediprolog-run-prolog ()
  "Start a Prolog process."
  ;; 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.
  (let ((args (cons ediprolog-program ediprolog-program-switches)))
    (with-current-buffer ediprolog-temp-buffer
      (ediprolog-widen (current-buffer))
      (goto-char (point-max))
      (unless (bolp)
        (insert "\n"))
      (insert (ediprolog-msg
               (format "=== Starting new Prolog process ===\n%s\n" args))))
     (setq ediprolog-process
           (apply #'start-process "ediprolog"
                  (if (ediprolog-emacs-geq-22)
      (format "'$set_prompt'('%s').\n" ediprolog-prompt))))
  (unless (ediprolog-running)
    (error "Couldn't start Prolog process.")))

(defun ediprolog-kill-prolog ()
  "Kill the Prolog process."
  (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 ()
  "Associate the current buffer with the running Prolog process."
  (if (ediprolog-emacs-geq-22)
      (process-put ediprolog-process :invocation-buffer (current-buffer))
    (set-process-buffer ediprolog-process (current-buffer))))

(defun ediprolog-delete-consult-window ()
  (when (window-live-p ediprolog-consult-window)
    (delete-window ediprolog-consult-window)
    (bury-buffer ediprolog-consult-buffer)))

(defun ediprolog-show-consult-output (str)
  (with-current-buffer ediprolog-consult-buffer
    (insert str)
    (goto-char (point-min))
    (while (re-search-forward (concat "^\\s *\\%.*\n") nil t)
      (delete-region (match-beginning 0) (match-end 0)))
    (setq str (buffer-string)))
  ;; show consult output in a separate window unless it is a prefix of
  ;; success (i.e., consulted without errors), or still an incomplete
  ;; line that starts with a comment character
  (unless (or (string-match "^\\s *\\%.*$" str)
              (let ((success "true."))
                (and (<= (length str) (length success))
                     (string= str (substring success 0 (length str))))))
    (setq ediprolog-consult-window (display-buffer ediprolog-consult-buffer))
    (fit-window-to-buffer ediprolog-consult-window (/ (frame-height) 2))
    ;; redisplay (Emacs < 22 compatible)
    (sit-for 0)))

(defun ediprolog-consult-filter (proc string)
  "Filter used when consulting a file, showing consult output."
  (let* ((buffer (if (ediprolog-emacs-geq-22)
                     (process-get proc :invocation-buffer)
                   (process-buffer proc)))
         (temp-buffer (with-current-buffer buffer
                        ;; temp buffer can be buffer local
    (with-current-buffer temp-buffer
      (goto-char (point-max))
      (insert string)
      (when (re-search-backward
             (format "^%s" (regexp-quote ediprolog-prompt)) nil t)
        (with-current-buffer buffer
          (setq ediprolog-seen-prompt t)))
      (skip-chars-backward "\n")
      (ediprolog-show-consult-output (buffer-substring (point-min) (point))))))

(defun ediprolog-wait-for-prompt-filter (proc string)
  "Filter that only waits until prompt appears."
  (let* ((buffer (if (ediprolog-emacs-geq-22)
                     (process-get proc :invocation-buffer)
                   (process-buffer proc)))
         (temp-buffer (with-current-buffer buffer
                        ;; temp buffer can be buffer local
    (with-current-buffer temp-buffer
      (goto-char (point-max))
      (insert string)
      (when (re-search-backward
             (format "^%s" (regexp-quote ediprolog-prompt)) nil t)
        (with-current-buffer buffer
          (setq ediprolog-seen-prompt t))))))

(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)
          (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))
    (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))
               (looking-at "\\([\t ]*\\)%*[\t ]*[:?]-")))
          ;; whitespace preceding the query is the indentation level
          (setq ediprolog-indent-prefix (match-string 1))
          (let* ((from (goto-char (match-end 0)))
                 (to (if (re-search-forward "\\.[\t ]*\\(?:%.*\\)?$" nil t)
                         ;; omit trailing whitespace
                         (+ (point) (skip-chars-backward "\t "))
                       (error "Missing `.' at the end of this query")))
                 (query (buffer-substring-no-properties from to)))
            (insert "\n" ediprolog-indent-prefix ediprolog-prefix)
             (format "%s\n" (mapconcat #'identity
                                       ;; `%' can precede each query line
                                       (split-string query "\n[ \t%]*") " ")))))
      (unless arg

(defun ediprolog-interact (query)
  "Send QUERY to Prolog process and interact as on a terminal.

You can use \\[keyboard-quit] to unblock Emacs in the case of
longer-running queries. When the query completes and the toplevel
asks for input, use \\[ediprolog-toplevel] to resume interaction
with the Prolog process."
  (unless (ediprolog-running)
  (set-marker (process-mark ediprolog-process) (point))
  (with-current-buffer ediprolog-temp-buffer
    (narrow-to-region (point-max) (point-max)))
  (set-process-filter ediprolog-process 'ediprolog-interact-filter)
  (setq ediprolog-seen-prompt nil
        ediprolog-read-term nil)
  (ediprolog-send-string query)

(defun ediprolog-send-string (str)
  "Send string to Prolog process and log it."
  (with-current-buffer ediprolog-temp-buffer
    (goto-char (point-max))
    ;; save as overlay to not interfere with current output
    (let ((o (make-overlay (point-max) (point-max))))
      (overlay-put o 'after-string (ediprolog-msg str))))
  (process-send-string ediprolog-process str))

(defun ediprolog-toplevel ()
  "Start or resume Prolog toplevel interaction in the buffer.

You can use this function if you have previously quit (with
\\[keyboard-quit]) waiting for a longer-running query and now
want to resume interaction with the toplevel."
  (let ((buffer (if (ediprolog-emacs-geq-22)
                    (process-get ediprolog-process :invocation-buffer)
                  (process-buffer ediprolog-process))))
    (select-window (display-buffer buffer)))
  (while (ediprolog-more-solutions)
    (let (string
      ;; poll for user input; meanwhile, process output can arrive
      (while (and (ediprolog-more-solutions) (null string))
        (goto-char (process-mark ediprolog-process))
        (if ediprolog-read-term
              (setq string (concat (read-string "Input: ") "\n"))
               string ediprolog-indent-prefix ediprolog-prefix)
              (setq ediprolog-read-term nil))
          (condition-case nil
              (when (setq char (if (ediprolog-emacs-geq-22)
                                   (read-char nil nil 0.1)
                                 (with-timeout (0.1 nil)
                ;; char-to-string might still yield an error (C-0 etc.)
                (setq string (char-to-string char)))
            (error nil))))
      (when (ediprolog-more-solutions)
        (if (eq char ?\C-c)             ; char can be nil too
            ;; sending C-c directly yields strange SWI buffering
            (interrupt-process ediprolog-process)
          (ediprolog-send-string string))))))

(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."
      (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))))))

(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. 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."
  (when new-process
  (unless (ediprolog-running)
  (with-current-buffer (get-buffer-create ediprolog-consult-buffer)
  (unless ediprolog-temp-file
    (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))
  (set-process-filter ediprolog-process 'ediprolog-consult-filter)
   (ediprolog-send-string (format "['%s'].\n" ediprolog-temp-file)))
  (message "%s consulted." (if (and transient-mark-mode mark-active)
                               "Region" "Buffer"))
  (if (string= (with-current-buffer ediprolog-consult-buffer
                 (buffer-string)) "true.")
      ;; consulted without errors
    ;; go to line of the first error, if any
    (unless (and transient-mark-mode mark-active)
      (let (line)
        (with-current-buffer ediprolog-consult-buffer
          (when (save-excursion
                  (goto-char (point-min))
                  (re-search-forward (concat "^ERROR.*?:\\([0-9]+\\)") nil t))
            (setq line (string-to-number (match-string 1)))))
        (when line
          (goto-line line))))))

(defun ediprolog-running ()
  "True iff `ediprolog-process' is a running process."
  (and (processp ediprolog-process)
       (eq (process-status ediprolog-process) 'run)))

(defun ediprolog-more-solutions ()
  "True iff there could be more solutions from the process."
  (and (not ediprolog-seen-prompt) (ediprolog-running)))

(defun ediprolog-interact-filter (proc string)
  "Insert output from the process and update the state."
  (let* ((buffer (if (ediprolog-emacs-geq-22)
                     (process-get proc :invocation-buffer)
                   (process-buffer proc)))
         (temp-buffer (with-current-buffer buffer
                        ;; temp buffer can be buffer local
    (with-current-buffer temp-buffer
      (when (and ediprolog-max-history (> (point-min) ediprolog-max-history))
        ;; delete older half of the log
        (let ((m (set-marker (make-marker) (point-min))))
          (delete-region (point-min) (+ (point-min) (/ m 2)))
          (narrow-to-region m (point-max))))
      (goto-char (point-max))
      (insert string)
      ;; read a term from the user?
      (when (re-search-backward "^|: $" nil t)
        (with-current-buffer buffer (setq ediprolog-read-term t))
        (setq str (buffer-substring (point-min) (point-max)))
        (narrow-to-region (point-max) (point-max)))
      ;; check for prompt
      (goto-char (point-max))
      (when (re-search-backward
             (format "^%s" (regexp-quote ediprolog-prompt)) nil t)
        (with-current-buffer buffer
          (setq ediprolog-seen-prompt t)
          ;; ignore further output due to accidental user input (C-j,
          ;; C-m, etc.) while the query was running
          (set-process-filter ediprolog-process nil))
        (skip-chars-backward "\n")
        (setq str (buffer-substring (point-min) (point)))
        (ediprolog-widen (current-buffer)))
      (when (null str)
        (goto-char (point-max))
        (when (let ((l (buffer-substring (line-beginning-position) (point))))
                (and (<= (length l) (length ediprolog-prompt))
                     (string= l (substring ediprolog-prompt 0 (length l)))))
          ;; delay final line if it can still be completed to prompt
          (goto-char (line-beginning-position)))
        ;; delay emitting newlines until we are sure no prompt
        ;; follows; one or two newlines can precede a prompt
        (let ((d (abs (skip-chars-backward "\n"))))
          (when (> d 2)
            (forward-char (- d 2))))
        (setq str (buffer-substring (point-min) (point)))
        (narrow-to-region (point) (point-max)))
      (when str
          ;; precede each line with ediprolog prefices
          (insert str)
          (goto-char (point-min))
          (while (search-forward "\n" nil t)
             (format "\n%s%s" ediprolog-indent-prefix ediprolog-prefix)))
          (setq str (buffer-string)))
        (when (and (buffer-live-p buffer)
                   (with-current-buffer buffer (ediprolog-running)))
          (with-current-buffer buffer
            (let ((near (<= (abs (- (point) (process-mark ediprolog-process)))
              (ediprolog-insert-at-marker str)
              (when near
                ;; catch up with output if point was reasonably close
                (goto-char (process-mark ediprolog-process))))))))))

(defun ediprolog-insert-at-marker (&rest args)
  "Insert strings ARGS at marker and update the marker."
    (goto-char (process-mark ediprolog-process))
    (apply #'insert args)
    (set-marker (process-mark ediprolog-process) (point))))

(defun ediprolog-map-variables (func)
  "Call FUNC with all ediprolog variables that can become buffer-local."
  (mapc func '(ediprolog-process

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

(defun ediprolog-unlocalize ()
  "Revert the effect of `ediprolog-localize'."
  (when (local-variable-p 'ediprolog-process)
    (ediprolog-map-variables #'kill-local-variable)))

(provide 'ediprolog)

;;; ediprolog.el ends here

reply via email to

[Prev in Thread] Current Thread [Next in Thread]