branch: elpa/idris-mode
commit cf69a2c921ba577fa1975264802cef2fe7574e2c
Author: Marek L <nospam.ke...@gmail.com>
Commit: Marek L <nospam.ke...@gmail.com>
Simplify and improve semantic source highlighting code by:
- Correctly using `save-excursion` before `save-restriction` macro
- Remove unecesary `buffer` param from `idris-highlight-input-region`
- Use `pcase-dolist` instead of `cl-loop & pcase`
---
idris-highlight-input.el | 105 ++++++++++++++++++++++-------------------------
idris-repl.el | 3 +-
test/idris-test-utils.el | 16 --------
test/idris-tests.el | 63 +++++++++++++++++-----------
4 files changed, 88 insertions(+), 99 deletions(-)
diff --git a/idris-highlight-input.el b/idris-highlight-input.el
index 1f43723443..70d9472f7e 100644
--- a/idris-highlight-input.el
+++ b/idris-highlight-input.el
@@ -53,68 +53,61 @@ See Info node `(elisp)Overlay Properties' to understand how
ARGS are used."
(when (= (length args) 5)
(delete-overlay (car args))))
-(defun idris-highlight-input-region (buffer start-line start-col end-line
end-col highlight)
+(defun idris-highlight-input-region (start-line start-col end-line end-col
highlight)
"Highlight in BUFFER using an overlay from START-LINE and START-COL to
END-LINE and END-COL and the semantic properties specified in HIGHLIGHT."
- (with-current-buffer buffer
+ (save-excursion
(save-restriction
(widen)
- (save-excursion
- (goto-char (point-min))
- (let* ((start-pos (+ (line-beginning-position start-line)
- (idris-highlight-column start-col)))
- (end-pos (+ (line-beginning-position end-line)
- (idris-highlight-column end-col)))
- (existing-idris-overlays-in-range (seq-filter
- (lambda (overlay)
- (overlay-get overlay
'idris-source-highlight))
- (overlays-in start-pos
end-pos)))
- (existing-idris-overlay (seq-find (lambda (overlay)
- (and
- (eql start-pos
(overlay-start overlay))
- (eql end-pos (overlay-end
overlay))
- ;; TODO: overlay
properties match
- ))
-
existing-idris-overlays-in-range)))
- (when (null existing-idris-overlay)
- (dolist (old-overlay existing-idris-overlays-in-range)
- (delete-overlay old-overlay))
- (let ((highlight-overlay (make-overlay start-pos end-pos)))
- (overlay-put highlight-overlay 'idris-source-highlight t)
- (idris-add-overlay-properties highlight-overlay
- (idris-semantic-properties
highlight))
- (overlay-put highlight-overlay
- 'modification-hooks
-
'(idris-highlight--overlay-modification-hook)))))))))
+ (goto-char (point-min))
+ (let* ((start-pos (+ (line-beginning-position start-line)
+ (idris-highlight-column start-col)))
+ (end-pos (+ (line-beginning-position end-line)
+ (idris-highlight-column end-col)))
+ (existing-idris-overlays-in-range (seq-filter
+ (lambda (overlay)
+ (overlay-get overlay
'idris-source-highlight))
+ (overlays-in start-pos
end-pos)))
+ (existing-idris-overlay (seq-find (lambda (overlay)
+ (and
+ (eql start-pos
(overlay-start overlay))
+ (eql end-pos (overlay-end
overlay))
+ ;; TODO: overlay properties
match
+ ))
+
existing-idris-overlays-in-range)))
+ (when (null existing-idris-overlay)
+ (mapc #'delete-overlay existing-idris-overlays-in-range)
+ (let ((highlight-overlay (make-overlay start-pos end-pos)))
+ (overlay-put highlight-overlay 'idris-source-highlight t)
+ (idris-add-overlay-properties highlight-overlay
(idris-semantic-properties highlight))
+ (overlay-put highlight-overlay 'modification-hooks
'(idris-highlight--overlay-modification-hook))))))))
(defun idris-highlight-source-file (hs)
- (cl-loop
- for h in hs
- do (pcase h
- (`(((:filename ,fn)
- (:start ,start-line-raw ,start-col-raw)
- (:end ,end-line-raw ,end-col-raw))
- ,props)
- (when (string= (file-name-nondirectory fn)
- (file-name-nondirectory (buffer-file-name)))
- (let ((start-line (if (>=-protocol-version 2 1)
- (1+ start-line-raw)
- start-line-raw))
- (start-col (if (>=-protocol-version 2 1)
- (1+ start-col-raw)
- start-col-raw))
- (end-line (if (>=-protocol-version 2 1)
- (1+ end-line-raw)
- end-line-raw))
- (end-col (if (>= idris-protocol-version 1)
- (1+ end-col-raw)
- end-col-raw)))
- (idris-highlight-input-region (current-buffer)
- start-line start-col
- end-line end-col
- props)))))))
-
-(defun idris-highlight-input-region-debug (_buffer start-line start-col
end-line end-col highlight)
+ (pcase-dolist
+ (`(((:filename ,fn)
+ (:start ,start-line-raw ,start-col-raw)
+ (:end ,end-line-raw ,end-col-raw))
+ ,props)
+ hs)
+ (when (string= (file-name-nondirectory fn)
+ (file-name-nondirectory (buffer-file-name)))
+ (let ((start-line (if (>=-protocol-version 2 1)
+ (1+ start-line-raw)
+ start-line-raw))
+ (start-col (if (>=-protocol-version 2 1)
+ (1+ start-col-raw)
+ start-col-raw))
+ (end-line (if (>=-protocol-version 2 1)
+ (1+ end-line-raw)
+ end-line-raw))
+ (end-col (if (>= idris-protocol-version 1)
+ (1+ end-col-raw)
+ end-col-raw)))
+ (idris-highlight-input-region start-line start-col
+ end-line end-col
+ props)))))
+
+(defun idris-highlight-input-region-debug (start-line start-col end-line
end-col highlight)
(when (not (or (> end-line start-line)
(and (= end-line start-line)
(> end-col start-col))))
diff --git a/idris-repl.el b/idris-repl.el
index a5511c5e34..c2d5b6ba5d 100644
--- a/idris-repl.el
+++ b/idris-repl.el
@@ -344,8 +344,7 @@ and semantic annotations PROPS."
(start-col-repl (+ input-col start-col))
(end-line-repl (+ input-line end-line -1))
(end-col-repl (+ input-col end-col)))
- (idris-highlight-input-region buffer
- start-line-repl start-col-repl
+ (idris-highlight-input-region start-line-repl start-col-repl
end-line-repl end-col-repl
props))))))
diff --git a/test/idris-test-utils.el b/test/idris-test-utils.el
index ebf411bb70..4c3d8fc19b 100644
--- a/test/idris-test-utils.el
+++ b/test/idris-test-utils.el
@@ -133,21 +133,5 @@ BODY is code to be executed within the temp buffer. Point
is
,@body)
(sit-for 0.1)))
-;; Based on
https://www.gnu.org/software/emacs/manual/html_node/ert/Fixtures-and-Test-Suites.html
-(defun with-idris-file-fixture (relative-filepath body)
- (save-window-excursion
- (let* ((buffer (find-file relative-filepath))
- (buffer-content (buffer-substring-no-properties (point-min)
(point-max))))
- (unwind-protect
- (progn (goto-char (point-min))
- (funcall body))
-
- ;; Cleanup (Tear down)
- (idris-delete-ibc t)
- (erase-buffer)
- (insert buffer-content)
- (save-buffer)
- (kill-buffer)))))
-
(provide 'idris-test-utils)
;;; idris-test-utils.el ends here
diff --git a/test/idris-tests.el b/test/idris-tests.el
index 154b3239fc..e14944e046 100644
--- a/test/idris-tests.el
+++ b/test/idris-tests.el
@@ -139,31 +139,44 @@
(overlays-in (point-min) (point-max))))
(ert-deftest idris-semantic-highlighthing ()
- (let ((idris-semantic-source-highlighting nil))
- (with-idris-file-fixture
- "test-data/AddClause.idr"
- (lambda ()
- (idris-load-file)
- (dotimes (_ 5) (accept-process-output nil 0.1))
- (should (not (idris-buffer-contains-semantic-highlighting-p))))))
- (let ((idris-semantic-source-highlighting t))
- (with-idris-file-fixture
- "test-data/AddClause.idr"
- (lambda ()
- (idris-load-file)
- (dotimes (_ 5) (accept-process-output nil 0.1))
- (should (idris-buffer-contains-semantic-highlighting-p)))))
- (let ((idris-semantic-source-highlighting t)
- (idris-semantic-source-highlighting-max-buffer-size 8))
- (with-idris-file-fixture
- "test-data/AddClause.idr"
- (lambda ()
- (idris-load-file)
- (dotimes (_ 5) (accept-process-output nil 0.1))
- (should (not (idris-buffer-contains-semantic-highlighting-p)))
- (with-current-buffer "*Messages*"
- (should (string-match-p "Semantic source highlighting is disabled for
the current buffer."
- (buffer-substring-no-properties (point-min)
(point-max))))))))
+ (let* ((buffer (find-file "test-data/AddClause.idr"))
+ (buffer-content (buffer-substring-no-properties (point-min)
(point-max))))
+ (idris-run)
+ (dotimes (_ 5) (accept-process-output nil 0.1))
+ (unwind-protect
+ (progn
+ (goto-char (point-max))
+ (let ((idris-semantic-source-highlighting nil))
+ (insert " ") ;; to make the buffer dirty
+ (idris-load-file)
+ (dotimes (_ 10) (accept-process-output nil 0.1))
+ (should (not (idris-buffer-contains-semantic-highlighting-p))))
+
+ (let ((idris-semantic-source-highlighting t))
+ (insert " ") ;; to make the buffer dirty
+ (idris-load-file)
+ (dotimes (_ 30) (accept-process-output nil 0.1))
+ (should (idris-buffer-contains-semantic-highlighting-p))
+ ;;cleanup
+ (mapc 'delete-overlay (overlays-in (point-min) (point-max))))
+
+ (let ((idris-semantic-source-highlighting t)
+ (idris-semantic-source-highlighting-max-buffer-size 8))
+ (insert " ") ;; to make the buffer dirty
+ (idris-load-file)
+ (dotimes (_ 10) (accept-process-output nil 0.1))
+ (should (not (idris-buffer-contains-semantic-highlighting-p)))
+ (with-current-buffer "*Messages*"
+ (should (string-match-p "Semantic source highlighting is
disabled for the current buffer."
+ (buffer-substring-no-properties
(point-min) (point-max)))))))
+
+ ;; Cleanup (Tear down)
+ (dotimes (_ 5) (accept-process-output nil 0.1))
+ (idris-delete-ibc t)
+ (erase-buffer)
+ (insert buffer-content)
+ (save-buffer)
+ (kill-buffer)))
(idris-quit))
(load "idris-commands-test")
