;; This file is NOT part of GNU Emacs.
;;; Package-Version: 0.1.0
-;;; Package-Requires: ((emacs "29"))
+;;; Package-Requires: ((emacs "28"))
;;; Commentary:
(defcustom iprolog-program "swipl"
"The Prolog executable."
:package-version '((iprolog . "0.1.0"))
- ;; :link '(custom-manual "(iprolog)Top")
: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)
+ :group 'iprolog-project)
-(defcustom iprolog-wants-flymake t
- "Non-nil means `iprolog-mode' should integrate with `flymake-mode'."
+(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-wants-eldoc t
- "Non-nil means `iprolog-mode' should integrate with `eldoc'."
+(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)
(let ((times (or arg 1)))
(if (< times 0)
(iprolog-beginning-of-next-defun (- times))
- (while (< 0 times)
- (goto-char (or (previous-single-property-change (point) 'iprolog-beginning-of-term) (point-min)))
- (unless (bobp) (backward-char))
- (setq times (1- times)))))
- (bobp))
-
+ (let ((point (point)))
+ (dotimes (_ times) (setq point (iprolog-beginning-of-defun1 point)))
+ (when point
+ (goto-char point))))))
-(defun iprolog-end-of-defun-function ()
+(defun iprolog-end-of-defun-function (&optional pom)
"Backend for `end-of-defun'."
- (goto-char (or (next-single-property-change (point) 'iprolog-end-of-term) (point-max)))
- (unless (eobp)
- (forward-char 1)))
+ (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)
- (while (< 0 times)
- (when (get-text-property (point) 'iprolog-beginning-of-term)
- (forward-char))
- (goto-char (or (next-single-property-change (point) 'iprolog-beginning-of-term) (point-max)))
- (setq times (1- times)))
- (eobp))
-
-(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))))
+ (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)
(save-mark-and-excursion
(save-match-data
(unless (bobp) (backward-char))
- (while (looking-at "[[:alnum:]_]" t)
+ (while (looking-at "[[:alnum:]:_]" t)
(backward-char))
(forward-char)
(when (looking-at "[[:lower:]]" t)
(let ((start (point)))
- (while (looking-at "[[:alnum:]_]" t)
+ (while (looking-at "[[:alnum:]:_]" t)
(forward-char))
(cons start (point))))))))
-(defun iprolog-save-and-load-buffer ()
+(defun iprolog-load-buffer ()
"Save this buffer and load it into the current Prolog session."
(interactive nil iprolog-mode)
- (save-buffer)
- (iprolog--request (concat "ensure_loaded(\""
- (buffer-file-name)
- "\")")))
+ (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)
;; "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)
+ "C-c C-l" #'iprolog-load-buffer)
(defvar iprolog-mode-syntax-table
(let ((table (make-syntax-table)))
(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)
+ (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 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-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
(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
keymap
action
help-echo
+ iprolog-term-end
+ iprolog-end-of-head
+ iprolog-end-of-goal
iprolog-end-of-term))))
;;;; project.el integration
;;;; 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)))
+;; (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--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
:local `[127 0 0 1 ,(setq iprolog--last-buffer-server-port (1+ iprolog--last-buffer-server-port))]
:coding 'utf-8
:server 5
- :buffer "foobar"
+ :buffer "iprolog-buffer-server-log"
:log
(lambda (server client message)
(with-current-buffer (process-buffer server)
(let* ((lines (string-lines output))
(path (car lines) )
(beg0 (string-to-number (cadr lines)))
- (end0 (string-to-number (caddr lines))))
- (with-current-buffer (find-file-noselect path)
+ (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 _
(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 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)
(defcustom iprolog-top-level-display-buffer-action
'((display-buffer-reuse-window display-buffer-below-selected)
- (window-height . 16))
+ (window-height . 20))
"The action used to display the top-level buffer."
:type '(cons (choice (function :tag "Display Function")
(repeat :tag "Display Functions" function))
(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."
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)
- (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))
+ (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
"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
- (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)))))))
-
+ (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 ((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))))
+ (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)
(list start
end
(completion-table-with-cache #'iprolog--current-atoms-completion-table)
- :exclusive 'no)))))
+ :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)
(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 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.")
(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-beginning-of-term t)
- (,end ,(1+ end) iprolog-end-of-term t)
- (,beg ,end font-lock-face default)))
+ `((,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 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-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-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-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-identifier-face)))
((string-match (rx (seq line-start (or "brace_term"
"rule_condition"
- "parentheses"
+ ;; "parentheses"
"html("
"body"
"expanded"
"exported_operator"
"dict"
- "goal_term("
"list"
+ "qq"
"predicate_indicator("
"dcg"
- "head_term("
+ ;; "head_term("
)))
type nil t)
nil)
(defvar-local iprolog-fontifying nil)
+(defvar-local iprolog-fontified nil)
(defun iprolog-fontify-region (beg0 end0 loudly)
- (when (buffer-modified-p)
+ (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)))
+ (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
(lambda ()
(goto-char (point-min))
(when (buffer-live-p buffer)
- (let ((colors nil))
- (while (not (eobp))
- (setq colors (append colors (iprolog--parse-fontification-line (buffer-substring-no-properties (point) (line-end-position)) 1)))
- (forward-line 1))
- (with-current-buffer buffer
- (save-mark-and-excursion
+ (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
- (font-lock-unfontify-region beg (min end (point-max)))
(dolist (f colors)
(let ((fs (car f))
(fe (cadr f))
(fv (cadddr f)))
(when fp
(unless (> fe (point-max))
- (put-text-property fs fe fp fv)))))
- (font-lock-fontify-keywords-region beg (min end (point-max)) loudly))))))
+ (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))))))
- t)
+ (setq iprolog-fontified t))
(defun iprolog-font-lock-ensure-function ()
(while iprolog-fontifying
;;; fill-paragraph
-(defun iprolog--portray-term (s)
- (iprolog--request-goal-sync (concat "term_string(T," (prin1-to-string s) ",[variable_names(VN)]),"
- "portray_clause(current_output, T, [variable_names(VN)])")))
+(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)
-(defun iprolog-portray-and-insert-term (s)
- (interactive "sTerm: " iprolog-mode)
- (insert (iprolog--portray-term s)))
-(defun iprolog-fill-paragraph-function (&optional _justify)
- (let* ((start (save-mark-and-excursion
- (beginning-of-defun)
- (point)))
- (end (save-mark-and-excursion
- (end-of-defun)
- (point)))
- (term (buffer-substring-no-properties start end))
- (port (iprolog--portray-term term)))
- (when port
- (goto-char start)
- (delete-region start end)
- (insert port))))
-
-
-;;; experiments
+;;; sync changes
(defun iprolog-after-change-function (beg end pre)
"Used for `after-change-functions', which see about BEG, END and PRE."
projects / dotfiles.git / commitdiff