(defun esy/setup-prolog ()
"Setup `prolog-mode' and more Prolog-related settings."
- (require 'flymake-swi-prolog)
- (flymake-swi-prolog-setup-backend))
+ (add-hook 'flymake-diagnostic-functions #'prolog-project--checker nil t)
+ (setq-local eldoc-documentation-strategy #'eldoc-documentation-default)
+ (add-hook 'eldoc-documentation-functions #'prolog-project-predicate-modes-doc nil t))
(add-hook 'prolog-mode-hook #'esy/setup-prolog)
#+end_src
(add-to-list 'rg-custom-type-aliases '("Prolog" . "*.pl *.plt *.pro *.prolog")))
#+end_src
+*** Integrate Prolog with =project.el=
-*** Per project Prolog top-level history :hook:
+#+begin_src emacs-lisp
+ (with-eval-after-load 'project
+ (add-hook 'project-find-functions #'project-try-prolog -10))
+#+end_src
+
+*** COMMENT Per project Prolog top-level history :hook:
:PROPERTIES:
:CUSTOM_ID: per-project-prolog-history
:CreatedAt: <2022-08-04 Thu>
:END:
#+begin_src emacs-lisp
- (defconst esy/prolog-input-ring-file-name ".swipl_history")
+ (defconst esy/prolog-input-ring-file-name ".prolog_history")
+
+ (defun esy/on-prolog-exec ()
+ "Setup the Prolog top-level process."
+ (when-let ((proc (get-buffer-process (current-buffer))))
+ (comint-read-input-ring t)
+ (set-process-sentinel proc #'esy/prolog-sentinel)))
+
+ (defun esy/prolog-sentinel (_proc _)
+ (comint-write-input-ring))
(defun esy/setup-project-prolog-history ()
"Setup per-project Prolog top-level history."
- (if-let ((project (project-current)))
- (progn
- (add-hook 'kill-buffer-hook #'comint-write-input-ring nil t)
- (setq comint-input-ring-file-name (expand-file-name esy/prolog-input-ring-file-name (project-root project))
- comint-input-ignoredups t)
- (comint-read-input-ring t))))
+ (when-let ((project (project-current)))
+ (setq comint-input-ring-file-name (expand-file-name esy/prolog-input-ring-file-name (project-root project))
+ comint-input-ignoredups t)
+ (esy/on-prolog-exec)
+ (add-hook 'kill-buffer-hook #'comint-write-input-ring nil t)
+ (add-hook 'comint-exec-hook #'esy/on-prolog-exec nil t)))
(add-hook 'prolog-inferior-mode-hook #'esy/setup-project-prolog-history)
#+end_src
+*** COMMENT Treat SWI-Prolog packages as =project.el= projects :prolog:
+:PROPERTIES:
+:CUSTOM_ID: swi-prolog-pack
+:CreatedAt: <2022-08-05 Fri>
+:CapturedAt:
+:CapturedAs: Emacs configuration fragment
+:END:
+
+#+begin_src emacs-lisp
+ (require 'comint)
+ (require 'project)
+
+ (defcustom swi-prolog-program "swipl"
+ "The SWI-Prolog executable."
+ :type 'string
+ :group 'prolog)
+
+ (defvar swi-prolog-project-buffer-alist nil)
+
+ (defun swi-prolog-execute-to-string (goal)
+ (shell-command-to-string (concat
+ swi-prolog-program
+ " -g "
+ (prin1-to-string (substring-no-properties goal))
+ " -t halt")))
+
+ (defvar-local swi-prolog-top-level-captured-output nil)
+
+ (defvar-local swi-prolog-top-level-capture-flag nil)
+
+ (defun swi-prolog-top-level-capture-output (s)
+ (if swi-prolog-top-level-capture-flag
+ (progn
+ (setq swi-prolog-top-level-captured-output (concat swi-prolog-top-level-captured-output s))
+ (when (string-search "\f" s)
+ (setq swi-prolog-top-level-captured-output (car (split-string swi-prolog-top-level-captured-output page-delimiter)))
+ (setq swi-prolog-top-level-capture-flag nil))
+ "")
+ s))
+
+
+ (defun swi-prolog-top-level-capture (goal)
+ "Execute GOAL and return its entire output as a string."
+ (interactive "M?- ")
+ (when-let ((default-directory (swi-prolog-pack-root)))
+ (swi-prolog-ensure-project-top-level)
+ (with-current-buffer (swi-prolog-project-top-level-buffer)
+ (let ((proc (get-buffer-process (current-buffer))))
+ (setq swi-prolog-top-level-capture-flag t)
+ (comint-send-string proc (concat "catch(ignore(notrace((" goal "))), _, _), put_code(12), flush_output.\n"))
+ (accept-process-output proc)
+ (while swi-prolog-top-level-capture-flag
+ (accept-process-output proc))
+ (let ((output swi-prolog-top-level-captured-output))
+ (setq swi-prolog-top-level-captured-output nil)
+ output)))))
+
+ (defun swi-prolog-atom-boundaries-at-point ()
+ (let ((case-fold-search nil))
+ (save-excursion
+ (backward-char)
+ (while (looking-at "[[:alnum:]_]" t)
+ (backward-char))
+ (forward-char)
+ (when (looking-at "[[:lower:]]" t)
+ (let ((start (point)))
+ (while (looking-at "[[:alnum:]_]" t)
+ (forward-char))
+ (cons start (point)))))))
+
+ (defun swi-prolog-predicate-definition (p)
+ (let ((goal (concat
+ "pi_head(("
+ p
+ "), P), predicate_property(P, file(F)), predicate_property(P, line_count(L)), writeln(F:L)")))
+ (let* ((loc (car (string-lines (swi-prolog-top-level-capture goal))))
+ (spl (split-string loc ":"))
+ (file (car spl))
+ (line (cadr spl)))
+ (when line
+ (cons file (string-to-number line))))))
+
+ ; (let* ((c (swi-prolog-predicate-definition "member/2")) (f (car c)) (l (cdr c))) (find-file f) (goto-line l))
+
+ (defun swi-prolog-current-atoms (s)
+ (let ((goal (concat
+ "forall((current_atom(A),atom_string(A, S),once(sub_string(S,_,_,_,"
+ (prin1-to-string s)
+ ")), re_match(\"^[[:lower:]][[:alnum:]_]+$\",S)),writeln(A))")))
+ (string-lines (swi-prolog-top-level-capture goal))))
+
+ (defun swi-prolog-atom-completion-at-point-function ()
+ (when-let ((default-directory (swi-prolog-pack-root)))
+ (swi-prolog-ensure-project-top-level)
+ (when-let ((bounds (swi-prolog-atom-boundaries-at-point)))
+ (let ((start (car bounds))
+ (end (cdr bounds)))
+ (list start end (completion-table-with-cache #'swi-prolog-current-atoms) :exclusive 'no)))))
+
+ (defun swi-prolog-read-current-atom ()
+ (when-let ((default-directory (swi-prolog-pack-root)))
+ (swi-prolog-ensure-project-top-level)
+ (completing-read "current_atom(A), A = " (completion-table-with-cache #'swi-prolog-current-atoms))))
+
+ (defun swi-prolog-atom-at-point ()
+ (when-let ((bounds (swi-prolog-atom-boundaries-at-point)))
+ (let ((start (car bounds))
+ (end (cdr bounds)))
+ (buffer-substring-no-properties start end))))
+
+ (defun swi-prolog-project-top-level-buffer ()
+ "."
+ (alist-get default-directory swi-prolog-project-buffer-alist nil nil #'string=))
+
+ (defun swi-prolog-pack-root ()
+ "."
+ (when-let ((proj (project-current)))
+ (when (eq 'swi-prolog-pack (car proj))
+ (project-root proj))))
+
+ (defconst swi-prolog-top-level-input-ring-file-name ".swipl_history")
+
+ (defun swi-prolog-project-top-level ()
+ "Run a SWI-Prolog top-level."
+ (interactive)
+ (when-let ((default-directory (swi-prolog-pack-root)))
+ (swi-prolog-ensure-project-top-level)
+ (switch-to-buffer-other-window (swi-prolog-project-top-level-buffer))))
+
+ (defun swi-prolog-ensure-project-top-level ()
+ (if-let ((buffer (swi-prolog-project-top-level-buffer)))
+ (swi-prolog-ensure-buffer-top-level buffer)
+ (setq swi-prolog-project-buffer-alist
+ (cons
+ (cons
+ default-directory
+ (swi-prolog-create-project-top-level))
+ swi-prolog-project-buffer-alist))))
+
+ (defun swi-prolog-ensure-buffer-top-level (buffer)
+ (if (buffer-live-p buffer)
+ (unless (process-live-p (get-buffer-process buffer))
+ (make-comint-in-buffer "swi-prolog" buffer swi-prolog-program))
+ (setf
+ (alist-get default-directory swi-prolog-project-buffer-alist nil 'remove #'string=)
+ (swi-prolog-create-project-top-level))))
+
+ (defun swi-prolog-create-project-top-level ()
+ (with-current-buffer (generate-new-buffer "swipl")
+ (swi-prolog-project-top-level-mode)
+ (make-comint-in-buffer "swi-prolog" (current-buffer) swi-prolog-program)))
+
+
+ (defun swi-prolog-project-top-level-on-exec ()
+ "Setup the Prolog top-level process."
+ (when-let ((proc (get-buffer-process (current-buffer))))
+ (set-process-sentinel proc (lambda (p _) (comint-write-input-ring)))))
+
+ (defvar swi-prolog-project-top-level-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap self-insert-command]
+ #'swi-prolog-project-top-level-self-insert-command)
+ map))
+
+ (defun swi-prolog-project-top-level-self-insert-command ()
+ "Insert the char in the buffer or pass it directly to the process."
+ (interactive)
+ (when-let ((pend (cdr comint-last-prompt)))
+ (let* ((pstart (car comint-last-prompt))
+ (prompt (buffer-substring-no-properties pstart pend)))
+ (if (and (= (point) pend)
+ (not (string= "?- " (substring prompt (- pend pstart 3) (- pend pstart))))
+ (not (string= "| " prompt)))
+ (progn
+ (call-interactively #'self-insert-command)
+ (comint-send-input))
+ (call-interactively #'self-insert-command)))))
+
+ (define-derived-mode swi-prolog-project-top-level-mode comint-mode "SWI-Prolog Project Top-level"
+ "Major mode for interacting with an inferior SWI-Prolog process."
+ :group 'swi-prolog-project-top-level
+ (setq mode-line-process (list ":"
+ (swi-prolog-pack-name)
+ ":%s")
+ comint-prompt-regexp (rx (seq line-start "?- "))
+ comint-input-ring-file-name (expand-file-name
+ swi-prolog-top-level-input-ring-file-name
+ default-directory)
+ comint-input-ignoredups t
+ comint-prompt-read-only t
+ comint-delimiter-argument-list '(?,)
+ comint-input-filter (lambda (s) (< 3 (length s))))
+ (comint-read-input-ring t)
+ (add-hook 'completion-at-point-functions #'swi-prolog-atom-completion-at-point-function -10 t)
+ (add-hook 'kill-buffer-hook #'comint-write-input-ring nil t)
+ (add-hook 'comint-preoutput-filter-functions #'swi-prolog-top-level-capture-output nil t)
+ (add-hook 'comint-exec-hook #'swi-prolog-project-top-level-on-exec nil t))
+
+ (defun swi-prolog-pack-project-try-prolog-pack (dir)
+ (when dir
+ (unless (file-remote-p dir)
+ (if (file-exists-p (expand-file-name "pack.pl" dir))
+ (let ((root (string-replace (expand-file-name "~") "~" (file-name-as-directory dir))))
+ (cons 'swi-prolog-pack root))
+ (let ((parent (file-name-directory (directory-file-name dir))))
+ (unless (string= parent dir)
+ (swi-prolog-pack-project-try-prolog-pack parent)))))))
+
+ (cl-defmethod project-root ((project (head swi-prolog-pack)))
+ "Return the root of the SWI-Prolog pack corresponding to PROJECT."
+ (cdr project))
+
+ (add-hook 'project-find-functions #'swi-prolog-pack-project-try
+
+ (defun swi-prolog-pack-name ()
+ "Return the name of the current SWI-Prolog pack."
+ (let ((default-directory (project-root (project-current))))
+ (swi-prolog-execute-to-string "consult(pack), name(N), write(N)")))
+
+ (defun swi-prolog-pack-version ()
+ "Return the version of the current SWI-Prolog pack, as a string."
+ (let ((default-directory (project-root (project-current))))
+ (swi-prolog-execute-to-string "consult(pack), vesrion(N), write(N)")))
+
+ (defun swi-prolog-pack-make-tags ()
+ "Create or update the TAGS file for the current SWI-Prolog pack."
+ (interactive)
+ (let* ((default-directory (project-root (project-current)))
+ (tags-file (expand-file-name "TAGS" default-directory))
+ (proc (start-process "swi-prolog-etags" nil xargs-program "etags" "--language=prolog")))
+ (dolist (file
+ (append
+ (directory-files-recursively
+ (swi-prolog-execute-to-string
+ "absolute_file_name(library(.), V), write(V)")
+ "\\.pl$")
+ (directory-files-recursively
+ (expand-file-name "prolog" default-directory)
+ "\\.pl$")))
+ (process-send-string proc file)
+ (process-send-string proc "\n"))
+ (process-send-eof proc)
+ (while (process-live-p proc))
+ (visit-tags-table tags-file t)))
+#+end_src
+
* LaTeX and PDF settings
:PROPERTIES:
:CUSTOM_ID: latex-and-pdf
:END:
#+begin_src emacs-lisp
- (defconst esy/projects-directory "~/checkouts"
+ (defconst esy/projects-directory "~/checkouts/"
"Path of the projects directory.")
(add-hook 'kill-emacs-hook
(lambda () (project-remember-projects-under
- esy/projects-directory)))
+ (expand-file-name esy/projects-directory))))
#+end_src
** Project switch commands
(add-hook 'after-init-hook #'esy/setup-misc)
#+end_src
+** Use =consult= to show =xref= results
+#+begin_src emacs-lisp
+ (with-eval-after-load 'xref
+ (setq xref-show-definitions-function #'consult-xref
+ xref-show-xrefs-function #'consult-xref))
+#+end_src
+
** Show the time in Amsterdam in =world-clock=
:PROPERTIES:
:CUSTOM_ID: world-clock-amsterdam
--- /dev/null
+;;; iprolog.el --- Interactive Prolog mode -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Eshel Yaron
+
+;; Authors: Eshel Yaron <me(at)eshelyaron(dot)com>
+;; Maintainer: Eshel Yaron <me(at)eshelyaron(dot)com>
+;; Keywords: prolog major mode
+
+;; This file is NOT part of GNU Emacs.
+
+;;; Package-Version: 0.1.0
+;;; Package-Requires: ((emacs "29"))
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'project)
+(require 'comint)
+(require 'flymake)
+
+(defgroup iprolog nil
+ "Editing and running Prolog code."
+ :group 'prolog)
+
+(defcustom iprolog-program "swipl"
+ "The Prolog executable."
+ :type 'string
+ :group 'iprolog)
+
+(defcustom iprolog-beginning-of-term-regexp
+ (rx (seq line-start
+ (not (or "%" "/" " " "\t"))
+ (not (or "%" "/" " " "\t"))))
+ "Regular expression matching the beginning of top Prolog terms."
+ :type 'regexp
+ :group 'iprolog)
+
+(defcustom iprolog-project-definition-file-name "pack.pl"
+ "File name for Prolog project definitions."
+ :type 'string
+ :group 'iprolog)
+
+(defun iprolog-beginning-of-term (&optional n)
+ "Move to the beginning of the current term.
+If already at the beginning of a term, move to previous term.
+
+With numeric prefix argument N, move this many terms backward."
+ (interactive "p" nil iprolog-mode)
+ (let ((times (or n 1)))
+ (while (< 0 times)
+ (search-backward-regexp iprolog-beginning-of-term-regexp nil t)
+ (beginning-of-line)
+ (setq times (1- times)))))
+
+(defun iprolog-beginning-of-next-term ()
+ "Move to the beginning of the next term."
+ (interactive nil iprolog-mode)
+ (goto-char (1+ (line-beginning-position)))
+ (or (search-forward-regexp iprolog-beginning-of-term-regexp nil t)
+ (goto-char (point-max)))
+ (beginning-of-line))
+
+(defun iprolog--atom-at-point ()
+ (when-let ((bounds (iprolog--atom-boundaries-at-point)))
+ (let ((start (car bounds))
+ (end (cdr bounds)))
+ (buffer-substring-no-properties start end))))
+
+(defun iprolog--atom-boundaries-at-point ()
+ (let ((case-fold-search nil))
+ (save-mark-and-excursion
+ (save-match-data
+ (unless (bobp) (backward-char))
+ (while (looking-at "[[:alnum:]_]" t)
+ (backward-char))
+ (forward-char)
+ (when (looking-at "[[:lower:]]" t)
+ (let ((start (point)))
+ (while (looking-at "[[:alnum:]_]" t)
+ (forward-char))
+ (cons start (point))))))))
+
+(defun iprolog-save-and-load-buffer ()
+ (interactive nil iprolog-mode)
+ (save-buffer)
+ (iprolog--request-goal-output (concat "[\""
+ (buffer-file-name)
+ "\"]")
+ (lambda (_)
+ (message "iprolog: buffer loaded."))))
+
+(defun iprolog-eval-dwim (&optional insert)
+ (interactive "P" iprolog-mode)
+ (if (region-active-p)
+ (iprolog-eval-region (region-beginning) (region-end))
+ (save-mark-and-excursion
+ (save-match-data
+ (iprolog-beginning-of-next-term)
+ (let ((end (point)))
+ (iprolog-beginning-of-term)
+ (iprolog-eval-region (point) end insert))))))
+
+(defun iprolog-eval-region (beg end &optional insert)
+ (interactive "r\nP" iprolog-mode)
+ (let ((goal (buffer-substring-no-properties beg end))
+ (default-directory (or (iprolog-project--root)
+ default-directory)))
+ (iprolog--ensure-top-level)
+ (iprolog--request-goal-output goal
+ (if insert
+ (lambda (o)
+ (message "iprolog: inserting output.")
+ (newline)
+ (insert o))
+ (lambda (o)
+ (message "iprolog: received output %s" o))))))
+
+(defvar-keymap iprolog-mode-map
+ :doc "Keymap for `iprolog-mode'."
+ "M-a" #'iprolog-beginning-of-term
+ "C-M-x" #'iprolog-eval-dwim
+ "C-c C-t" #'iprolog-top-level
+ "C-c C-l" #'iprolog-save-and-load-buffer)
+
+;;;###autoload
+(define-derived-mode iprolog-mode prog-mode "iprolog"
+ "Major mode for editing Prolog code."
+ :group 'iprolog
+ (setq-local comment-start "%")
+ (setq-local comment-start-skip "\\(?:/\\*+ *\\|%+ *\\)")
+ (setq-local parens-require-spaces nil)
+ ;; (add-hook 'flymake-diagnostic-functions #'iprolog--checker nil t)
+ (setq-local eldoc-documentation-strategy #'eldoc-documentation-default)
+ (add-hook 'eldoc-documentation-functions #'iprolog-predicate-modes-doc nil t)
+ (add-hook 'completion-at-point-functions #'iprolog--atom-completion-at-point-function nil t)
+ (add-hook 'after-change-functions
+ (lambda (b e l)
+ (message "change %s %s %s in %s" b e l (current-buffer)))
+ nil t)
+ ;; (setq-local compile-command ...)
+ ;; (setq-local electric-indent-chars ...)
+ ;; (setq-local align-rules-alist ...)
+ ;; (setq-local imenu-create-index-function ...)
+ (setq jit-lock-chunk-size 262144)
+ (setq-local font-lock-defaults
+ '(nil
+ t
+ nil
+ nil
+ (font-lock-fontify-region-function . iprolog-fontify-region))))
+
+;;;; project.el integration
+
+(defun iprolog--execute-to-string (goal)
+ "Run Prolog with initial goal GOAL and return its output as a string."
+ (shell-command-to-string (concat
+ iprolog-program
+ " -g "
+ (prin1-to-string (substring-no-properties goal))
+ " -t halt")))
+
+;;;###autoload
+(defun project-try-prolog (dir)
+ "Find a Prolog project definition file in DIR or a parent thereof.
+Prolog project definition files are identified according to the
+value of `iprolog-project-definition-file-name'."
+ (when dir
+ (unless (file-remote-p dir)
+ (if (file-exists-p (expand-file-name iprolog-project-definition-file-name
+ dir))
+ (let ((root (string-replace (expand-file-name "~") "~"
+ (file-name-as-directory dir))))
+ (cons 'iprolog-project root))
+ (let ((parent (file-name-directory (directory-file-name dir))))
+ (unless (string= parent dir)
+ (project-try-prolog parent)))))))
+
+(cl-defmethod project-root ((project (head iprolog-project)))
+ "Return the root of the Prolog project PROJECT."
+ (cdr project))
+
+(defun iprolog-project--root ()
+ "Return the root directory of the current Prolog project."
+ (when-let ((proj (project-current)))
+ (when (eq 'iprolog-project (car proj))
+ (project-root proj))))
+
+(defun iprolog-project--name ()
+ "Return the name of the current Prolog project."
+ (let ((default-directory (project-root (project-current))))
+ (iprolog--execute-to-string "consult(pack), name(N), write(N)")))
+
+(defun iprolog-project--version ()
+ "Return the version of the current Prolog project, as a string."
+ (let ((default-directory (project-root (project-current))))
+ (iprolog--execute-to-string "consult(pack), version(N), write(N)")))
+
+
+;;;; top-level
+
+(defvar iprolog--top-level-buffers-alist nil
+ "Global mapping between directories and Prolog top-level buffers.")
+
+(defvar-local iprolog-top-level--capture-flag nil
+ "Non-nil means we are currently capturing process output.")
+
+(defvar-local iprolog-top-level--captured-output nil
+ "Accumulated captured process output.")
+
+(defvar-local iprolog--helper-connection nil)
+
+(defvar-local iprolog--pending-requests (make-ring 128))
+
+(defvar-local iprolog--last-request-id 0)
+
+(defvar-local iprolog--sync-output nil)
+
+(defvar iprolog--last-helper-port 11111)
+
+(defun iprolog--ensure-top-level ()
+ (if-let ((buffer (iprolog--top-level-buffer)))
+ (iprolog--ensure-top-level-in-buffer buffer)
+ (setq iprolog--top-level-buffers-alist
+ (cons
+ (cons
+ default-directory
+ (iprolog--create-top-level))
+ iprolog--top-level-buffers-alist))))
+
+(defun iprolog--ensure-top-level-in-buffer (buffer)
+ "Make sure a Prolog top-level in running in BUFFER."
+ (if (buffer-live-p buffer)
+ (unless (process-live-p (get-buffer-process buffer))
+ (iprolog--make-top-level buffer))
+ (setf
+ (alist-get default-directory
+ iprolog--top-level-buffers-alist
+ nil 'remove #'string=)
+ (iprolog--create-top-level))))
+
+(defun iprolog--top-level-buffer ()
+ "Return the top-level buffer associated with `default-directory'."
+ (alist-get default-directory
+ iprolog--top-level-buffers-alist nil nil #'string=))
+
+(defun iprolog--create-top-level ()
+ (with-current-buffer (generate-new-buffer "*Prolog top-level*")
+ (iprolog-top-level-mode)
+ (iprolog--make-top-level (current-buffer))))
+
+(defun iprolog--make-top-level-old (buffer)
+ "Create a Prolog top-level process in BUFFER."
+ (make-comint-in-buffer
+ "top-level" buffer iprolog-program nil
+ "-q"
+ "-g" "[library(pldoc)]"
+ "-g" "[library(pldoc/doc_process)]"
+ "-g" "[library(pldoc/doc_wiki)]"
+ "-g" "[library(pldoc/doc_modes)]"
+ "-g" "[library(pldoc/doc_man)]"
+ "-g" "[library(lynx/html_text)]"
+ "-g" "[library(diagnostics)]"
+ "-t" "prolog"))
+
+(defun iprolog--make-top-level (buffer)
+ (iprolog-top-level--start-in-buffer buffer
+ (setq iprolog--last-helper-port
+ (1+ iprolog--last-helper-port))))
+
+(defun iprolog-top-level--start-in-buffer (buffer port)
+ "Create a Prolog top-level process in BUFFER.
+Also start a Prolog server listening on UDP port PORT."
+ (make-comint-in-buffer
+ "top-level" buffer iprolog-program nil
+ "-g" "[library(pldoc)]"
+ "-g" "[library(pldoc/doc_process)]"
+ "-g" "[library(pldoc/doc_wiki)]"
+ "-g" "[library(pldoc/doc_modes)]"
+ "-g" "[library(pldoc/doc_man)]"
+ "-g" "[library(lynx/html_text)]"
+ "-g" "[library(diagnostics)]"
+ "-g" (concat "thread_create((udp_socket(Socket), tcp_bind(Socket," (number-to-string port) "), tcp_setopt(Socket, sndbuf(65535)), repeat, (catch(udp_receive(Socket, Data, Peer, [as(term),encoding(utf8)]), Ball, (debug(iprolog, \"Caught ~q.\", [Ball]), fail)), debug(iprolog, \"Got ~p from ~q.\", [Data, Peer]), Data = (Id :- Goal) -> debug(iprolog, \"Executing goal ~w.\", [Goal]), catch(with_output_to(string(Output), ignore(Goal)), GBall, (debug(iprolog, \"Ball ~q thrown during goal execution.\", [GBall]), fail)), string_concat(Id, \" :- \", Prefix), string_concat(Prefix, Output, Reply0), (string_length(Reply0, Length), Length > 49152 -> debug(iprolog, \"detected large output (~w characters long).\", [Length]), sub_string(Reply0, 0, 49152, _, Reply) ; Reply = Reply0), udp_send(Socket, Reply, Peer, [encoding(utf8)]), debug(iprolog, \"Sending reply ~w.\", [Reply]) ; debug(iprolog, \"udp_receive failed.\", [])), fail), _, [])")
+ "-t" "prolog")
+ (setq iprolog--helper-connection
+ (make-network-process
+ :name "iprolog_helper"
+ :host 'local
+ :service port
+ :type 'datagram
+ :filter
+ (lambda (_proc output)
+ (when-let ((cd (save-match-data
+ (string-match
+ (rx (seq (group (+ digit)) " :- " (group (* anychar))))
+ output)
+ (let ((id (string-to-number (match-string 1 output)))
+ (data (match-string 2 output)))
+ (when-let ((cb (alist-get id (ring-elements (with-current-buffer buffer
+ iprolog--pending-requests)))))
+ (cons cb data))))))
+ (funcall (car cd) (cdr cd))))))
+ buffer)
+
+(defun iprolog--request-goal-output (goal cb)
+ "Request evaluation of GOAL, setting up CB to handle its output."
+ (let ((default-directory (or (iprolog-project--root)
+ default-directory)))
+ (iprolog--ensure-top-level)
+ (with-current-buffer (iprolog--top-level-buffer)
+ (setq iprolog--last-request-id
+ (1+ iprolog--last-request-id))
+ (ring-insert iprolog--pending-requests
+ (cons iprolog--last-request-id cb))
+ (process-send-string iprolog--helper-connection
+ (concat (number-to-string iprolog--last-request-id)
+ " :- " goal)))))
+
+(defun iprolog--request-goal-sync (goal)
+ "Request evaluation of GOAL and return output its as a string."
+ (let ((default-directory (or (iprolog-project--root)
+ default-directory)))
+ (iprolog--ensure-top-level)
+ (let ((buffer (iprolog--top-level-buffer)))
+ (with-current-buffer buffer
+ (setq iprolog--sync-output nil)
+ (iprolog--request-goal-output goal
+ (lambda (o)
+ (with-current-buffer buffer
+ (setq iprolog--sync-output o))))
+ (while (null iprolog--sync-output)
+ (accept-process-output iprolog--helper-connection 10))
+ iprolog--sync-output))))
+
+(defun iprolog-top-level--on-exec ()
+ "Setup the Prolog top-level process."
+ (when-let ((proc (get-buffer-process (current-buffer))))
+ (set-process-sentinel proc (lambda (_ _) (comint-write-input-ring)))
+ (accept-process-output proc 10)))
+
+(defvar iprolog-top-level-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap self-insert-command]
+ #'iprolog-top-level--self-insert-command)
+ map))
+
+(defun iprolog-top-level--self-insert-command ()
+ "Insert the char in the buffer or pass it directly to the process."
+ (interactive)
+ (when-let ((pend (cdr comint-last-prompt)))
+ (let* ((pstart (car comint-last-prompt))
+ (prompt (buffer-substring-no-properties pstart pend)))
+ (if (and (= (point) pend)
+ (not (string-empty-p prompt))
+ (not (string= "?- " (substring prompt (- pend pstart 3) (- pend pstart))))
+ (not (string= "| " prompt)))
+ (progn
+ (call-interactively #'self-insert-command)
+ (comint-send-input))
+ (call-interactively #'self-insert-command)))))
+
+(defgroup iprolog-top-level nil
+ "Interactive Prolog top-level."
+ :group 'iprolog)
+
+(defcustom iprolog-top-level-input-ring-file-name ".iprolog_history"
+ "File name to use for persisting Prolog top-level history."
+ :type 'string
+ :group 'iprolog-top-level)
+
+(defcustom iprolog-top-level-display-buffer-action
+ '((display-buffer-reuse-window display-buffer-below-selected)
+ (window-height . 16))
+ "The action used to display the top-level buffer."
+ :type '(cons (choice (function :tag "Display Function")
+ (repeat :tag "Display Functions" function))
+ alist)
+ :package-version '(iprolog . "0.1.0")
+ :group 'iprolog-top-level)
+
+;;;###autoload
+(defun iprolog-top-level ()
+ "Switch to the current project's Prolog top-level."
+ (interactive)
+ (let ((default-directory (or (iprolog-project--root)
+ default-directory)))
+ (iprolog--ensure-top-level)
+ (display-buffer (iprolog--top-level-buffer) iprolog-top-level-display-buffer-action)
+ (switch-to-buffer-other-window (iprolog--top-level-buffer))
+ (set-window-dedicated-p (selected-window) t)
+ (goto-char (point-max))))
+
+(defun iprolog-top-level--capture-output (output)
+ "When `iprolog-top-level--capture-flag' in non-nil, capture OUTPUT."
+ (pcase iprolog-top-level--capture-flag
+ ('t
+ (setq iprolog-top-level--captured-output
+ (concat iprolog-top-level--captured-output output))
+ (when-let ((endpos (string-search "\f" output)))
+ (setq iprolog-top-level--captured-output
+ (car (split-string iprolog-top-level--captured-output
+ "\f")))
+ (setq iprolog-top-level--capture-flag
+ (let ((promptpos (string-search "?- " output))
+ (temppos nil))
+ (while promptpos
+ (setq temppos (1+ promptpos))
+ (setq promptpos (string-search "?- " output temppos)))
+ (unless (and temppos (< endpos temppos))
+ 'prompt))))
+ "")
+ ('prompt
+ (when (string-search "?- " output)
+ (setq iprolog-top-level--capture-flag nil))
+ "")
+ (`(callback ,cb ,f)
+ (if-let ((endpos (string-search "\f" output)))
+ (let ((data (car (split-string
+ output
+ "\f"))))
+ (funcall cb data)
+ (funcall f)
+ (setq iprolog-top-level--capture-flag
+ (let ((promptpos (string-search "?- " output))
+ (temppos nil))
+ (while promptpos
+ (setq temppos (1+ promptpos))
+ (setq promptpos (string-search "?- " output temppos)))
+ (unless (and temppos (< endpos temppos))
+ 'prompt))))
+ (funcall cb output))
+ "")
+ (_ output)))
+
+;;;###autoload
+(define-derived-mode iprolog-top-level-mode comint-mode "iprolog Top-level"
+ "Major mode for interacting with an inferior Prolog interpreter."
+ :group 'iprolog-top-level
+ (setq mode-line-process (list ":"
+ (or (iprolog-project--name) "")
+ ":"
+ (or (iprolog-project--version) "")
+ ":%s")
+ comint-prompt-regexp (rx (seq line-start "?- "))
+ comint-input-ring-file-name (expand-file-name
+ iprolog-top-level-input-ring-file-name
+ default-directory)
+ comint-input-ignoredups t
+ comint-prompt-read-only t
+ comint-delimiter-argument-list '(?,)
+ comint-input-filter (lambda (s) (< 3 (length s))))
+ (comint-read-input-ring t)
+ (add-hook 'comint-preoutput-filter-functions #'iprolog-top-level--capture-output nil t)
+ (add-hook 'comint-exec-hook #'iprolog-top-level--on-exec nil t)
+ (setq read-process-output-max 49152)
+ (add-hook 'kill-buffer-hook #'comint-write-input-ring nil t)
+ (setq-local eldoc-documentation-strategy #'eldoc-documentation-default)
+ (add-hook 'completion-at-point-functions #'iprolog--atom-completion-at-point-function -10 t)
+ (add-hook 'eldoc-documentation-functions #'iprolog-predicate-modes-doc -10 t))
+
+
+;; (defun iprolog-execute-goal-with-callback (goal cb f)
+;; "Execute GOAL, setting up CB to handle its output and F its exit."
+;; (when-let ((default-directory (iprolog-project--root)))
+;; (iprolog--ensure-top-level)
+;; (with-current-buffer (iprolog--top-level-buffer)
+;; (let ((proc (get-buffer-process (current-buffer))))
+;; (while iprolog-top-level--capture-flag
+;; (accept-process-output proc 10))
+;; (setq iprolog-top-level--capture-flag (list 'callback cb f))
+;; (comint-send-string proc (concat "catch(ignore(notrace((" goal "))), _, _), put_code(12), flush_output.\n"))))))
+
+;;;; flymake integration
+
+(defun iprolog--parse-diagnostic (line start)
+ (when (string-match (rx
+ (seq line-start
+ (group (or "warning" "error"))
+ ":"
+ (group (+ (not ":")))
+ ":"
+ (group (+ digit))
+ ":"
+ (group (+ digit))
+ ": "
+ (group (+ anychar))))
+ line)
+ (let* ((line-prefix (match-string 1 line))
+ (path (match-string 2 line))
+ (buff (find-buffer-visiting path))
+ (beg (+ (string-to-number (match-string 3 line)) start))
+ (end (+ beg (string-to-number (match-string 4 line))))
+ (text (match-string 5 line))
+ (type (if (string= "warning" line-prefix) :warning :error)))
+ (when buff
+ (flymake-make-diagnostic buff beg end type text)))))
+
+;;;###autoload
+(defun iprolog--checker (report-fn &rest args)
+ "Flymake backend function for Prolog projects.
+REPORT-FN is the reporting function passed to backend by Flymake,
+as documented in `flymake-diagnostic-functions', ARGS"
+ (let* ((end (when-let ((pos (plist-get args :changes-end)))
+ (save-mark-and-excursion
+ (save-match-data
+ (goto-char pos)
+ (iprolog-beginning-of-next-term)
+ (point)))))
+ (start (if-let ((pos (plist-get args :changes-start)))
+ (save-mark-and-excursion
+ (save-match-data
+ (goto-char pos)
+ (iprolog-beginning-of-term)
+ (point)))
+ (point-min)))
+ (buffer (current-buffer))
+ (tempfile (make-temp-file "iprolog--checker")))
+ (with-temp-file tempfile
+ (insert-buffer-substring buffer start end))
+ (iprolog--request-goal-output
+ (concat "'" (buffer-file-name buffer) "' = Path, [Path], diagnose(Path,'" tempfile "')")
+ (if end
+ (lambda (o)
+ (with-current-buffer buffer
+ (funcall report-fn
+ (or (delq nil
+ (seq-map
+ (lambda (line)
+ (iprolog--parse-diagnostic line start))
+ (string-lines o t)))
+ nil)
+ :region (cons start end))))
+ (lambda (o)
+ (with-current-buffer buffer
+ (dolist (line (string-lines o t))
+ (when-let ((diag (iprolog--parse-diagnostic line start)))
+ (funcall report-fn (list diag)))))))))
+ t)
+
+
+;;;; eldoc integration
+
+;;;###autoload
+(defun iprolog-predicate-modes-doc (callback &rest _ignored)
+ "Document predicate at point.
+Intended for `eldoc-documentation-functions', which see for
+explanation about the argument CALLBACK."
+ (save-mark-and-excursion
+ (save-match-data
+ (when-let ((sym (iprolog--atom-at-point)))
+ (iprolog--request-goal-output
+ (concat
+ "forall((doc_comment(M:("
+ sym
+ ")/N, Pos, OneLiner, Comment), is_structured_comment(Comment, Prefixes), string_codes(Comment, Codes), indented_lines(Codes, Prefixes, Lines), process_modes(Lines, M, Pos, Modes0, _, _), maplist({M}/[mode(Mode0,Args),(M:Mode1 is Det)]>>(maplist([Name=Var]>>(Var='$VAR'(Name)), Args), (Mode0 = (Mode1 is Det) -> true ; Mode1 = Mode0, Det = unspec)), Modes0, Modes)), maplist([Head is Det]>>format('~W is ~w.~n ~w~n', [Head, [module(pldoc_modes), numbervars(true)], Det, OneLiner]), Modes)),forall(call(pldoc_man:load_man_object(("
+ sym
+ ")/_, _, _, Dom)), (with_output_to(string(DomS), html_text(Dom, [])), sub_string(DomS, EOL, _, _, '\\n'), sub_string(DomS, 0, EOL, _, FLine), sub_string(DomS, EOL, _, 0, Rest), (sub_string(Rest, EOS, _, _, '. ') -> sub_string(Rest, 0, EOS, _, OneLiner2) ; OneLiner2 = Rest), format('~w. ~w.~n', [FLine, OneLiner2]), !))")
+ (lambda (o)
+ (funcall callback o
+ :thing sym
+ :face 'font-lock-function-name-face)))))))
+
+;;;; completions
+
+
+(defun iprolog--current-atoms-completion-table (atom)
+ (let ((goal (concat
+ "forall((current_atom(A),atom_string(A, S),once(sub_string(S,_,_,_,"
+ (prin1-to-string atom)
+ ")), re_match(\"^[[:lower:]][[:alnum:]_]+$\",S)),writeln(A))")))
+ (string-lines (iprolog--request-goal-sync goal))))
+
+(defun iprolog--atom-completion-at-point-function ()
+ (let ((default-directory (or (iprolog-project--root)
+ default-directory)))
+ (iprolog--ensure-top-level)
+ (when-let ((bounds (iprolog--atom-boundaries-at-point)))
+ (let ((start (car bounds))
+ (end (cdr bounds)))
+ (list start
+ end
+ (completion-table-with-cache #'iprolog--current-atoms-completion-table)
+ :exclusive 'no)))))
+
+(provide 'iprolog)
+
+
+;;;; font lock
+
+(defun iprolog--parse-fontification-line (line start)
+ (when (string-match (rx
+ (seq line-start
+ (group (+ digit))
+ ":"
+ (group (+ digit))
+ ":"
+ (group (+ anychar))))
+ line)
+ (let* ((beg (+ (string-to-number (match-string 1 line)) start))
+ (end (+ beg (string-to-number (match-string 2 line))))
+ (type (match-string 3 line)))
+ (cons
+ beg
+ (cons
+ end
+ (cond
+ ((string= type "clause")
+ '(nil t))
+ ((string= type "directive")
+ '(nil t))
+ ((string= type "grammar_rule")
+ '(nil t))
+ ((string= type "comment(structured)")
+ (list font-lock-comment-face t))
+ ((string= type "comment(block)")
+ (list font-lock-comment-face t))
+ ((string= type "string")
+ (list font-lock-string-face t))
+ ((string= type "predicate_indicator")
+ (list font-lock-function-name-face nil))
+ ((string= type "arity")
+ (list font-lock-function-name-face nil))
+ ((string-match (rx (seq line-start
+ "predicate_indicator("
+ (+ anychar)
+ ")"))
+ type nil t)
+ (list font-lock-function-name-face nil))
+ ((string= type "functor")
+ (list font-lock-function-name-face nil))
+ ((string-match (rx (seq line-start
+ "head("
+ (+ anychar)
+ ")"))
+ type nil t)
+ (list font-lock-builtin-face nil))
+ ((string-match (rx (seq line-start
+ "goal(recursion"
+ (+ anychar)
+ ")"))
+ type nil t)
+ (list font-lock-builtin-face nil))
+ ((string-match (rx (seq line-start
+ "goal(built_in"
+ (+ anychar)
+ ")"))
+ type nil t)
+ (list font-lock-keyword-face nil))
+ ((string-match (rx (seq line-start
+ "goal("
+ (+ anychar)
+ ")"))
+ type nil t)
+ (list font-lock-function-name-face nil))
+ ((string= type "comment(line)")
+ (list font-lock-comment-face nil))
+ ((string-match (rx (seq line-start
+ "neck("
+ (+ anychar)
+ ")"))
+ type nil t)
+ (list font-lock-preprocessor-face nil))
+ ((string= type "var")
+ (list font-lock-variable-name-face nil))
+ ((string= type "empty_list")
+ (list font-lock-keyword-face nil))
+ ((string= type "fullstop")
+ (list font-lock-keyword-face nil))
+ ((string= type "control")
+ (list font-lock-keyword-face nil))
+ ((string= type "atom")
+ (list font-lock-constant-face nil))
+ ((string= type "int")
+ (list font-lock-constant-face nil))
+ ((string= type "error")
+ (list font-lock-warning-face nil))
+ ((string-match (rx (seq line-start
+ "syntax_error("
+ (+ anychar)
+ ")"))
+ type nil t)
+ (list font-lock-negation-char-face t))
+ ((string= type "singleton")
+ (list font-lock-warning-face t))
+ ((string-match (rx (seq line-start
+ "module("
+ (+ anychar)
+ ")"))
+ type nil t)
+ (list font-lock-type-face nil))
+ ((string= type "identifier")
+ (list font-lock-constant-face nil))))))))
+
+(defvar-local iprolog-fontified nil)
+
+(defun iprolog-fontify-region (beg0 end0 _loudly)
+ (let ((beg (if iprolog-fontified beg0 (point-min)))
+ (end (if iprolog-fontified end0 (point-max)))
+ (buffer (current-buffer))
+ (default-directory (or (iprolog-project--root)
+ default-directory)))
+ (message "doin %s" (- end beg))
+ (iprolog--ensure-top-level)
+ (let* ((tempfile (make-temp-file
+ "iprolog--fontify"
+ nil
+ ".pl")))
+ (with-temp-file tempfile
+ (insert-buffer-substring buffer beg end))
+ (iprolog--request-goal-output
+ (concat "\""
+ tempfile
+ "\"= Path, xref_source('"
+ (buffer-file-name buffer)
+ "'), setup_call_cleanup(prolog_open_source(Path, Stream), prolog_colourise_stream(Stream, Path, [T, S, L]>>format(\"~w:~w:~w~n\", [S,L,T])), prolog_close_source(Stream))")
+ (lambda (o)
+ (with-current-buffer buffer
+ (with-silent-modifications
+ (dolist (line (string-lines o t))
+ (when-let ((f (iprolog--parse-fontification-line line beg)))
+ (let ((fs (car f))
+ (fe (cadr f))
+ (ff (caddr f))
+ (fm (cadddr f)))
+ (if ff
+ (put-text-property fs fe 'font-lock-face ff)
+ (remove-text-properties fs fe '(font-lock-face)))
+ (when fm
+ (put-text-property fs fe 'font-lock-multiline t))))))
+ (setq iprolog-fontified t))
+ (delete-file tempfile))))
+ `(jit-lock-bounds ,beg . ,end)))
+
+
+(defun iprolog-fontify-window ()
+ (let ((buffer (current-buffer))
+ (default-directory (or (iprolog-project--root)
+ default-directory)))
+ (iprolog--ensure-top-level)
+ (let ((start (save-mark-and-excursion
+ (save-match-data
+ (goto-char (window-start))
+ (iprolog-beginning-of-term)
+ (point))))
+ (end (save-mark-and-excursion
+ (save-match-data
+ (goto-char (window-end))
+ (iprolog-beginning-of-next-term)
+ (point))))
+ (tempfile (make-temp-file "iprolog--fontify")))
+ (with-temp-file tempfile
+ (insert-buffer-substring buffer start end))
+ (iprolog--request-goal-output
+ (concat "\""
+ tempfile
+ "\"= Path, xref_source(Path), setup_call_cleanup(prolog_open_source(Path, Stream), prolog_colourise_stream(Stream, Path, [T, S, L]>>format(\"~w:~w:~w~n\", [S,L,T])), prolog_close_source(Stream))")
+ (lambda (o)
+ (with-current-buffer buffer
+ (dolist (line (string-lines o t))
+ (when-let ((f (iprolog--parse-fontification-line line start)))
+ (let ((fs (car f))
+ (fe (cadr f))
+ (ff (caddr f)))
+ (add-face-text-property fs fe ff))))))))))
+
+;;; iprolog.el ends here
projects / dotfiles.git / commitdiff