[Emacs-diffs] emacs-26 1e3b3fa 1/2: Fix (thing-at-point 'list) regression (Bug#31772)

[Leo Liu]

branch: emacs-26
commit 1e3b3fa6159db837fca2f2d564e51b01048a906f
Author: Leo Liu <address@hidden>
Commit: Leo Liu <address@hidden>

    Fix (thing-at-point 'list) regression (Bug#31772)
    
    * lisp/thingatpt.el (thing-at-point-bounds-of-list-at-point): Revert
      to pre 26.1 behavior.  Return whole sexp at point if no enclosing
      list.
      (list-at-point): New optional arg to ignore comments and strings.
    
    * test/lisp/thingatpt-tests.el
      (thing-at-point-bounds-of-list-at-point): Fix and augment tests.
---
 lisp/thingatpt.el            | 27 +++++++++--------
 test/lisp/thingatpt-tests.el | 72 +++++++++++++++++++++++---------------------
 2 files changed, 52 insertions(+), 47 deletions(-)

diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 6a978fe..79f0230 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -219,17 +219,15 @@ The bounds of THING are determined by 
`bounds-of-thing-at-point'."
 
 (defun thing-at-point-bounds-of-list-at-point ()
   "Return the bounds of the list at point.
+Prefer the enclosing list with fallback on sexp at point.
 \[Internal function used by `bounds-of-thing-at-point'.]"
   (save-excursion
-    (let* ((st (parse-partial-sexp (point-min) (point)))
-           (beg (or (and (eq 4 (car (syntax-after (point))))
-                         (not (nth 8 st))
-                         (point))
-                    (nth 1 st))))
-      (when beg
-        (goto-char beg)
-        (forward-sexp)
-        (cons beg (point))))))
+    (if (ignore-errors (up-list -1))
+       (ignore-errors (cons (point) (progn (forward-sexp) (point))))
+      (let ((bound (bounds-of-thing-at-point 'sexp)))
+       (and bound
+            (<= (car bound) (point)) (< (point) (cdr bound))
+            bound)))))
 
 ;; Defuns
 
@@ -608,8 +606,13 @@ Signal an error if the entire string was not used."
 
 (put 'number 'thing-at-point 'number-at-point)
 ;;;###autoload
-(defun list-at-point ()
-  "Return the Lisp list at point, or nil if none is found."
-  (form-at-point 'list 'listp))
+(defun list-at-point (&optional ignore-comment-or-string)
+  "Return the Lisp list at point, or nil if none is found.
+If IGNORE-COMMENT-OR-STRING is non-nil comments and strings are
+treated as white space."
+  (let ((ppss (and ignore-comment-or-string (syntax-ppss))))
+    (save-excursion
+      (goto-char (or (nth 8 ppss) (point)))
+      (form-at-point 'list 'listp))))
 
 ;;; thingatpt.el ends here
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index cfb57de..1d80519 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -84,41 +84,43 @@ position to retrieve THING.")
       (goto-char (nth 1 test))
       (should (equal (thing-at-point (nth 2 test)) (nth 3 test))))))
 
-;; These tests reflect the actual behavior of
-;; `thing-at-point-bounds-of-list-at-point'.
-(ert-deftest thing-at-point-bug24627 ()
-  "Test for https://debbugs.gnu.org/24627 ."
-  (let ((string-result '(("(a \"b\" c)" . (a "b" c))
-                         (";(a \"b\" c)")
-                         ("(a \"b\" c\n)" . (a "b" c))
-                         ("\"(a b c)\"")
-                         ("(a ;(b c d)\ne)" . (a e))
-                         ("(foo\n(a ;(b c d)\ne) bar)" . (a e))
-                         ("(foo\na ;(b c d)\ne bar)" . (foo a e bar))
-                         ("(foo\n(a \"(b c d)\"\ne) bar)" . (a "(b c d)" e))
-                         ("(b\n(a ;(foo c d)\ne) bar)" . (a e))
-                         ("(princ \"(a b c)\")" . (princ "(a b c)"))
-                         ("(defun foo ()\n  \"Test function.\"\n  ;;(a b)\n  
nil)" . (defun foo nil "Test function." nil))))
-        (file
-         (expand-file-name "lisp/thingatpt.el" source-directory))
-        buf)
-    ;; Test for `thing-at-point'.
-    (when (file-exists-p file)
-      (unwind-protect
-          (progn
-            (setq buf (find-file file))
-            (goto-char (point-max))
-            (forward-line -1)
-            (should-not (thing-at-point 'list)))
-        (kill-buffer buf)))
-    ;; Tests for `list-at-point'.
-    (dolist (str-res string-result)
-      (with-temp-buffer
-        (emacs-lisp-mode)
-        (insert (car str-res))
-        (re-search-backward "\\((a\\|^a\\)")
-        (should (equal (list-at-point)
-                       (cdr str-res)))))))
+;; See bug#24627 and bug#31772.
+(ert-deftest thing-at-point-bounds-of-list-at-point ()
+  (cl-macrolet ((with-test-buffer (str &rest body)
+                  `(with-temp-buffer
+                     (emacs-lisp-mode)
+                     (insert ,str)
+                     (search-backward "|")
+                     (delete-char 1)
+                     ,@body)))
+    (let ((tests1
+           '(("|(a \"b\" c)" (a "b" c))
+             (";|(a \"b\" c)" (a "b" c) nil)
+             ("|(a \"b\" c\n)" (a "b" c))
+             ("\"|(a b c)\"" (a b c) nil)
+             ("|(a ;(b c d)\ne)" (a e))
+             ("(foo\n|(a ;(b c d)\ne) bar)" (foo (a e) bar))
+             ("(foo\n|a ;(b c d)\ne bar)" (foo a e bar))
+             ("(foo\n|(a \"(b c d)\"\ne) bar)" (foo (a "(b c d)" e) bar))
+             ("(b\n|(a ;(foo c d)\ne) bar)" (b (a e) bar))
+             ("(princ \"|(a b c)\")" (a b c) (princ "(a b c)"))
+             ("(defun foo ()\n  \"Test function.\"\n  ;;|(a b)\n  nil)"
+              (defun foo nil "Test function." nil)
+              (defun foo nil "Test function." nil))))
+          (tests2
+           '(("|list-at-point" . "list-at-point")
+             ("list-|at-point" . "list-at-point")
+             ("list-at-point|" . nil)
+             ("|(a b c)" . "(a b c)")
+             ("(a b c)|" . nil))))
+      (dolist (test tests1)
+        (with-test-buffer (car test)
+          (should (equal (list-at-point) (cl-second test)))
+          (when (cddr test)
+            (should (equal (list-at-point t) (cl-third test))))))
+      (dolist (test tests2)
+        (with-test-buffer (car test)
+          (should (equal (thing-at-point 'list) (cdr test))))))))
 
 (ert-deftest thing-at-point-url-in-comment ()
   (with-temp-buffer