From: Eshel Yaron Date: Wed, 10 Aug 2022 16:53:47 +0000 (+0300) Subject: Checkpoint X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=fe13be5f98ce3ed703e15809265052e7a276d056;p=dotfiles.git Checkpoint --- diff --git a/.emacs.d/esy.org b/.emacs.d/esy.org index c3bde60..361a7ff 100644 --- a/.emacs.d/esy.org +++ b/.emacs.d/esy.org @@ -1508,8 +1508,9 @@ include =emacs-lisp-mode= and =lisp-interaction-mode=. (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 @@ -1524,8 +1525,14 @@ include =emacs-lisp-mode= and =lisp-interaction-mode=. (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> @@ -1534,20 +1541,275 @@ include =emacs-lisp-mode= and =lisp-interaction-mode=. :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 @@ -1595,12 +1857,12 @@ without asking each time. :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 @@ -1848,6 +2110,13 @@ terminates, e.g. when pressing =C-d=. (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 diff --git a/.emacs.d/lisp/iprolog.el b/.emacs.d/lisp/iprolog.el new file mode 100644 index 0000000..765f59d --- /dev/null +++ b/.emacs.d/lisp/iprolog.el @@ -0,0 +1,766 @@ +;;; iprolog.el --- Interactive Prolog mode -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Eshel Yaron + +;; Authors: Eshel Yaron +;; Maintainer: Eshel Yaron +;; 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