Fix regression in widget-move (bug#72995)

* lisp/wid-edit.el (widget-move): Avoid advancing point only if it
is at the start of a widget at BOB.

* test/lisp/wid-edit-tests.el (widget-test-widget-move-bug72995): New test.
This commit is contained in:
Stephen Berman 2024-09-14 12:42:49 +02:00
parent ef0276de82
commit d509a35699
2 changed files with 21 additions and 1 deletions

View file

@ -1336,7 +1336,10 @@ nothing is shown in the echo area."
(let ((new (widget-tabable-at))) (let ((new (widget-tabable-at)))
(while (and (eq (widget-tabable-at) new) (not (bobp))) (while (and (eq (widget-tabable-at) new) (not (bobp)))
(backward-char))) (backward-char)))
(unless (bobp) (forward-char))) ;; If the widget is at BOB, point is already at the widget's
;; starting position; otherwise, advance point to put it at the
;; start of the widget (cf. bug#69943 and bug#72995).
(unless (and (widget-tabable-at) (bobp)) (forward-char)))
(unless suppress-echo (unless suppress-echo
(widget-echo-help (point))) (widget-echo-help (point)))
(run-hooks 'widget-move-hook)) (run-hooks 'widget-move-hook))

View file

@ -344,6 +344,23 @@ return nil, even with a non-nil bubblep argument."
(should (string= "Third" (widget-value (widget-at)))) (should (string= "Third" (widget-value (widget-at))))
(widget-forward 1))) ; Should not signal beginning-of-buffer error. (widget-forward 1))) ; Should not signal beginning-of-buffer error.
(ert-deftest widget-test-widget-move-bug72995 ()
"Test moving to a widget that starts at buffer position 2."
(with-temp-buffer
;; The first tabable widget begins at position 2 (bug#72995).
(widget-insert " ")
(dolist (el '("First" "Second" "Third"))
(widget-create 'push-button el))
(widget-insert "\n")
(use-local-map widget-keymap)
(widget-setup)
;; Make sure there is no tabable widget at BOB.
(goto-char (point-min))
(should-not (widget-tabable-at))
;; Check that we can move to the first widget after BOB.
(widget-forward 1)
(should (widget-tabable-at))))
(ert-deftest widget-test-color-match () (ert-deftest widget-test-color-match ()
"Test that the :match function for the color widget works." "Test that the :match function for the color widget works."
(let ((widget (widget-convert 'color))) (let ((widget (widget-convert 'color)))