[nongnu] elpa/idris-mode cf69a2c921 02/10: Simplify and improve semantic source highlighting code by:

[ELPA Syncer]

branch: elpa/idris-mode
commit cf69a2c921ba577fa1975264802cef2fe7574e2c
Author: Marek L <nospam.keram@gmail.com>
Commit: Marek L <nospam.keram@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")