+++ /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 "28"))
-
-;;; 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."
- :package-version '((iprolog . "0.1.0"))
- :type 'string
- :risky t
- :group 'iprolog)
-
-(defgroup iprolog-project nil
- "Prolog projects."
- :group 'iprolog)
-
-(defcustom iprolog-project-definition-file-name "pack.pl"
- "File name for Prolog project definitions."
- :package-version '((iprolog . "0.1.0"))
- :type 'string
- :group 'iprolog-project)
-
-(defcustom iprolog-enable-flymake t
- "When Non-nil, enable integration with `flymake-mode'."
- :package-version '((iprolog . "0.1.0"))
- :type 'boolean
- :group 'iprolog)
-
-(defcustom iprolog-enable-flymake t
- "When Non-nil, enable integration with `eldoc'."
- :package-version '((iprolog . "0.1.0"))
- :type 'boolean
- :group 'iprolog)
-
-
-;; (defun iprolog-forward-term-2 (&optional arg _interactive)
-;; "Backend for `forward-sexp', which see for the meaning of ARG."
-;; (font-lock-ensure)
-;; (iprolog-font-lock-ensure-function)
-;; (let* ((point (ponit))
-;; (times0 (or arg 1))
-;; (dir (or (and (< 0 times0) 1) -1))
-;; (times (abs times0)))
-;; (while (< 0 times)
-;; (unless (or (= point (buffer-end dir))
-;; (get-text-property point (iprolog-goal-end-prop dir)))
-;; (next-single-property-change point )
-;; (while (not (or (buffer-end dir)
-;; (get-text-property (point) 'iprolog-end-of-goal)
-;; (get-text-property (point) 'iprolog-beginning-of-goal)))
-;; (forward-char dir)))
-;; (if-let ((g (get-text-property (point) (iprolog-goal-end-prop (* -1 dir)))))
-;; (while (not (or (buffer-end dir)
-;; (equal g (get-text-property (point) (iprolog-goal-end-prop dir)))))
-;; (forward-char dir))
-;; (backward-char dir)
-;; (signal 'scan-error
-;; (list "No next term"
-;; (save-mark-and-excursion
-;; (let ((k (get-text-property (point) (iprolog-goal-end-prop dir))))
-;; (while (not (or (buffer-end (* -1 dir))
-;; (equal k (get-text-property (point) (iprolog-goal-end-prop (* -1 dir))))))
-;; (backward-char dir)))
-;; (point))
-;; (point))))
-;; (setq times (1- times)))))
-
-;; (defun iprolog-goal-end-prop (dir)
-;; (if (< 0 dir)
-;; 'iprolog-end-of-goal
-;; 'iprolog-beginning-of-goal))
-
-;; (defun iprolog-forward-term (&optional arg _interactive)
-;; "Backend for `forward-sexp', which see for the meaning of ARG."
-;; (font-lock-ensure)
-;; (iprolog-font-lock-ensure-function)
-;; (let ((times (or arg 1)))
-;; (if (< times 0)
-;; (iprolog-backward-term (- times))
-;; (while (< 0 times)
-;; (unless (or (eobp)
-;; (get-text-property (point) 'iprolog-beginning-of-goal))
-;; (forward-char)
-;; (while (not (or (eobp)
-;; (get-text-property (point) 'iprolog-end-of-goal)
-;; (get-text-property (point) 'iprolog-beginning-of-goal)))
-;; (forward-char)))
-;; (if-let ((g (get-text-property (point) 'iprolog-beginning-of-goal)))
-;; (while (not (or (eobp)
-;; (equal g (get-text-property (point) 'iprolog-end-of-goal))))
-;; (forward-char))
-;; (backward-char)
-;; (signal 'scan-error
-;; (list "No next term"
-;; (save-mark-and-excursion
-;; (let ((k (get-text-property (point) 'iprolog-end-of-goal)))
-;; (while (not (or (bobp)
-;; (equal k (get-text-property (point) 'iprolog-beginning-of-goal))))
-;; (backward-char)))
-;; (point))
-;; (point))))
-;; (setq times (1- times))))))
-
-;; (defun iprolog-backward-term (times)
-;; (while (< 0 times)
-;; (unless (or (bobp)
-;; (get-text-property (point) 'iprolog-end-of-goal))
-;; (backward-char)
-;; (while (not (or (bobp)
-;; (get-text-property (point) 'iprolog-end-of-goal)
-;; (get-text-property (point) 'iprolog-beginning-of-goal)))
-;; (backward-char)))
-;; (if-let ((g (get-text-property (point) 'iprolog-end-of-goal)))
-;; (while (not (or (bobp)
-;; (equal g (get-text-property (point) 'iprolog-beginning-of-goal))))
-;; (backward-char))
-;; (signal 'scan-error
-;; (list "No previous term"
-;; (point)
-;; (save-mark-and-excursion
-;; (let ((k (get-text-property (point) 'iprolog-beginning-of-goal)))
-;; (while (not (or (eobp)
-;; (equal k (get-text-property (point) 'iprolog-end-of-goal))))
-;; (forward-char)))
-;; (point)))))
-;; (setq times (1- times))))
-
-(defun iprolog-forward-term-new (&optional arg)
- "Backend for \\[forward-sexp], which see for the meaning of ARG."
- (font-lock-ensure)
- (iprolog-font-lock-ensure-function)
- (let ((times (or arg 1)))
- (if (< times 0)
- (iprolog-backward-term-new (- times))
- (let ((point (point)))
- (dotimes (_ times) (setq point (iprolog-forward-term1 point)))
- (when point
- (goto-char point))))))
-
-(defun iprolog-forward-term1 (point)
- (if-let ((other-end (and (not (= point (point-max)))
- (iprolog-beginning-of-thing point))))
- other-end
- (let ((p (min (1+ point) (point-max))))
- (while (not (or (= p (point-max))
- (get-text-property p 'iprolog-term-end)))
- (setq p (1+ p)))
- (if-let ((end (and (not (= p (point-max)))
- (iprolog-beginning-of-thing p))))
- end
- (max point (1- p))))))
-
-(defun iprolog-backward-term-new (&optional arg)
- "Backend for \\[forward-sexp], which see for the meaning of ARG."
- (let ((times (or arg 1)))
- (let ((point (point)))
- (dotimes (_ times) (setq point (iprolog-backward-term1 point)))
- (when point
- (goto-char point)))))
-
-(defun iprolog-backward-term1 (point)
- (if-let ((other-end (and (not (= point (point-min)))
- (iprolog-end-of-thing point))))
- other-end
- (let ((p (max (1- point) (point-min))))
- (while (not (or (= p (point-min))
- (get-text-property p 'iprolog-term-end)))
- (setq p (1- p)))
- (if-let ((beg (and (not (= p (point-min)))
- (iprolog-end-of-thing p))))
- beg
- (min point p)))))
-
-(defun iprolog-beginning-of-defun-function (&optional arg)
- "Backend for `beginning-of-defun', which see for the meaning of ARG."
- (font-lock-ensure)
- (iprolog-font-lock-ensure-function)
- (let ((times (or arg 1)))
- (if (< times 0)
- (iprolog-beginning-of-next-defun (- times))
- (let ((point (point)))
- (dotimes (_ times) (setq point (iprolog-beginning-of-defun1 point)))
- (when point
- (goto-char point))))))
-
-(defun iprolog-end-of-defun-function (&optional pom)
- "Backend for `end-of-defun'."
- (if-let ((point (or pom (point)))
- (other-end (and (not (= point (point-min)))
- (iprolog-beginning-of-defun-p point))))
- (goto-char other-end)
- (let ((p (min (1+ point) (point-max))))
- (while (not (or (= p (point-max))
- (iprolog-end-of-defun-p p)))
- (setq p (1+ p)))
- (when (iprolog-end-of-defun-p p)
- (goto-char p)))))
-
-(defun iprolog-beginning-of-next-defun (times)
- (let ((point (point)))
- (dotimes (_ times) (setq point (iprolog-beginning-of-next-defun1 point)))
- (when point
- (goto-char point))))
-
-(defun iprolog-beginning-of-defun1 (point)
- (if-let ((other-end (and (not (= point (point-min)))
- (iprolog-end-of-defun-p point))))
- other-end
- (let ((p (max (1- point) (point-min))))
- (while (not (or (= p (point-min))
- (iprolog-beginning-of-defun-p p)))
- (setq p (1- p)))
- (and (iprolog-beginning-of-defun-p p) p))))
-
-(defun iprolog-beginning-of-next-defun1 (point)
- (let ((p (+ point (or (and (iprolog-beginning-of-defun-p point) 1) 0))))
- (while (not (or (= p (point-max))
- (iprolog-beginning-of-defun-p p)))
- (setq p (1+ p)))
- (and (iprolog-beginning-of-defun-p p) p)))
-
-(defun iprolog-beginning-of-thing (point)
- (cddar (seq-filter (lambda (e) (pcase e (`(beg ,_ . ,_) t))) (get-text-property point 'iprolog-term-end))))
-
-(defun iprolog-end-of-thing (point)
- (cddar (seq-filter (lambda (e) (pcase e (`(end ,_ . ,_) t))) (get-text-property point 'iprolog-term-end))))
-
-(defun iprolog-end-of-defun-p (point)
- (cddar (seq-filter (lambda (e) (pcase e (`(end top . ,_) t))) (get-text-property point 'iprolog-term-end))))
-
-(defun iprolog-beginning-of-defun-p (point)
- (cddar (seq-filter (lambda (e) (pcase e (`(beg top . ,_) t))) (get-text-property point 'iprolog-term-end))))
-
-
-;; (defun iprolog-text-property--find-beg-backward (property value)
-;; (iprolog-text-property--find-end-backward property value)
-;; (goto-char (or (previous-single-property-change (point) property)
-;; (point-min))))
-
-;; (defun iprolog-text-property--find-end-backward (property value)
-;; (let ((go t))
-;; (while (and go (not (bobp)))
-;; (backward-char)
-;; (setq go (not (equal value
-;; (get-text-property (point) property)))))))
-
-
-;; (defun iprolog-text-property--find-beg-forward (property value)
-;; (let ((go t))
-;; (while (and go (not (eobp)))
-;; (forward-char)
-;; (setq go (not (equal value
-;; (get-text-property (point) property)))))))
-
-;; (defun iprolog-text-property--find-end-forward (property value)
-;; (iprolog-text-property--find-beg-forward property value)
-;; (goto-char (or (next-single-property-change (point) property)
-;; (point-max))))
-
-
-;; (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-load-buffer ()
- "Save this buffer and load it into the current Prolog session."
- (interactive nil iprolog-mode)
- (iprolog--request (concat "load('" (buffer-file-name) "')")))
-
-(eldoc-add-command 'complete-symbol 'corfu-complete 'completion-at-point)
-;; (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-load-buffer)
-
-(defvar iprolog-mode-syntax-table
- (let ((table (make-syntax-table)))
- (modify-syntax-entry ?_ "_" table)
- (modify-syntax-entry ?+ "." table)
- (modify-syntax-entry ?- "." table)
- (modify-syntax-entry ?= "." table)
- (modify-syntax-entry ?< "." table)
- (modify-syntax-entry ?> "." table)
- (modify-syntax-entry ?| "." table)
- (modify-syntax-entry ?\' "\"" table)
- (modify-syntax-entry ?% "<" table)
- (modify-syntax-entry ?\n ">" table)
- (modify-syntax-entry ?* ". 23b" table)
- (modify-syntax-entry ?/ ". 14" table)
- table))
-
-;;;###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)
- ;; (when iprolog-wants-flymake
- ;; (add-hook 'flymake-diagnostic-functions #'iprolog--checker nil t))
- (when iprolog-wants-eldoc
- (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 #'iprolog-after-change-function nil t)
- ;; (add-hook 'post-self-insert-hook #'iprolog-post-self-insert-function nil t)
- ;; (add-hook 'xref-backend-functions ...)
- ;; (setq-local compile-command ...)
- ;; (setq-local electric-indent-chars ...)
- ;; (setq-local align-rules-alist ...)
- ;; (setq-local imenu-create-index-function ...)
- ;; (setq-local indent-line-function ...)
- ;; (setq-local indent-region-function ...)
- (setq-local fill-paragraph-function #'iprolog-fill-paragraph-function)
- ;; (setq-local fill-forward-paragraph-function ...)
- ;; (setq jit-lock-chunk-size 8192)
- (setq-local forward-sexp-function #'iprolog-forward-term-new)
- (setq-local beginning-of-defun-function #'iprolog-beginning-of-defun-function)
- (setq-local end-of-defun-function #'iprolog-end-of-defun-function)
-;; (run-with-idle-timer 0.3 t #'font-lock-fontify-buffer)
- (setq-local font-lock-defaults
- '(nil
- t
- nil
- nil
- (font-lock-support-mode)
- (font-lock-fontify-region-function . iprolog-fontify-region)
- (font-lock-extra-managed-props iprolog-beginning-of-term
- iprolog-beginning-of-goal
- iprolog-beginning-of-head
- button
- follow-link
- category
- button-data
- mouse-face
- keymap
- action
- help-echo
- iprolog-term-end
- iprolog-end-of-head
- iprolog-end-of-goal
- iprolog-end-of-term))))
-
-;;;; project.el integration
-
-;;;###autoload
-(defun project-try-iprolog (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-iprolog parent)))))))
-
-(defun iprolog--execute-to-string (goal)
- "Call the Prolog 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")))
-
-(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)))
- (project-root proj)))
-
-(defun iprolog-project--name ()
- "Return the name of the current Prolog project."
- (let ((default-directory (or (iprolog-project--root)
- default-directory)))
- (if (file-exists-p (expand-file-name "pack.pl" default-directory))
- (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 (or (iprolog-project--root)
- default-directory)))
- (if (file-exists-p (expand-file-name "pack.pl" default-directory))
- (iprolog--execute-to-string "consult(pack), version(N), write(N)")
- "")))
-
-
-;;;; autotyping
-
-;; (defconst iprolog--atom-regexp (rx (seq line-start (or lower "'") (* anychar)))
-;; "Regular expression recognizing atoms.")
-
-;; (defun iprolog-read-term ()
-;; (let ((token (iprolog-read-token)))
-;; token))
-
-;; (defun iprolog-read-token ()
-;; (let ((string (read-string "?- ")))
-;; (cond
-;; ((string-match iprolog--atom-regexp string nil t)
-;; (list 'atom string)))))
-
-;; (defun iprolog-post-self-insert-function ()
-;; (when (and (not (memq last-command-event '(?\s ?\n)))
-;; (not (get-text-property (point) 'iprolog-beginning-of-term))
-;; (not (eq 'iprolog-syntax-error-face (get-text-property (1- (point)) 'font-lock-face)))
-;; (not (eq 'iprolog-fullstop-face (get-text-property (1- (point)) 'font-lock-face)))
-;; (< (save-mark-and-excursion
-;; (iprolog-text-property--find-end-backward 'iprolog-beginning-of-term t)
-;; (point))
-;; (save-mark-and-excursion
-;; (iprolog-text-property--find-end-backward 'font-lock-face 'iprolog-fullstop-face)
-;; (point))))
-;; (insert ". ")
-;; (backward-char 2))
-;; (remove-text-properties (1- (point)) (point) '(font-lock-face iprolog-beginning-of-term)))
-
-;;;; top-level
-
-(defvar iprolog--top-level-buffers-alist nil
- "Global mapping between directories and Prolog top-level buffers.")
-
-(defvar-local iprolog--helper-connection nil)
-
-(defvar iprolog--buffer-server-process nil)
-
-(defvar-local iprolog--server-process nil)
-
-(defvar-local iprolog--pending-requests (make-ring 128))
-
-(defvar-local iprolog--pending-data nil)
-
-(defvar-local iprolog--last-request-id 0)
-
-(defvar-local iprolog--sync-output nil)
-
-(defvar iprolog--last-helper-port 11111)
-
-(defvar iprolog--last-server-port 22222)
-
-(defvar iprolog--last-buffer-server-port 33333)
-
-(defvar-local iprolog--last-paren-id 0)
-
-(defun iprolog--ensure-buffer-server ()
- (unless (process-live-p iprolog--buffer-server-process)
- (setq iprolog--buffer-server-process
- (make-network-process
- :name "iprolog-buffer-server"
- :local `[127 0 0 1 ,(setq iprolog--last-buffer-server-port (1+ iprolog--last-buffer-server-port))]
- :coding 'utf-8
- :server 5
- :buffer "iprolog-buffer-server-log"
- :log
- (lambda (server client message)
- (with-current-buffer (process-buffer server)
- (goto-char (point-max))
- (insert (format "%s %s %s" server client message))))
- :sentinel
- (lambda (_proc _state))
- :filter
- (lambda (proc output)
- (save-excursion
- (let* ((lines (string-lines output))
- (path (car lines) )
- (beg0 (string-to-number (cadr lines)))
- (end0 (string-to-number (caddr lines)))
- (buffer (or (find-buffer-visiting path) (find-file-noselect path t t ))))
- (with-current-buffer buffer
- (let ((beg (or (and (< 0 beg0) beg0) (point-min)))
- (end (or (and (< 0 end0) end0) (point-max))))
- (condition-case _
- (progn (process-send-region proc beg end)
- (process-send-eof proc))))))))))))
-
-(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 (buffer)
- (iprolog-top-level--start-in-buffer buffer
- (setq iprolog--last-helper-port
- (1+ iprolog--last-helper-port))
- (setq iprolog--last-server-port
- (1+ iprolog--last-server-port))))
-
-(defun iprolog-top-level--start-in-buffer (buffer port server-port)
- "Create a Prolog top-level process in BUFFER.
-Also start a Prolog server listening on UDP port PORT,
-SERVER-PORT."
- (iprolog--ensure-buffer-server)
- (make-comint-in-buffer
- "top-level" buffer iprolog-program nil "/Users/eshelyaron/checkouts/iprolog/prolog/iprolog.pl" "--" "-u" (number-to-string port) "-e" (number-to-string server-port) "-b" (number-to-string iprolog--last-buffer-server-port))
- (setq iprolog--server-process
- (make-network-process
- :name "iprolog_server"
- :local `[127 0 0 1 ,server-port]
- :coding 'utf-8
- :server 5
- :buffer (generate-new-buffer "*iprolog-server-log*")
- :log
- (lambda (server client message)
- (with-current-buffer (process-buffer server)
- (goto-char (point-max))
- (insert (format "%s %s %s" server client message))))
- :sentinel
- (lambda (proc state)
- (when (string= state "connection broken by remote peer\n")
- (with-silent-modifications
- (with-current-buffer (process-buffer proc)
- (save-mark-and-excursion
- (goto-char (point-min))
- (end-of-line)
- (let* ((id (string-to-number (buffer-substring (point-min) (point))))
- (cb (alist-get id (ring-elements (with-current-buffer buffer iprolog--pending-requests)))))
- (delete-line)
- (when cb
- (funcall cb))
- (unless (process-live-p proc)
- (kill-buffer))))))))))
- (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 &optional 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))
- (when cb
- (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
- (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--fontifying nil)
-
-(defun iprolog-top-level--fontify-query (&optional buf loudly)
- (let ((buffer (or buf (current-buffer))))
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (let ((beg (cdr comint-last-prompt))
- (end (point-max))
- (query (buffer-substring-no-properties (cdr comint-last-prompt) (point-max))))
-
- (setq iprolog-top-level--fontifying t)
- (iprolog--request
- (concat "colourise(query, " (prin1-to-string query) ")")
- (lambda ()
- (goto-char (point-min))
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (with-silent-modifications
- (font-lock-unfontify-region beg (min end (point-max)))
- (put-text-property (1- beg) (point-max) 'font-lock-face 'default)))
- (while (not (eobp))
- (let ((colors (iprolog--parse-fontification-line (buffer-substring-no-properties (point) (line-end-position)) beg)))
- (with-current-buffer buffer
- (with-silent-modifications
- (dolist (f colors)
- (let ((fs (car f))
- (fe (cadr f))
- (fp (caddr f))
- (fv (cadddr f)))
- (when fp
- (unless (> fe (point-max))
- (if (equal fp 'iprolog-term-end)
- (put-text-property fs fe fp (cons fv (get-text-property fs 'iprolog-term-end)))
- (put-text-property fs fe fp fv)))))))))
- (forward-line 1)))
- (with-current-buffer buffer
- (setq iprolog-top-level--fontifying nil)))))))))
-
-(defvar iprolog-top-level-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap self-insert-command] #'iprolog-top-level--self-insert-command)
- (define-key map [remap comint-send-input] #'iprolog-top-level--maybe-send-input)
- map))
-
-(defun iprolog-top-level--maybe-send-input (&optional no-newline artificial)
- "NO-NEWLINE, ARTIFICIAL."
- (interactive)
- (while iprolog-top-level--fontifying
- (accept-process-output))
- (call-interactively
- (if (and (save-mark-and-excursion
- (goto-char (point-max))
- (skip-chars-backward " \n\t\v" (cdr comint-last-prompt))
- (= ?. (preceding-char)))
- (not (save-mark-and-excursion
- (goto-char (cdr comint-last-prompt))
- (text-property-search-forward 'font-lock-face
- 'iprolog-syntax-error-face t))))
- #'comint-send-input
- #'newline)))
-
-
-(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 . 20))
- "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))))
-
-
-(defvar-local iprolog-top-level-timer nil "Buffer-local timer.")
-
-
-;;;###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))))
- (setq iprolog-top-level-timer (run-with-idle-timer 0.2 t #'iprolog-top-level--fontify-query (current-buffer)))
- (add-hook 'kill-buffer-hook
- (lambda ()
- (when (timerp iprolog-top-level-timer)
- (cancel-timer iprolog-top-level-timer))))
- (setq-local comment-start "%")
- (comint-read-input-ring t)
- ;; (add-hook 'comint-preoutput-filter-functions ...)
- ;; (setq-local 'bookmark-make-record-function ...)
- (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)
- (when iprolog-wants-eldoc
- (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 'eldoc-documentation-functions #'iprolog-predicate-modes-doc -10 t)
- )
-
-
-;;;; 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 ((diags nil)
- (end (save-mark-and-excursion
- (save-match-data
- (goto-char (or (plist-get args :changes-end) (point-min)))
- (end-of-defun 2)
- (point)))))
- (save-mark-and-excursion
- (save-match-data
- (goto-char (or (plist-get args :changes-start) (point-min)))
- (beginning-of-defun)
- (let ((beg (point)))
- (font-lock-ensure beg end)
- (while (< (point) end)
- (when-let ((diag (pcase (get-text-property (point) 'font-lock-face)
- ('iprolog-syntax-error-face
- (let ((wbeg (point)))
- (goto-char (or (next-single-property-change (point) 'font-lock-face) end))
- (flymake-make-diagnostic (current-buffer) wbeg (point) :error "Syntax error")))
- ('iprolog-instantiation-error-face
- (let ((wbeg (point)))
- (goto-char (or (next-single-property-change (point) 'font-lock-face) end))
- (flymake-make-diagnostic (current-buffer) wbeg (point) :warning "Instantiation error")))
- ('iprolog-singleton-face
- (let ((wbeg (point)))
- (goto-char (or (next-single-property-change (point) 'font-lock-face) end))
- (flymake-make-diagnostic (current-buffer) wbeg (point) :warning "Singleton variable"))))))
- (setq diags (cons diag diags)))
- (goto-char (or (next-single-property-change (point) 'font-lock-face) end)))
- (funcall report-fn diags :region (cons beg end))))))
- 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."
- (when-let ((pi (iprolog-pi-at-point)))
- (iprolog--request
- (concat "document('" (buffer-file-name) "', " pi ")")
- (lambda ()
- (funcall callback
- (buffer-substring-no-properties (point-min) (point-max))
- :thing pi
- :face font-lock-function-name-face)))))
-
-(defun iprolog-pi-at-point ()
- (cdadr (car (seq-filter (lambda (e) (pcase e (`(beg (goal . ,_) . ,_) t))) (get-text-property (or (and (iprolog-beginning-of-thing (point)) (point)) (iprolog-backward-term1 (point))) 'iprolog-term-end)))))
-;;;; completions
-
-
-
-(defvar-local iprolog--current-atoms nil)
-
-(defun iprolog--current-atoms-completion-table (atom)
- (let ((buffer (current-buffer))
- (goal (concat "atom_completion(" (prin1-to-string atom) ")")))
- (setq iprolog--current-atoms nil)
- (iprolog--request goal
- (lambda ()
- (let ((atoms (string-lines (buffer-substring-no-properties (point-min) (point-max)) t)))
- (with-current-buffer buffer
- (setq iprolog--current-atoms atoms)))))
- (while (not iprolog--current-atoms)
- (accept-process-output))
- iprolog--current-atoms))
-
-(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
- :exit-function
- (lambda (_ sts)
- (when (eq sts 'finished)
- (let ((opoint (point)))
- (save-match-data
- (with-silent-modifications
- (skip-chars-backward "1234567890")
- (when (= ?/ (preceding-char))
- (backward-char)
- (let ((arity (string-to-number (buffer-substring-no-properties (1+ (point)) opoint))))
- (delete-region (point) opoint)
- (when (< 0 arity)
- (insert "(")
- (dotimes (_ (1- arity))
- (insert "_, "))
- (insert "_)")
- (goto-char (1- opoint))))))))
- ;; (let ((this-command nil)
- ;; (last-command 'complete-symbol))
- ;; (eldoc-print-current-symbol-info))
- )))))))
-
-(provide 'iprolog)
-
-
-;;;; font lock
-
-(defgroup iprolog-faces nil
- "Faces used to highlight Prolog code."
- :group 'iprolog)
-
-(eval-when-compile
- (defmacro iprolog-defface (name def doc)
- "Define iprolog face FACE with doc DOC."
- (declare
- (indent defun)
- (doc-string 3))
- (let ((face (intern (concat "iprolog-" (symbol-name name) "-face"))))
- `(progn
- (defface ,face
- '((default :inherit ,def))
- ,(concat "Face used to highlight " (downcase doc))
- :group 'iprolog-faces)
- (defvar ,face ',face
- ,(concat "Name of the face used to highlight " (downcase doc)))))))
-
-(iprolog-defface functor font-lock-function-name-face
- "Functors.")
-
-(iprolog-defface arity font-lock-function-name-face
- "Arities.")
-
-(iprolog-defface predicate-indicator font-lock-function-name-face
- "Predicate indicators.")
-
-(iprolog-defface built-in font-lock-keyword-face
- "Built in predicate calls.")
-
-(iprolog-defface neck font-lock-preprocessor-face
- "Necks.")
-
-(iprolog-defface goal font-lock-function-name-face
- "Unspecified predicate goals.")
-
-(iprolog-defface string font-lock-string-face
- "Strings.")
-
-(iprolog-defface comment font-lock-comment-face
- "Comments.")
-
-(iprolog-defface head-local font-lock-builtin-face
- "Local predicate definitions.")
-
-(iprolog-defface head-meta font-lock-preprocessor-face
- "Meta predicate definitions.")
-
-(iprolog-defface head-multifile font-lock-type-face
- "Multifile predicate definitions.")
-
-(iprolog-defface head-extern font-lock-type-face
- "External predicate definitions.")
-
-(iprolog-defface head-unreferenced font-lock-warning-face
- "Unreferenced predicate definitions.")
-
-(iprolog-defface head-exported font-lock-builtin-face
- "Exported predicate definitions.")
-
-(iprolog-defface head-hook font-lock-type-face
- "Hook definitions.")
-
-(iprolog-defface head-iso font-lock-keyword-face
- "Hook definitions.")
-
-(iprolog-defface head-undefined font-lock-warning-face
- "Undefind head terms.")
-
-(iprolog-defface head-public font-lock-builtin-face
- "Public definitions.")
-
-(iprolog-defface meta-spec font-lock-preprocessor-face
- "Meta argument specifiers.")
-
-(iprolog-defface recursion font-lock-builtin-face
- "Recursive calls.")
-
-(iprolog-defface local font-lock-function-name-face
- "Local predicate calls.")
-
-(iprolog-defface autoload font-lock-function-name-face
- "Autoloaded predicate calls.")
-
-(iprolog-defface imported font-lock-function-name-face
- "Imported predicate calls.")
-
-(iprolog-defface extern font-lock-function-name-face
- "External predicate calls.")
-
-(iprolog-defface foreign font-lock-keyword-face
- "Foreign predicate calls.")
-
-(iprolog-defface meta font-lock-type-face
- "Meta predicate calls.")
-
-(iprolog-defface undefined font-lock-warning-face
- "Undefined predicate calls.")
-
-(iprolog-defface thread-local font-lock-constant-face
- "Thread local predicate calls.")
-
-(iprolog-defface global font-lock-keyword-face
- "Global predicate calls.")
-
-(iprolog-defface multifile font-lock-function-name-face
- "Multifile predicate calls.")
-
-(iprolog-defface dynamic font-lock-constant-face
- "Dynamic predicate calls.")
-
-(iprolog-defface undefined-import font-lock-warning-face
- "Undefined imports.")
-
-(iprolog-defface html-attribute font-lock-function-name-face
- "HTML attributes.")
-
-(iprolog-defface html-call font-lock-keyword-face
- "Multifile predicate calls.")
-
-(iprolog-defface option-name font-lock-constant-face
- "Option names.")
-
-(iprolog-defface no-option-name font-lock-warning-face
- "Non-existent option names.")
-
-(iprolog-defface flag-name font-lock-constant-face
- "Flag names.")
-
-(iprolog-defface no-flag-name font-lock-warning-face
- "Non-existent flag names.")
-
-(iprolog-defface qq-type font-lock-type-face
- "Quasi-quotation types.")
-
-(iprolog-defface qq-sep font-lock-type-face
- "Quasi-quotation separators.")
-
-(iprolog-defface qq-open font-lock-type-face
- "Quasi-quotation open sequences.")
-
-(iprolog-defface qq-close font-lock-type-face
- "Quasi-quotation close sequences.")
-
-(iprolog-defface op-type font-lock-type-face
- "Operator types.")
-
-(iprolog-defface dict-tag font-lock-constant-face
- "Dict tags.")
-
-(iprolog-defface dict-key font-lock-keyword-face
- "Dict keys.")
-
-(iprolog-defface dict-sep font-lock-keyword-face
- "Dict separators.")
-
-(iprolog-defface type-error font-lock-warning-face
- "Type errors.")
-
-(iprolog-defface instantiation-error font-lock-warning-face
- "Instantiation errors.")
-
-(iprolog-defface file button
- "File specifiers.")
-
-(iprolog-defface no-file font-lock-warning-face
- "Non-existent file specifiers.")
-
-(iprolog-defface file-no-depend font-lock-warning-face
- "Unused file specifiers.")
-
-(iprolog-defface unused-import font-lock-warning-face
- "Unused imports.")
-
-(iprolog-defface identifier font-lock-type-face
- "Identifiers.")
-
-(iprolog-defface hook font-lock-preprocessor-face
- "Hooks.")
-
-(iprolog-defface module font-lock-type-face
- "Module names.")
-
-(iprolog-defface singleton font-lock-warning-face
- "Singletons.")
-
-(iprolog-defface fullstop font-lock-negation-char-face
- "Fullstops.")
-
-(iprolog-defface nil font-lock-keyword-face
- "The empty list.")
-
-(iprolog-defface variable font-lock-variable-name-face
- "Variables.")
-
-(iprolog-defface ext-quant font-lock-keyword-face
- "Existential quantifiers.")
-
-(iprolog-defface control font-lock-keyword-face
- "Control constructs.")
-
-(iprolog-defface atom font-lock-constant-face
- "Atoms.")
-
-(iprolog-defface int font-lock-constant-face
- "Integers.")
-
-(iprolog-defface float font-lock-constant-face
- "Floats.")
-
-(iprolog-defface codes font-lock-constant-face
- "Codes.")
-
-(iprolog-defface error font-lock-warning-face
- "Unspecified errors.")
-
-(iprolog-defface syntax-error error
- "Syntax errors.")
-
-(iprolog-defface structured-comment font-lock-doc-face
- "Structured comments.")
-
-(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)))
- (cond
- ((string-match (rx (seq line-start (or "clause" "term" "directive" "grammar_rule"))) type nil t)
- `((,beg ,(1+ beg) iprolog-term-end (beg top . ,end))
- (,end ,(1+ end) iprolog-term-end (end top . ,beg))
- (,beg ,end font-lock-face default)))
- ((string= type "comment(structured)")
- `((,beg ,end font-lock-face ,iprolog-structured-comment-face)))
- ((string-match (rx (seq line-start "comment(" (or "line" "block" "string") ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-comment-face)))
- ((string= type "string")
- `((,beg ,end font-lock-face ,iprolog-string-face)))
- ((string= type "predicate_indicator")
- `((,beg ,end font-lock-face ,iprolog-predicate-indicator-face)))
- ((string= type "arity")
- `((,beg ,end font-lock-face ,iprolog-arity-face)))
- ((string= type "functor")
- `((,beg ,end font-lock-face ,iprolog-functor-face)))
- ((string-match (rx (seq line-start "file_no_depend(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-file-no-depend-face)))
- ((string-match (rx (seq line-start "nofile")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-no-file-face)))
- ((string-match (rx (seq line-start "file(" (+ anychar) ")")) type nil t)
- (let ((file-path (save-match-data
- (string-match (rx (seq line-start "file('" (group (+ anychar)) "')")) type)
- (match-string 1 type))))
- `((,beg ,end font-lock-face ,iprolog-file-face)
- (,beg ,end button ,t)
- (,beg ,end follow-link ,t)
- (,beg ,end category ,t)
- (,beg ,end button-data ,file-path)
- (,beg ,end mouse-face highlight)
- (,beg ,end keymap ,button-map)
- (,beg ,end action find-file)
- (,beg ,end help-echo ,(concat "Find " file-path)))))
- ((string-match (rx (seq line-start "head_term(" (+ anychar) ")")) type nil t)
- (let ((predicate (save-match-data
- (string-match (rx (seq line-start "head_term(" (+ anychar) "," (group (+ anychar)) ")")) type)
- (match-string 1 type))))
- `((,beg ,(1+ beg) iprolog-term-end (beg (head . ,predicate) . ,end))
- (,end ,(1+ end) iprolog-term-end (end (head . ,predicate) . ,beg)))))
- ((string-match (rx (seq line-start "head(undefined" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-undefined-face)))
- ((string-match (rx (seq line-start "head((public" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-public-face)))
- ((string-match (rx (seq line-start "head(iso" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-iso-face)))
- ((string-match (rx (seq line-start "head(hook" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-hook-face)))
- ((string-match (rx (seq line-start "head((multifile" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-multifile-face)))
- ((string-match (rx (seq line-start "head(exported" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-exported-face)))
- ((string-match (rx (seq line-start "head(local" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-local-face)))
- ((string-match (rx (seq line-start "head(meta" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-meta-face)))
- ((string-match (rx (seq line-start "head(extern" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-extern-face)))
- ((string-match (rx (seq line-start "head(unreferenced" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-head-unreferenced-face)))
- ((string-match (rx (seq line-start "meta(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-meta-spec-face)))
- ((string= type "parentheses")
- `((,beg ,(1+ beg) iprolog-term-end (beg parentheses . ,end))
- (,end ,(1+ end) iprolog-term-end (end parentheses . ,beg))))
- ((string-match (rx (seq line-start "goal_term(" (+ anychar) ")")) type nil t)
- (let ((predicate (save-match-data
- (string-match (rx (seq line-start "goal_term(" (+ anychar) "," (group (+ anychar)) ")")) type)
- (match-string 1 type))))
- `((,beg ,(1+ beg) iprolog-term-end (beg (goal . ,predicate) . ,end))
- (,end ,(1+ end) iprolog-term-end (end (goal . ,predicate) . ,beg)))))
- ((string-match (rx (seq line-start "goal(recursion" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-recursion-face)))
- ((string-match (rx (seq line-start "goal(meta" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-meta-face)))
- ((string-match (rx (seq line-start "goal(foreign" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-foreign-face)))
- ((string-match (rx (seq line-start "goal(built_in" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-built-in-face)))
- ((string-match (rx (seq line-start "goal(local" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-local-face)))
- ((string-match (rx (seq line-start "goal(imported" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-imported-face)))
- ((string-match (rx (seq line-start "goal(autoload" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-autoload-face)))
- ((string-match (rx (seq line-start "goal(extern" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-extern-face)))
- ((string-match (rx (seq line-start "goal(undefined" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-undefined-face)))
- ((string-match (rx (seq line-start "goal(global" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-global-face)))
- ((string-match (rx (seq line-start "goal((thread_local" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-thread-local-face)))
- ((string-match (rx (seq line-start "goal((multifile" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-multifile-face)))
- ((string-match (rx (seq line-start "goal((dynamic" (+ anychar))) type nil t)
- `((,beg ,end font-lock-face ,iprolog-dynamic-face)))
- ((string= type "unused_import")
- `((,beg ,end font-lock-face ,iprolog-unused-import-face)))
- ((string= type "undefined_import")
- `((,beg ,end font-lock-face ,iprolog-undefined-import-face)))
- ((string= type "dict_tag")
- `((,beg ,end font-lock-face ,iprolog-dict-tag-face)))
- ((string= type "dict_key")
- `((,beg ,end font-lock-face ,iprolog-dict-key-face)))
- ((string= type "qq_type")
- `((,beg ,end font-lock-face ,iprolog-qq-type-face)))
- ((string= type "qq(open)")
- `((,beg ,end font-lock-face ,iprolog-qq-sep-face)))
- ((string= type "qq(close)")
- `((,beg ,end font-lock-face ,iprolog-qq-sep-face)))
- ((string= type "qq(sep)")
- `((,beg ,end font-lock-face ,iprolog-qq-sep-face)))
- ((string= type "instantiation_error")
- `((,beg ,end font-lock-face ,iprolog-instantiation-error-face)))
- ((string-match (rx (seq line-start "type_error(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-type-error-face)))
- ((string-match (rx (seq line-start "op_type(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-op-type-face)))
- ((string-match (rx (seq line-start "flag_name(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-flag-name-face)))
- ((string-match (rx (seq line-start "no_flag_name(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-no-flag-name-face)))
- ((string= type "option_name")
- `((,beg ,end font-lock-face ,iprolog-option-name-face)))
- ((string= type "no_option_name")
- `((,beg ,end font-lock-face ,iprolog-no-option-name-face)))
- ((string-match (rx (seq line-start "neck(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-neck-face)))
- ((string= type "var")
- `((,beg ,end font-lock-face ,iprolog-variable-face)))
- ((string= type "empty_list")
- `((,beg ,end font-lock-face ,iprolog-nil-face)))
- ((string= type "fullstop")
- `((,beg ,end font-lock-face ,iprolog-fullstop-face)))
- ((string= type "ext_quant")
- `((,beg ,end font-lock-face ,iprolog-ext-quant-face)))
- ((string= type "control")
- `((,beg ,end font-lock-face ,iprolog-control-face)))
- ((string= type "dict_sep")
- `((,beg ,end font-lock-face ,iprolog-dict-sep-face)))
- ((string-match (rx (seq line-start "html_attribute(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-html-attribute-face)))
- ((string= type "html_call")
- `((,beg ,end font-lock-face ,iprolog-html-call-face)))
- ((string= type "atom")
- `((,beg ,end font-lock-face ,iprolog-atom-face)))
- ((string= type "float")
- `((,beg ,end font-lock-face ,iprolog-float-face)))
- ((string= type "codes")
- `((,beg ,end font-lock-face ,iprolog-float-face)))
- ((string= type "int")
- `((,beg ,end font-lock-face ,iprolog-int-face)))
- ((string= type "error")
- `((,beg ,end font-lock-face ,iprolog-error-face)))
- ((string-match (rx (seq line-start "syntax_error(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-syntax-error-face)))
- ((string= type "singleton")
- `((,beg ,end font-lock-face ,iprolog-singleton-face)))
- ((string-match (rx (seq line-start "module(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-module-face)))
- ((string-match (rx (seq line-start "hook(" (+ anychar) ")")) type nil t)
- `((,beg ,end font-lock-face ,iprolog-hook-face)))
- ((string= type "identifier")
- `((,beg ,end font-lock-face ,iprolog-identifier-face)))
- ((string-match (rx (seq line-start (or "brace_term"
- "rule_condition"
- ;; "parentheses"
- "html("
- "body"
- "expanded"
- "exported_operator"
- "dict"
- "list"
- "qq"
- "predicate_indicator("
- "dcg"
- ;; "head_term("
- )))
- type nil t)
- nil)
- (t (message "Unrecognized color term %s at %s-%s" type beg end)
- nil)))))
-
-
-(defvar-local iprolog-fontifying nil)
-(defvar-local iprolog-fontified nil)
-
-(defun iprolog-fontify-region (beg0 end0 loudly)
- (when (or (not iprolog-fontified) (buffer-modified-p))
- (let ((buffer (current-buffer))
- (default-directory (or (iprolog-project--root)
- default-directory))
- (beg (point-min))
- (end (point-max))
- ;; (beg (save-mark-and-excursion
- ;; (goto-char beg0)
- ;; (beginning-of-defun)
- ;; (point)))
- ;; (end (save-mark-and-excursion
- ;; (goto-char end0)
- ;; (end-of-defun)
- ;; (end-of-defun)
- ;; (point)))
- )
- (iprolog--ensure-top-level)
- (setq iprolog-fontifying t)
- (iprolog--request
- (concat "colourise('" (buffer-file-name buffer) "', " (number-to-string beg) ", " (number-to-string end) ")")
- (lambda ()
- (goto-char (point-min))
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (with-silent-modifications
- (font-lock-unfontify-region beg (min end (point-max)))))
- (while (not (eobp))
- (let ((colors (iprolog--parse-fontification-line (buffer-substring-no-properties (point) (line-end-position)) beg)))
- (with-current-buffer buffer
- (with-silent-modifications
- (dolist (f colors)
- (let ((fs (car f))
- (fe (cadr f))
- (fp (caddr f))
- (fv (cadddr f)))
- (when fp
- (unless (> fe (point-max))
- (if (equal fp 'iprolog-term-end)
- (put-text-property fs fe fp (cons fv (get-text-property fs 'iprolog-term-end)))
- (put-text-property fs fe fp fv)))))))))
- (forward-line 1))
- (with-current-buffer buffer
- (with-silent-modifications
- (save-mark-and-excursion
- (font-lock-fontify-keywords-region beg (min end (point-max)) loudly)))))
- (with-current-buffer buffer
- (setq iprolog-fontifying nil))))))
- (setq iprolog-fontified t))
-
-(defun iprolog-font-lock-ensure-function ()
- (while iprolog-fontifying
- (accept-process-output)))
-
-;;; fill-paragraph
-
-(defun iprolog-fill-paragraph-function (&optional _justify)
- (font-lock-ensure)
- (iprolog-font-lock-ensure-function)
- (let* ((buffer (current-buffer))
- (start (iprolog-beginning-of-defun1 (point)))
- (end (min (iprolog-end-of-defun-function start) (point-max)))
- (term (buffer-substring-no-properties start end)))
- (iprolog--request (concat "portray('" (buffer-file-name) "'," (prin1-to-string term) ")")
- (lambda ()
- (goto-char (point-max))
- (backward-delete-char 1)
- (let ((output-buffer (current-buffer)))
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (save-mark-and-excursion
- (save-restriction
- (combine-after-change-calls
- (narrow-to-region start (min (1+ end) (point-max)))
- (replace-buffer-contents output-buffer))))))))))
- t)
-
-
-;;; sync changes
-
-(defun iprolog-after-change-function (beg end pre)
- "Used for `after-change-functions', which see about BEG, END and PRE."
- (let ((default-directory (or (iprolog-project--root)
- default-directory)))
- (iprolog--ensure-top-level)
- (iprolog--request (format "change('%s', %s, %s, %s)" (buffer-file-name) beg end pre))))
-
-;;; iprolog.el ends here
projects / dotfiles.git / commitdiff