From c60d03b6a9dd1a6788381a66cae739a2ac3f9fba Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 17 Aug 2022 18:11:09 +0300 Subject: [PATCH] Checkpoint --- .emacs.d/esy.org | 29 +- .emacs.d/lisp/iprolog.el | 644 +++++++++++++++++++++++++++++---------- 2 files changed, 498 insertions(+), 175 deletions(-) diff --git a/.emacs.d/esy.org b/.emacs.d/esy.org index 2d81967..d48954e 100644 --- a/.emacs.d/esy.org +++ b/.emacs.d/esy.org @@ -1508,23 +1508,9 @@ include =emacs-lisp-mode= and =lisp-interaction-mode=. (add-to-list 'auto-mode-alist '("\\.pl\\'" . iprolog-mode)) (add-to-list 'auto-mode-alist '("\\.plt\\'" . iprolog-mode)) - (require 'lsp-mode) - - (setq lsp-semantic-tokens-enable t - lsp-log-io t) - - (lsp-register-client - (make-lsp-client - :new-connection - (lsp-stdio-connection (list "swipl" - "-g" "use_module(library(lsp_server))." - "-g" "lsp_server:main" - "-t" "halt" - "--" "stdio")) - :major-modes '(iprolog-mode) - :priority 1 - :multi-root t - :server-id 'prolog-ls)) + (with-eval-after-load 'recentf + (add-to-list 'recentf-exclude (rx (seq "/usr/local/lib/swipl/library/" (+ anychar) ".pl"))) + (setq recentf-max-saved-items 32)) #+end_src *** Make =rg= regard =.pl= files as Prolog rather than Perl @@ -1844,6 +1830,15 @@ terminates, e.g. when pressing =C-d=. (add-hook 'after-init-hook #'esy/setup-misc) #+end_src +** Add a repeat-map to =tranpose-lines= +#+begin_src emacs-lisp + (defvar-keymap transpose-lines-repeat-map + :doc "Repeat map for \\[transpose-lines]" + "C-t" #'transpose-lines) + + (put 'transpose-lines 'repeat-map 'transpose-lines-repeat-map) + +#+end_src ** Use =consult= to show =xref= results #+begin_src emacs-lisp (with-eval-after-load 'xref diff --git a/.emacs.d/lisp/iprolog.el b/.emacs.d/lisp/iprolog.el index 8976547..412f466 100644 --- a/.emacs.d/lisp/iprolog.el +++ b/.emacs.d/lisp/iprolog.el @@ -9,7 +9,7 @@ ;; This file is NOT part of GNU Emacs. ;;; Package-Version: 0.1.0 -;;; Package-Requires: ((emacs "29")) +;;; Package-Requires: ((emacs "28")) ;;; Commentary: @@ -26,29 +26,171 @@ (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) @@ -56,51 +198,84 @@ (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) @@ -134,23 +309,21 @@ (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) @@ -182,7 +355,7 @@ ;; "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))) @@ -209,10 +382,10 @@ (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 ...) @@ -222,11 +395,13 @@ ;; (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 @@ -235,6 +410,8 @@ (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 @@ -243,6 +420,9 @@ keymap action help-echo + iprolog-term-end + iprolog-end-of-head + iprolog-end-of-goal iprolog-end-of-term)))) ;;;; project.el integration @@ -299,33 +479,33 @@ value of `iprolog-project-definition-file-name'." ;;;; 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 @@ -352,6 +532,8 @@ value of `iprolog-project-definition-file-name'." (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 @@ -360,7 +542,7 @@ value of `iprolog-project-definition-file-name'." :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) @@ -374,8 +556,9 @@ value of `iprolog-project-definition-file-name'." (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 _ @@ -512,12 +695,68 @@ SERVER-PORT." (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) @@ -544,7 +783,7 @@ SERVER-PORT." (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)) @@ -564,6 +803,10 @@ SERVER-PORT." (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." @@ -581,15 +824,24 @@ SERVER-PORT." 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 @@ -661,30 +913,35 @@ as documented in `flymake-diagnostic-functions', ARGS" "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) @@ -696,7 +953,28 @@ explanation about the argument CALLBACK." (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) @@ -827,6 +1105,9 @@ explanation about the argument CALLBACK." (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.") @@ -836,6 +1117,15 @@ explanation about the argument CALLBACK." (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.") @@ -928,9 +1218,9 @@ explanation about the argument CALLBACK." (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) @@ -960,6 +1250,12 @@ explanation about the argument CALLBACK." (,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) @@ -982,6 +1278,15 @@ explanation about the argument CALLBACK." `((,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) @@ -1018,6 +1323,12 @@ explanation about the argument CALLBACK." `((,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) @@ -1030,6 +1341,8 @@ explanation about the argument CALLBACK." `((,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") @@ -1070,17 +1383,17 @@ explanation about the argument CALLBACK." `((,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) @@ -1089,14 +1402,25 @@ explanation about the argument CALLBACK." (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 @@ -1104,14 +1428,13 @@ explanation about the argument CALLBACK." (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)) @@ -1119,11 +1442,17 @@ explanation about the argument CALLBACK." (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 @@ -1131,30 +1460,29 @@ explanation about the argument CALLBACK." ;;; 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." -- 2.39.5