[nongnu] elpa/idris-mode b7c50dd60f 3/3: Merge pull request #600 from keram/warning-overlay-jump

[ELPA Syncer]

branch: elpa/idris-mode
commit b7c50dd60facd2a20279653d0186402649ade33b
Merge: a47903d2e1 24ce417b69
Author: Jan de Muijnck-Hughes <jfdm@users.noreply.github.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #600 from keram/warning-overlay-jump
    
    Preserve point position after adding warning overlay
---
 idris-tests.el    | 30 ++++++++++++++++++++++++++++++
 idris-warnings.el | 45 +++++++++++++++++++--------------------------
 2 files changed, 49 insertions(+), 26 deletions(-)

diff --git a/idris-tests.el b/idris-tests.el
index 47798b24cb..2d79f4162c 100644
--- a/idris-tests.el
+++ b/idris-tests.el
@@ -289,6 +289,36 @@ myReverse xs = revAcc [] xs where
       (kill-buffer))
     (idris-quit)))
 
+(ert-deftest idris-test-warning-overlay ()
+  "Test that `idris-warning-overaly-point' works as expected."
+  (let* ((buffer (find-file-noselect "test-data/AddClause.idr"))
+         (warning '("AddClause.idr" (5 7) (5 17) "Some warning message" ()))
+         (idris-raw-warnings '())
+         (idris-process-current-working-directory (file-name-directory 
(buffer-file-name buffer)))
+         (expected-position)
+         (expected-overlay))
+    (with-current-buffer buffer
+      (goto-char (point-min))
+      (re-search-forward "data Test")
+      (setq expected-position (point))
+
+      (idris-warning-overlay warning)
+
+      ;; Assert that the point position does not change
+      ;; https://github.com/idris-community/idris2-mode/issues/36
+      (should (eq (point) expected-position))
+
+      ;; Assert side effect
+      (should (not (null idris-raw-warnings)))
+
+      ;; Assert that overlay was added
+      (setq expected-overlay (car (overlays-in (point-min) (point-max))))
+      (should (not (null expected-overlay)))
+      (should (string= (overlay-get expected-overlay 'help-echo)
+                       "Some warning message"))
+      ;; Cleanup
+      (kill-buffer))))
+       
 (ert-deftest idris-backard-toplevel-navigation-test-2pTac9 ()
   "Test idris-backard-toplevel navigation command."
   (idris-test-with-temp-buffer
diff --git a/idris-warnings.el b/idris-warnings.el
index 1d98971e92..d5d709d52c 100644
--- a/idris-warnings.el
+++ b/idris-warnings.el
@@ -60,18 +60,12 @@
   (setq idris-warnings '())
   (delq (current-buffer) idris-warnings-buffers))
 
-(defun idris-get-line-region (line)
-  (goto-char (point-min))
-  (cl-values
-   (line-beginning-position line)
-   (line-end-position line)))
-
 (defun idris-warning-overlay-p (overlay)
   (overlay-get overlay 'idris-warning))
 
-(defun idris-warning-overlay-at-point ()
-  "Return the overlay for a note starting at point, otherwise nil."
-  (cl-find (point) (cl-remove-if-not 'idris-warning-overlay-p (overlays-at 
(point)))
+(defun idris-warning-overlay-at-point (point)
+  "Return the overlay for a note starting at POINT, otherwise nil."
+  (cl-find point (cl-remove-if-not 'idris-warning-overlay-p (overlays-at 
point))
         :key 'overlay-start))
 
 (defun idris-warning-overlay (warning)
@@ -100,23 +94,22 @@ is mostly the same as (startline startcolumn)"
              (buffer (get-file-buffer fullpath)))
         (when (not (null buffer))
           (with-current-buffer buffer
-            (save-restriction
-              (widen) ;; Show errors at the proper location in narrowed buffers
-              (goto-char (point-min))
-              (cl-multiple-value-bind (startp endp) (idris-get-line-region 
startline)
-                (goto-char startp)
-                (let ((start (+ startp startcol))
-                      (end (if (and (= startline endline) (= startcol endcol))
-                               ;; this is a hack to have warnings reported 
which point to empty lines
-                               (if (= startp endp)
-                                   (progn (insert " ")
-                                          (1+ endp))
-                                 endp)
-                             (+ (save-excursion
-                                  (goto-char (point-min))
-                                  (line-beginning-position endline))
-                                endcol)))
-                      (overlay (idris-warning-overlay-at-point)))
+            (save-excursion
+              (save-restriction
+                (widen) ;; Show errors at the proper location in narrowed 
buffers
+                (goto-char (point-min))
+                (let* ((startp (line-beginning-position startline))
+                       (endp (line-end-position startline))
+                       (start (+ startp startcol))
+                       (end (if (and (= startline endline) (= startcol endcol))
+                                ;; a hack to have warnings, which point to 
empty lines, reported
+                                (if (= startp endp)
+                                    (progn (goto-char startp)
+                                           (insert " ")
+                                           (1+ endp))
+                                  endp)
+                              (+ (line-beginning-position endline) endcol)))
+                       (overlay (idris-warning-overlay-at-point startp)))
                   (if overlay
                       (idris-warning-merge-overlays overlay message)
                     (idris-warning-create-overlay start end message)))))))))))