Commit 1e3b3fa6 authored by Leo Liu's avatar Leo Liu

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.
parent 219893a5
......@@ -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
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment