;; ediprolog -- Emacs does Interactive Prolog
;; Written Nov. 28th, 2006 by Markus Triska (triska@gmx.at)
;; Public domain code.

;; These definitions let you transparently interact with SWI Prolog in
;; all buffers.  You can load and syntax-check Prolog programs and
;; execute 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 execute 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.


(defvar ediprolog-prefix "%@% "
  "String to prepend when inserting output from the Prolog
process into the buffer.")

(defvar ediprolog-command-line-parameters '("-q" "-L2M" "-G4M" "-T4M")
  "List of command line arguments to pass to the Prolog
executable. \"-q\" should be included.")

(defvar ediprolog-prolog-executable "pl"
  "Program file name of the Prolog executable.")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defconst ediprolog-version "0.9m")

(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)
(defvar ediprolog-invocation-buffer	nil)

(defmacro ediprolog-wait-for-prompt-after (form)
  "Execute FORM and wait for prompt."
  `(progn
     (setq ediprolog-seen-prompt nil)
     ,form
     (set-process-filter ediprolog-process 'ediprolog-wait-for-prompt-filter)
     (while (not ediprolog-seen-prompt)
       (accept-process-output ediprolog-process))))

(defun ediprolog-run-prolog ()
  (ediprolog-wait-for-prompt-after
   (setq ediprolog-process
	 (apply 'start-process "ediprolog" nil ediprolog-prolog-executable
		ediprolog-command-line-parameters))))

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


(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, send the query to the Prolog
process. 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 on a query, send it to the
Prolog process. Analogously, C-u C-u for `ediprolog-consult' with
argument t. With other prefix arguments, equivalent to
`ediprolog-remove-interactions'."
  (interactive "P")
  (setq ediprolog-invocation-buffer (current-buffer))
  (if (eq arg 0)
      (if (ediprolog-running)
	  (progn
	    (kill-process ediprolog-process)
	    (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."))
  (if (or (equal arg '(4)) (equal arg '(16)) (eq arg 1) (eq arg 2))
      (ediprolog-consult (or (eq arg 2) (equal arg '(16)))))
  (if (or (null arg) (equal arg '(4)) (equal arg '(16)))
      (let ((line (thing-at-point 'line)))
	(if (string-match "^\\(\\s *\\)%*\\s *[:?]-\\s *\\(.*\\)$" line)
	    (progn
	      (setq ediprolog-indent-prefix (match-string 1 line))
	      (ediprolog-interact (format "%s\n" (match-string 2 line))))
	  (unless arg (ediprolog-consult))))))

(defun ediprolog-interact (query)
  (unless (ediprolog-running) (ediprolog-run-prolog))
  (end-of-line)
  ;; 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 (<= emacs-major-version 21) (sit-for 0.1))
  (while (and ediprolog-more-solutions (ediprolog-running))
    (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 (>= emacs-major-version 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)))
	    (if char (message "Press h for help.")))))
      (setq ediprolog-read-term nil)
      (if ediprolog-more-solutions
	  (process-send-string ediprolog-process string))
      (when ediprolog-more-solutions	; STILL more solutions?
	(ediprolog-wait-for-response)
	(if (<= emacs-major-version 21) (sit-for 0.1)))))
  (if (ediprolog-running)
      (ediprolog-wait-for-prompt-after
       (process-send-string ediprolog-process
			    "set_prolog_flag(verbose,silent).\n"))))

(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
      (if (and transient-mark-mode mark-active)
	  (narrow-to-region (region-beginning) (region-end)))
      (goto-char (point-min))
      (flush-lines (concat "^\\s *" (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. All output from the process not equal `Yes' or `?- ' is
displayed.  Therefore, `ediprolog-command-line-parameters' should
include \"-q\" to suppress various informational messages.

In transient mark mode, the function operates on the region if it
is active."
  (interactive)
  (when (or new-process (not (ediprolog-running)))
    (if (ediprolog-running) (kill-process ediprolog-process))
    (ediprolog-run-prolog))
  (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 (concat (if (and transient-mark-mode mark-active)
			     "Region" "Buffer") " consulted."))))))

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

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

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

(provide 'ediprolog)