home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / lisp / swi-prolog.el < prev   
Lisp/Scheme  |  1992-06-04  |  6KB  |  225 lines
  1. ;;; Interface to SWI-Prolog
  2. ;;; Author: Jan Wielemaker, SWI, University of Amsterdam
  3. ;;; E-mail: jan@swi.psy.uva.nl
  4.  
  5. ;;; This package forms a layer around the Quintus-Prolog interface.  It
  6. ;;; should be used together with the Prolog library 'emacs_interface.pl'.
  7.  
  8. ;;; It implements hooks that allow SWI-Prolog to give compilation-warnings
  9. ;;; back to EMACS, so the user can step through them using the normal
  10. ;;; ^X` command
  11.  
  12. ;;; Usage:
  13. ;;;
  14. ;;;     Put the following lines in your ~/.emacs:
  15. ;;;
  16. ;;;    (autoload 'run-prolog "swi-prolog" "Run an inferior prolog process" t)
  17. ;;;    (autoload 'prolog-mode "swi-prolog" "SWI-Prolog mode" t)
  18.  
  19. ;;; Notes:
  20. ;;;
  21. ;;; As far as I was able to figure out, the Quintus Prolog GNU-Emacs lisp
  22. ;;; interface can be distributed under the normal GNU general public licence
  23. ;;;
  24. ;;; This file is distributed confirm the GNU general public licence.
  25.  
  26.  
  27. (defconst qplisp-directory "/usr/local/lib/emacs/qplisp"
  28.   "Directory with all the quintus interface files")
  29. (defvar run-prolog-command "pl"
  30.   "Command to start SWI-Prolog")
  31. (defconst prolog-warning-buffer "*compilation*"
  32.   "SWI-Prolog buffer for warnings")
  33.  
  34. ;;; Get the Quintus EMACS library in your load path
  35.  
  36. (setq load-path (cons qplisp-directory load-path))
  37. (load-library "qprolog-mode")
  38. (load-library "compile")
  39. (setq prolog-prompt-pattern "^[0-9]+ \\?- ")
  40.  
  41.  
  42. (defun prolog-compilation-start (dir)
  43.   "Clear *compilation* buffer"
  44.   (save-excursion
  45.     (set-buffer (get-buffer-create prolog-warning-buffer))
  46.     (erase-buffer)
  47.     (setq default-directory dir)
  48.     (compilation-forget-errors)
  49.     (setq compilation-error-list t)
  50.     (setq compilation-error-message "No more SWI-Prolog errors")
  51.     (insert "cd " dir)
  52.     (newline)
  53.     (insert "SWI-Prolog warnings")
  54.     (newline)))
  55.  
  56.  
  57. (defun prolog-compilation-finish ()
  58.   "Finish prolog-compilation"
  59.   (save-excursion
  60.     (set-buffer prolog-warning-buffer)
  61.     (end-of-buffer)
  62.     (newline 2)
  63.     (insert "Compilation finished at " (current-time-string))
  64.     (newline)
  65.     (setq compilation-parsing-end 1)))
  66.  
  67.  
  68. (defun prolog-compilation-warning (file line msg)
  69.   "Put a prolog error-message in *compilation*"
  70.   (save-excursion
  71.     (set-buffer prolog-warning-buffer)
  72.     (end-of-buffer)
  73.     (display-buffer (current-buffer))
  74.     (insert file ":" line ": " msg)
  75.     (newline)))
  76.  
  77.  
  78. ;;; STARTING PROLOG
  79. ;;; This function is a modified version of run-prolog in qprolog-mode.el
  80.  
  81. (defun run-prolog (command)
  82.   "Run an inferior SWI-Prolog process, input and output via buffer
  83. *prolog*."
  84.   (interactive (list (read-string "Run prolog: " run-prolog-command)))
  85.   (setq run-prolog-command command)
  86.   (ensure-prolog-syntax)
  87.   (qprequire 'shell)
  88.   (get-prolog-exec-and-flags (concat command startup-jcl))
  89.   (switch-to-buffer-other-window (apply 'make-shell "prolog"
  90.                     *prolog-executable* nil  
  91.                     *prolog-flags*))
  92.   (set-process-filter (get-process "prolog") 'prolog-process-filter)
  93.   (sleep-for 2)
  94.   (inferior-prolog-mode)
  95.   (local-set-key "\t" 'prolog-dabbrev-atom)
  96.   (local-set-key "\C-d" 'prolog-complete-atom)
  97.   (local-set-key "\C-c\C-n" 'prolog-next-command)
  98.   (local-set-key "\C-c\C-p" 'prolog-previous-command))
  99.  
  100.  
  101. ;;; ATOM COMPLETION
  102.  
  103. (defvar *prolog-start-completion* nil
  104.   "Start of prolog completion")
  105. (defvar *prolog-end-completion* nil
  106.   "End of prolog completion")
  107. (defvar *prolog-atom-completions* nil
  108.   "Collect-list for prolog completions")
  109. (defvar *prolog-completion-process-mark* nil
  110.   "Process mark when starting completion")
  111.  
  112. (defun prolog-completion-backward-word ()
  113.   (interactive)
  114.   (backward-word 1)
  115.   (backward-char 1)
  116.   (if (looking-at "_")
  117.       (prolog-completion-backward-word)
  118.       (forward-char 1)))
  119.  
  120.  
  121. (defun prolog-completion-sofar ()
  122.   (setq *prolog-end-completion* (point))
  123.   (let ((end (point)))
  124.     (save-excursion
  125.       (backward-char 1)
  126.       (cond ((looking-at "[a-zA-Z0-9_]\\b")
  127.          (prolog-completion-backward-word)
  128.          (setq *prolog-start-completion* (point))
  129.          (setq *prolog-completion-process-mark*
  130.            (marker-position (process-mark
  131.                      (get-buffer-process "*prolog*"))))
  132.          (buffer-substring (point) end))
  133.         (t nil)))))
  134.  
  135. (defun prolog-complete-atom-with (extended unique)
  136.   (cond ((eq *prolog-end-completion* (point))
  137.      (kill-region *prolog-start-completion* *prolog-end-completion*)
  138.      (insert extended)
  139.      (setq *saved-prolog-process-mark* *prolog-completion-process-mark*)
  140.      (if (not unique) (message "[incomplete]")))
  141.     (t
  142.      (prolog-completion-error-message "Mismatch of dabbrev-point"))))
  143.  
  144. (defun prolog-completion-error-message (string)
  145.   (message string)
  146.   (setq *saved-prolog-process-mark* *prolog-completion-process-mark*))
  147.  
  148. ;;; DABBREV
  149.  
  150. (defun prolog-dabbrev-atom ()
  151.   (interactive)
  152.   (let (sofar)
  153.     (cond ((setq sofar (prolog-completion-sofar))
  154.        (send-prolog (concat 
  155.              "'$silent'(emacs_dabbrev_atom(\""
  156.              sofar
  157.              "\"))")))
  158.       (t
  159.        (message "Point not at end of atom")))))
  160.  
  161. ;;; COMPLETION
  162.  
  163. (defun prolog-complete-atom ()
  164.   (interactive)
  165.   (let (sofar)
  166.     (cond ((setq sofar (prolog-completion-sofar))
  167.        (send-prolog (concat
  168.              "'$silent'(emacs_complete_atom(\""
  169.              sofar
  170.              "\"))")))
  171.       (t
  172.        (message "Point not at end of atom")))))
  173.         
  174. (defun prolog-completions-start-collect ()
  175.   (setq *prolog-atom-completions* nil))
  176.  
  177. (defun prolog-transfer-completion (atom number)
  178.   (setq *prolog-atom-completions*
  179.     (cons (list atom number)
  180.           *prolog-atom-completions*)))
  181.  
  182. (defun prolog-completions-run (sofar)
  183.   (prolog-complete-atom-with
  184.    (completing-read "Complete atom: "
  185.             *prolog-atom-completions*
  186.             nil
  187.             nil
  188.             sofar)
  189.    t))
  190.   
  191. ;;; HISTORY
  192.  
  193. (defun prolog-previous-command ()
  194.   (interactive)
  195.   (end-of-buffer)
  196.   (setq *prolog-completion-process-mark*
  197.     (marker-position (process-mark (get-buffer-process "*prolog*"))))
  198.   (send-prolog "'$silent'(emacs_previous_command)"))
  199.  
  200.  
  201. (defun prolog-next-command ()
  202.   (interactive)
  203.   (end-of-buffer)
  204.   (setq *prolog-completion-process-mark*
  205.     (marker-position (process-mark (get-buffer-process "*prolog*"))))
  206.   (send-prolog "'$silent'(emacs_next_command)"))
  207.  
  208.  
  209. (defun prolog-insert-history-command (cmd)
  210.   (kill-region *prolog-completion-process-mark* (point))
  211.   (insert cmd ".")
  212.   (setq *saved-prolog-process-mark* *prolog-completion-process-mark*))
  213.  
  214.  
  215. ;;; COMPILATION
  216.  
  217. (defun prolog-recompile ()
  218.   (interactive)
  219.   (save-some-buffers)
  220.   (if (not (eq (current-buffer) (get-buffer "*prolog*")))
  221.       (pop-to-buffer (get-buffer "*prolog*") nil))
  222.   (end-of-buffer)
  223.   (insert "make.\n")
  224.   (send-prolog "make"))
  225.