branch: externals/polymode
commit c12fa8fb1c3c49300d214203e6309161e1aacea4
Author: vitalie <vitalie.sp...@adyen.com>
Commit: Vitalie Spinu <spinu...@gmail.com>
Improve on naming of lsp subsystem functons
---
.dir-locals.el | 3 +-
polymode-compat.el | 93 +++++++++++++++++++++++++-------------------------
polymode-core.el | 90 ++++++++++++++++++++++++++----------------------
tests/compat-tests.el | 94 +++++++++++++++++++++++++--------------------------
4 files changed, 144 insertions(+), 136 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 017d039e0d..2fe4b85d8d 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -9,5 +9,4 @@
(checkdoc-force-docstrings-flag . nil)
(checkdoc-verb-check-experimental-flag . nil)
(bug-reference-bug-regexp . "#\\(\\([[:digit:]]+\\)\\)")
- (bug-reference-url-format . "https://github.com/polymode/polymode/issues/%s";)
- (eval . (add-hook 'before-save-hook 'delete-trailing-whitespace nil t))))
+ (bug-reference-url-format .
"https://github.com/polymode/polymode/issues/%s";)))
diff --git a/polymode-compat.el b/polymode-compat.el
index a05773c1e2..8bee89c73c 100644
--- a/polymode-compat.el
+++ b/polymode-compat.el
@@ -216,7 +216,7 @@ are passed to ORIG-FUN."
;; before-change:(obeg,oend)=(50,56)
;; lsp-on-change:(nbeg,nend,olen)=(50,60,6)
-(defun pm--lsp-text-document-content-change-event (beg end len)
+(defun pm--lsp-buffer-content-document-content-change-event (beg end len)
"Make a TextDocumentContentChangeEvent body for BEG to END, of length LEN."
(if (zerop len)
;; insertion
@@ -248,45 +248,45 @@ are passed to ORIG-FUN."
:text text))
(defun pm--lsp-full-change-event ()
- (list :text (pm--lsp-text)))
-
-(defun pm--lsp-text (&optional beg end)
- (prog1
- (save-excursion
- (save-restriction
- (widen)
- (setq beg (or beg (point-min)))
- (setq end (or end (point-max)))
- (let ((cmode major-mode)
- (end-eol (save-excursion (goto-char end)
- (point-at-eol)))
- line-acc acc)
- (pm-map-over-modes
- (lambda (sbeg send)
- (let ((beg1 (max sbeg beg))
- (end1 (min send end))
- (rem))
- (if (eq cmode major-mode)
- (progn
- (when (eq sbeg beg1)
- ;; first line of mode; use line-acc
- (setq acc (append line-acc acc))
- (setq line-acc nil))
- ;; if cur-mode follows after end on same line,
accumulate the
- ;; last line but not the actual text
- (when (< beg1 end)
- (push (buffer-substring-no-properties beg1 end1)
acc)))
- (goto-char beg1)
- (if (<= end1 (point-at-eol))
- (when (< beg1 end1) ; don't accumulate on last line
- (push (make-string (- end1 beg1) ? ) line-acc))
- (while (< (point-at-eol) end1)
- (push "\n" acc)
- (forward-line 1))
- (setq line-acc (list (make-string (- end1 (point)) ?
)))))))
- beg end-eol)
- (apply #'concat (reverse acc)))))
- (pm--synchronize-points)))
+ (list :text (pm--lsp-buffer-content)))
+
+(defun pm--lsp-buffer-content (&optional beg end)
+ "Buffer content between BEG and END with text for non-current mode replaced
with whitespaces."
+ (pm-with-synchronized-points
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq beg (or beg (point-min)))
+ (setq end (or end (point-max)))
+ (let ((cmode major-mode)
+ (end-eol (save-excursion (goto-char end)
+ (point-at-eol)))
+ line-acc acc)
+ (pm-map-over-modes
+ (lambda (sbeg send)
+ (let ((beg1 (max sbeg beg))
+ (end1 (min send end))
+ (rem))
+ (if (eq cmode major-mode)
+ (progn
+ (when (eq sbeg beg1)
+ ;; first line of mode; use line-acc
+ (setq acc (append line-acc acc))
+ (setq line-acc nil))
+ ;; if cur-mode follows after end on same line, accumulate
the
+ ;; last line but not the actual text
+ (when (< beg1 end)
+ (push (buffer-substring-no-properties beg1 end1) acc)))
+ (goto-char beg1)
+ (if (<= end1 (point-at-eol))
+ (when (< beg1 end1) ; don't accumulate on last line
+ (push (make-string (- end1 beg1) ? ) line-acc))
+ (while (< (point-at-eol) end1)
+ (push "\n" acc)
+ (forward-line 1))
+ (setq line-acc (list (make-string (- end1 (point)) ? )))))))
+ beg end-eol)
+ (apply #'concat (reverse acc)))))))
;; We cannot compute original change location when modifications are complex
;; (aka multiple changes are combined). In those cases we send an entire
@@ -297,18 +297,20 @@ are passed to ORIG-FUN."
(and (eq beg (car bcr))
(eq len (- (cdr bcr) (car bcr))))))
-;; advises
(defun polymode-lsp-buffer-content (orig-fun)
+ "In polymode buffers, replace other modes' content with whitespaces.
+Use as around advice for lsp--buffer-content."
(if (and polymode-mode pm/polymode)
- (pm--lsp-text)
+ (pm--lsp-buffer-content)
(funcall orig-fun)))
(defun polymode-lsp-change-event (orig-fun beg end len)
(if (and polymode-mode pm/polymode)
- (pm--lsp-text-document-content-change-event beg end len)
+ (pm--lsp-buffer-content-document-content-change-event beg end len)
(funcall orig-fun beg end len)))
-(defvar-local polymode-lsp-integration t)
+(defvar-local polymode-lsp-integration t
+ "Non-nil if lsp polymode integration should be enabled for this buffer.")
(with-eval-after-load "lsp-mode"
(when polymode-lsp-integration
@@ -322,9 +324,6 @@ are passed to ORIG-FUN."
(pm-around-advice 'lsp--buffer-content #'polymode-lsp-buffer-content)
(pm-around-advice 'lsp--text-document-content-change-event
#'polymode-lsp-change-event)))
-;; (advice-remove 'lsp--buffer-content #'polymode-lsp-buffer-content)
-;; (advice-remove 'lsp--text-document-content-change-event
#'polymode-lsp-change-event)
-
;;; Flyspel
(defun pm--flyspel-dont-highlight-in-chunkmodes (beg end _poss)
diff --git a/polymode-core.el b/polymode-core.el
index 04935468d0..cdccec376f 100644
--- a/polymode-core.el
+++ b/polymode-core.el
@@ -1048,7 +1048,7 @@ switch."
((eq mode 'host) (pm-base-buffer))
(mode (or (pm-get-buffer-of-mode mode)
;; not throwing because in auto-modes mode
might not
- ;; be installed yet and there is no way
install it
+ ;; be installed yet and there is no way to
install it
;; from here
buffer))))))
;; no further action if BUFFER is already the current buffer
@@ -1060,6 +1060,8 @@ switch."
(pm-base-buffer) buffer)
(pm--move-vars polymode-move-these-vars-from-old-buffer
cbuf buffer)
+ ;; synchronize again just in case
+ (pm--synchronize-points cbuf)
(if visibly
;; Slow, visual selection. Don't perform in foreign indirect buffers.
(when own
@@ -1406,17 +1408,21 @@ Placed with high priority in `after-change-functions'
hook."
;; (remove-hook 'after-change-functions 'jit-lock-after-change t))
))))
-(defun pm--run-other-hooks (allow syms hook &rest args)
- (when (and allow polymode-mode pm/polymode)
- (dolist (sym syms)
+(defun pm--run-hooks-in-other-buffers (function-names hook-name &rest args)
+ "Run each function in FUNCTION-NAMES in other polymode buffers.
+But, only if it is part of the hook HOOK-NAME. Each function is called witih
arguments ARGS."
+ (when (and polymode-mode pm/polymode)
+ (let ((cbuf (current-buffer)))
(dolist (buf (eieio-oref pm/polymode '-buffers))
(when (buffer-live-p buf)
- (unless (eq buf (current-buffer))
+ (unless (eq buf cbuf)
(with-current-buffer buf
- (when (memq sym (symbol-value hook))
- (if args
- (apply sym args)
- (funcall sym))))))))))
+ (let ((hooks (symbol-value hook-name)))
+ (dolist (sym function-names)
+ (when (memq sym hooks)
+ (if args
+ (apply sym args)
+ (funcall sym))))))))))))
;; BUFFER SAVE
;; TOTHINK: add auto-save-hook?
@@ -1434,17 +1440,17 @@ declared in the base buffer is triggered.")
"Run after-save-hooks in indirect buffers.
Only those in `polymode-run-these-after-save-functions-in-other-buffers'
are triggered if present."
- (pm--run-other-hooks t
-
polymode-run-these-before-save-functions-in-other-buffers
- 'after-save-hook))
+ (pm--run-hooks-in-other-buffers
+ polymode-run-these-before-save-functions-in-other-buffers
+ 'after-save-hook))
(defun polymode-after-save ()
"Run after-save-hooks in indirect buffers.
Only those in `polymode-run-these-after-save-functions-in-other-buffers'
are triggered if present."
- (pm--run-other-hooks t
- polymode-run-these-after-save-functions-in-other-buffers
- 'after-save-hook))
+ (pm--run-hooks-in-other-buffers
+ polymode-run-these-after-save-functions-in-other-buffers
+ 'after-save-hook))
;; change hooks
@@ -1464,21 +1470,22 @@ Placed with low priority in `before-change-functions'
hook."
(with-current-buffer buf
(when lsp-mode
(setq pm--lsp-before-change-end-position (pm--lsp-position end))))))
- (pm--run-other-hooks pm-allow-before-change-hook
-
polymode-run-these-before-change-functions-in-other-buffers
- 'before-change-functions
- beg end))
+ (when pm-allow-before-change-hook
+ (pm--run-hooks-in-other-buffers
+ polymode-run-these-before-change-functions-in-other-buffers
+ 'before-change-functions
+ beg end)))
(defun polymode-after-change (beg end len)
"Polymode after-change fixes.
Run `polymode-run-these-after-change-functions-in-other-buffers'.
Placed with low priority in `after-change-functions' hook."
;; ensure points are synchronized (after-change runs BEFORE
post-command-hook)
- (pm--synchronize-points)
- (pm--run-other-hooks pm-allow-after-change-hook
-
polymode-run-these-after-change-functions-in-other-buffers
- 'after-change-functions
- beg end len))
+ (when pm-allow-after-change-hook
+ (pm--run-hooks-in-other-buffers
+ polymode-run-these-after-change-functions-in-other-buffers
+ 'after-change-functions
+ beg end len)))
(defvar polymode-run-these-pre-commands-in-other-buffers nil
"These commands, if present in `pre-command-hook', are run in other bufers.")
@@ -1490,13 +1497,13 @@ Placed with low priority in `after-change-functions'
hook."
Currently synchronize points and runs
`polymode-run-these-pre-commands-in-other-buffers' if any. Runs in
local `pre-command-hook' with very high priority."
- (pm--synchronize-points (current-buffer))
- (condition-case err
- (pm--run-other-hooks pm-allow-pre-command-hook
- polymode-run-these-pre-commands-in-other-buffers
- 'pre-command-hook)
- (error (message "error polymode-pre-command run other hooks: (%s) %s"
- (point) (error-message-string err)))))
+ (when pm-allow-pre-command-hook
+ (condition-case err
+ (pm--run-hooks-in-other-buffers
+ polymode-run-these-pre-commands-in-other-buffers
+ 'pre-command-hook)
+ (error (message "error polymode-pre-command run other hooks: (%s) %s"
+ (point) (error-message-string err))))))
(defun polymode-post-command ()
"Select the buffer relevant buffer and run post-commands in other buffers.
@@ -1516,9 +1523,10 @@ appropriate. This function is placed into local
(condition-case err
(if (eq cbuf (current-buffer))
;; 1. same buffer, run hooks in other buffers
- (pm--run-other-hooks pm-allow-post-command-hook
-
polymode-run-these-post-commands-in-other-buffers
- 'post-command-hook)
+ (when pm-allow-post-command-hook
+ (pm--run-hooks-in-other-buffers
+ polymode-run-these-post-commands-in-other-buffers
+ 'post-command-hook))
;; 2. Run all hooks in this (newly switched to) buffer
(run-hooks 'post-command-hook))
(error (message "error in polymode-post-command run other hooks: (%s)
%s"
@@ -2045,18 +2053,20 @@ Elements of LIST can be either strings or symbols."
(when (and polymode-mode
(buffer-live-p buffer))
(let* ((bufs (eieio-oref pm/polymode '-buffers))
- ;; (buffer (or buffer
- ;; (cl-loop for b in bufs
- ;; if (and (buffer-live-p b)
- ;; (buffer-local-value 'pm/current b))
- ;; return b)
- ;; (current-buffer)))
(pos (with-current-buffer buffer (point))))
(dolist (b bufs)
(when (buffer-live-p b)
(with-current-buffer b
(goto-char pos)))))))
+(defmacro pm-with-synchronized-points (&rest body)
+ "Run BODY and ensure the points in all polymode buffers are synchronized
before and after BODY."
+ (declare (indent 0) (debug (body)))
+ (pm--synchronize-points)
+ `(prog1
+ ,@body
+ (pm--synchronize-points)))
+
(defun pm--completing-read (prompt collection &optional predicate require-match
initial-input hist def inherit-input-method)
;; Wrapper for `completing-read'.
diff --git a/tests/compat-tests.el b/tests/compat-tests.el
index 1607efb0b9..e084e265ae 100644
--- a/tests/compat-tests.el
+++ b/tests/compat-tests.el
@@ -22,64 +22,64 @@
;; python
(goto-char 44)
(pm-switch-to-buffer)
- (should (equal (pm--lsp-text 108 108) ""))
- (should (equal (pm--lsp-text 29 29) ""))
- (should (equal (pm--lsp-text 128 128) ""))
- (should (equal (pm--lsp-text 150 150) ""))
- (should (equal (pm--lsp-text 151 151) ""))
- (should (equal (pm--lsp-text 152 152) ""))
-
- (should (equal (pm--lsp-text 142 143) " "))
- (should (equal (pm--lsp-text 142 145) " "))
-
- (should (equal (pm--lsp-text 44 50) "fruits"))
- (should (equal (pm--lsp-text 21 50)
+ (should (equal (pm--lsp-buffer-content 108 108) ""))
+ (should (equal (pm--lsp-buffer-content 29 29) ""))
+ (should (equal (pm--lsp-buffer-content 128 128) ""))
+ (should (equal (pm--lsp-buffer-content 150 150) ""))
+ (should (equal (pm--lsp-buffer-content 151 151) ""))
+ (should (equal (pm--lsp-buffer-content 152 152) ""))
+
+ (should (equal (pm--lsp-buffer-content 142 143) " "))
+ (should (equal (pm--lsp-buffer-content 142 145) " "))
+
+ (should (equal (pm--lsp-buffer-content 44 50) "fruits"))
+ (should (equal (pm--lsp-buffer-content 21 50)
(concat (make-string 3 ?\n) "# foo\nfruits")))
- (should (equal (pm--lsp-text 148 155)
+ (should (equal (pm--lsp-buffer-content 148 155)
"+ x"))
- (should (equal (pm--lsp-text 131 155)
+ (should (equal (pm--lsp-buffer-content 131 155)
(concat (make-string 12 ? ) " 3 + x")))
- (should (equal (pm--lsp-text 103 155)
+ (should (equal (pm--lsp-buffer-content 103 155)
(concat "print(x)\n\n\n\n"
(make-string 28 ? )
"3 + x")))
- (should (equal (pm--lsp-text 121 141)
+ (should (equal (pm--lsp-buffer-content 121 141)
(make-string 20 ? )))
- (should (equal (pm--lsp-text 121 131)
+ (should (equal (pm--lsp-buffer-content 121 131)
(make-string 10 ? )))
;; latex
(goto-char 130)
(pm-switch-to-buffer)
- (should (equal (pm--lsp-text 108 108) ""))
- (should (equal (pm--lsp-text 29 29) ""))
- (should (equal (pm--lsp-text 128 128) ""))
- (should (equal (pm--lsp-text 150 150) ""))
- (should (equal (pm--lsp-text 151 151) ""))
- (should (equal (pm--lsp-text 152 152) ""))
+ (should (equal (pm--lsp-buffer-content 108 108) ""))
+ (should (equal (pm--lsp-buffer-content 29 29) ""))
+ (should (equal (pm--lsp-buffer-content 128 128) ""))
+ (should (equal (pm--lsp-buffer-content 150 150) ""))
+ (should (equal (pm--lsp-buffer-content 151 151) ""))
+ (should (equal (pm--lsp-buffer-content 152 152) ""))
;; markdown
(goto-char 21)
(pm-switch-to-buffer)
- (should (equal (pm--lsp-text 108 108) ""))
- (should (equal (pm--lsp-text 29 29) ""))
- (should (equal (pm--lsp-text 128 128) ""))
- (should (equal (pm--lsp-text 150 150) ""))
- (should (equal (pm--lsp-text 151 151) ""))
- (should (equal (pm--lsp-text 152 152) ""))
-
- (should (equal (pm--lsp-text 142 143) " "))
- (should (equal (pm--lsp-text 142 145) " "))
- (should (equal (pm--lsp-text 151 152) " "))
-
- (should (equal (pm--lsp-text 117 121) "\nfoo"))
- (should (equal (pm--lsp-text 118 121) "foo"))
- (should (equal (pm--lsp-text 122 123) "$"))
- (should (equal (pm--lsp-text 135 145) " $ bar "))
-
- (should (equal (pm--lsp-text 21 50)
+ (should (equal (pm--lsp-buffer-content 108 108) ""))
+ (should (equal (pm--lsp-buffer-content 29 29) ""))
+ (should (equal (pm--lsp-buffer-content 128 128) ""))
+ (should (equal (pm--lsp-buffer-content 150 150) ""))
+ (should (equal (pm--lsp-buffer-content 151 151) ""))
+ (should (equal (pm--lsp-buffer-content 152 152) ""))
+
+ (should (equal (pm--lsp-buffer-content 142 143) " "))
+ (should (equal (pm--lsp-buffer-content 142 145) " "))
+ (should (equal (pm--lsp-buffer-content 151 152) " "))
+
+ (should (equal (pm--lsp-buffer-content 117 121) "\nfoo"))
+ (should (equal (pm--lsp-buffer-content 118 121) "foo"))
+ (should (equal (pm--lsp-buffer-content 122 123) "$"))
+ (should (equal (pm--lsp-buffer-content 135 145) " $ bar "))
+
+ (should (equal (pm--lsp-buffer-content 21 50)
"some text\n\n```py\n\n"))
(should (equal (point) 21))
@@ -88,21 +88,21 @@
"$ bar "
(make-string 8 ? )
" baz")))
- (should (equal (pm--lsp-text 100 156)
+ (should (equal (pm--lsp-buffer-content 100 156)
base))
- (should (equal (pm--lsp-text 100 160)
+ (should (equal (pm--lsp-buffer-content 100 160)
(concat base "\n```")))
- (should (equal (pm--lsp-text 100 163)
+ (should (equal (pm--lsp-buffer-content 100 163)
(concat base "\n```js\n")))
- (should (equal (pm--lsp-text 100 200)
+ (should (equal (pm--lsp-buffer-content 100 200)
(concat base "\n```js\n\n\n"))))
(let ((base " baz\n```js\n\n\n"))
- (should (equal (pm--lsp-text 145 203)
+ (should (equal (pm--lsp-buffer-content 145 203)
base))
- (should (equal (pm--lsp-text 136 203)
+ (should (equal (pm--lsp-buffer-content 136 203)
(concat "$ bar " base)))
- (should (equal (pm--lsp-text 128 203)
+ (should (equal (pm--lsp-buffer-content 128 203)
(concat " $ bar " base))))
(should (equal (point) 21))
