[nongnu] elpa/tuareg 2e87104 1/6: Update `tuareg-interactive-error-range-regexp`

[ELPA Syncer]

branch: elpa/tuareg
commit 2e871044c898e06b067f8834c8524efc361cb65e
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    Update `tuareg-interactive-error-range-regexp`
    
    Translate to `rx` notation and extend it to accept error messages
    emitted by current OCaml compilers, with both line and char ranges.
    
    This probably fixes #248.
---
 tuareg.el | 116 +++++++++++++++++++++++++++++++++++++++-----------------------
 1 file changed, 74 insertions(+), 42 deletions(-)

diff --git a/tuareg.el b/tuareg.el
index a7217f0..52c9896 100644
--- a/tuareg.el
+++ b/tuareg.el
@@ -3437,8 +3437,44 @@ OCaml uses exclusive end-columns but Emacs wants them to 
be inclusive."
 (defconst tuareg-interactive-buffer-name "*OCaml*")
 
 (defconst tuareg-interactive-error-range-regexp
-  "[ \t]*Characters \\([0-9]+\\)-\\([1-9][0-9]*\\):\n"
-  "Regexp matching the char numbers in OCaml REPL's error messages.")
+  (rx (* (in "\t "))
+      (? "Line" (? "s") " "
+         (group-n 1 (+ (in "0-9")))     ; starting line
+         (? "-"
+            (group-n 2 (+ (in "0-9")))) ; ending line
+         ", ")
+      (in "Cc") "haracters "
+      (group-n 3 (+ (in "0-9")))        ; starting character
+      "-"
+      (group-n 4 (+ (in "0-9")))        ; ending character
+      ":\n")
+  "Regexp matching the line and char numbers in OCaml REPL's error messages.")
+
+(defun tuareg--interactive-error-range (base-pos text-buffer)
+  "Decode range in `tuareg-interactive-error-range-regexp' match.
+BASE-POS is the start, in TEXT-BUFFER, of the text to
+which the matched error refers. Return (BEG-POS . END-POS)."
+  (let* ((match-num (lambda (group)
+                      (and (match-beginning group)
+                           (string-to-number (match-string group)))))
+         (beg-line (funcall match-num 1))
+         (end-line (funcall match-num 2))
+         (beg-char (funcall match-num 3))
+         (end-char (funcall match-num 4)))
+    (with-current-buffer text-buffer
+      (save-excursion
+        (goto-char base-pos)
+        (when (and beg-line (> beg-line 1))
+          (forward-line (1- beg-line)))
+        (forward-char beg-char)
+        (let ((beg-pos (point)))
+          (if end-line
+              (progn
+                (forward-line (- end-line beg-line))
+                (forward-char end-char))
+            (forward-char (- end-char beg-char)))
+          (let ((end-pos (point)))
+            (cons beg-pos end-pos)))))))
 
 (defconst tuareg-interactive-error-regexp
   "\n\\(Error: [^#]*\\)")
@@ -3474,12 +3510,12 @@ OCaml uses exclusive end-columns but Emacs wants them 
to be inclusive."
             (goto-char comint-last-input-end)
             (cond
              ((looking-at tuareg-interactive-error-range-regexp)
-              (let ((beg (string-to-number (match-string-no-properties 1)))
-                    (end (string-to-number (match-string-no-properties 2))))
+              (let* ((range (tuareg--interactive-error-range
+                             comint-last-input-start (current-buffer)))
+                     (beg (car range))
+                     (end (cdr range)))
                 (put-text-property
-                 (+ comint-last-input-start beg)
-                 (+ comint-last-input-start end)
-                 'font-lock-face 'tuareg-font-lock-error-face))
+                 beg end 'font-lock-face 'tuareg-font-lock-error-face))
               (goto-char comint-last-input-end)
               (when (re-search-forward tuareg-interactive-error-regexp nil t)
                 (let ((errbeg (match-beginning 1))
@@ -3691,46 +3727,42 @@ It is assumed that the range START-END delimit valid 
OCaml phrases."
 
 (defun tuareg-interactive-next-error-source ()
   (interactive)
-  (let ((error-pos) (beg 0) (end 0))
-    (with-current-buffer tuareg-interactive-buffer-name
-      (goto-char tuareg-interactive-last-phrase-pos-in-repl)
-      (setq error-pos
-            (re-search-forward tuareg-interactive-error-range-regexp
-                               (point-max) t))
-      (when error-pos
-        (setq beg (string-to-number (match-string-no-properties 1))
-              end (string-to-number (match-string-no-properties 2)))))
-    (if (not error-pos)
+  (let* ((source-buffer (current-buffer))
+         (range
+          (with-current-buffer tuareg-interactive-buffer-name
+            (goto-char tuareg-interactive-last-phrase-pos-in-repl)
+            (and (re-search-forward tuareg-interactive-error-range-regexp nil 
t)
+                 (tuareg--interactive-error-range
+                  tuareg-interactive-last-phrase-pos-in-source
+                  source-buffer)))))
+    (if (not range)
         (message "No syntax or typing error in last phrase.")
-      (setq beg (+ tuareg-interactive-last-phrase-pos-in-source beg)
-            end (+ tuareg-interactive-last-phrase-pos-in-source end))
-      (goto-char beg)
-      (move-overlay tuareg-interactive-next-error-olv beg end)
-      (unwind-protect
-          (sit-for 60 t)
-        (delete-overlay tuareg-interactive-next-error-olv))
-      )))
+      (let ((beg (car range))
+            (end (cdr range)))
+        (goto-char beg)
+        (move-overlay tuareg-interactive-next-error-olv beg end)
+        (unwind-protect
+            (sit-for 60 t)
+          (delete-overlay tuareg-interactive-next-error-olv))))))
 
 (defun tuareg-interactive-next-error-repl ()
   (interactive)
-  (let ((error-pos) (beg 0) (end 0))
-    (save-excursion
-      (goto-char tuareg-interactive-last-phrase-pos-in-repl)
-      (setq error-pos
-            (re-search-forward tuareg-interactive-error-range-regexp
-                               (point-max) t))
-      (when error-pos
-        (setq beg (string-to-number (match-string-no-properties 1))
-              end (string-to-number (match-string-no-properties 2)))))
-    (if (not error-pos)
+  (let ((range
+         (save-excursion
+           (goto-char tuareg-interactive-last-phrase-pos-in-repl)
+           (and (re-search-forward tuareg-interactive-error-range-regexp nil t)
+                (tuareg--interactive-error-range
+                 tuareg-interactive-last-phrase-pos-in-repl
+                 (current-buffer))))))
+    (if (not range)
         (message "No syntax or typing error in last phrase.")
-      (setq beg (+ tuareg-interactive-last-phrase-pos-in-repl beg)
-            end (+ tuareg-interactive-last-phrase-pos-in-repl end))
-      (move-overlay tuareg-interactive-next-error-olv beg end)
-      (unwind-protect
-          (sit-for 60 t)
-        (delete-overlay tuareg-interactive-next-error-olv))
-      (goto-char beg))))
+      (let ((beg (car range))
+            (end (cdr range)))
+        (move-overlay tuareg-interactive-next-error-olv beg end)
+        (unwind-protect
+            (sit-for 60 t)
+          (delete-overlay tuareg-interactive-next-error-olv))
+        (goto-char beg)))))
 
 (defun tuareg-interrupt-ocaml ()
   (interactive)