diff options
| -rw-r--r-- | lisp/button.el | 10 | ||||
| -rw-r--r-- | lisp/wid-edit.el | 5 | ||||
| -rw-r--r-- | test/lisp/button-tests.el | 40 | ||||
| -rw-r--r-- | test/lisp/wid-edit-tests.el | 39 |
4 files changed, 88 insertions, 6 deletions
diff --git a/lisp/button.el b/lisp/button.el index c46f3d9a52b..921e84dfa68 100644 --- a/lisp/button.el +++ b/lisp/button.el | |||
| @@ -382,10 +382,12 @@ Also see `make-text-button'." | |||
| 382 | If the button at POS is a text property button, the return value | 382 | If the button at POS is a text property button, the return value |
| 383 | is a marker pointing to POS." | 383 | is a marker pointing to POS." |
| 384 | (let ((button (get-char-property pos 'button))) | 384 | (let ((button (get-char-property pos 'button))) |
| 385 | (if (or (overlayp button) (null button)) | 385 | (and button (get-char-property pos 'category) |
| 386 | button | 386 | (if (overlayp button) |
| 387 | ;; Must be a text-property button; return a marker pointing to it. | 387 | button |
| 388 | (copy-marker pos t)))) | 388 | ;; Must be a text-property button; |
| 389 | ;; return a marker pointing to it. | ||
| 390 | (copy-marker pos t))))) | ||
| 389 | 391 | ||
| 390 | (defun next-button (pos &optional count-current) | 392 | (defun next-button (pos &optional count-current) |
| 391 | "Return the next button after position POS in the current buffer. | 393 | "Return the next button after position POS in the current buffer. |
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 52c0b5b74d2..b9f98cdc4c7 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -1163,8 +1163,9 @@ When not inside a field, signal an error." | |||
| 1163 | 1163 | ||
| 1164 | (defun widget-at (&optional pos) | 1164 | (defun widget-at (&optional pos) |
| 1165 | "The button or field at POS (default, point)." | 1165 | "The button or field at POS (default, point)." |
| 1166 | (or (get-char-property (or pos (point)) 'button) | 1166 | (let ((widget (or (get-char-property (or pos (point)) 'button) |
| 1167 | (widget-field-at pos))) | 1167 | (widget-field-at pos)))) |
| 1168 | (and (widgetp widget) widget))) | ||
| 1168 | 1169 | ||
| 1169 | ;;;###autoload | 1170 | ;;;###autoload |
| 1170 | (defun widget-setup () | 1171 | (defun widget-setup () |
diff --git a/test/lisp/button-tests.el b/test/lisp/button-tests.el new file mode 100644 index 00000000000..d54a992ab89 --- /dev/null +++ b/test/lisp/button-tests.el | |||
| @@ -0,0 +1,40 @@ | |||
| 1 | ;;; button-tests.el --- tests for button.el -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2019 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Code: | ||
| 21 | |||
| 22 | (require 'ert) | ||
| 23 | |||
| 24 | (ert-deftest button-at () | ||
| 25 | "Test `button-at' behavior." | ||
| 26 | (with-temp-buffer | ||
| 27 | (should-not (button-at (point))) | ||
| 28 | (let ((button (insert-text-button "text button")) | ||
| 29 | (marker (button-at (1- (point))))) | ||
| 30 | (should (markerp marker)) | ||
| 31 | (should (= (button-end button) (button-end marker) (point)))) | ||
| 32 | (let ((button (insert-button "overlay button")) | ||
| 33 | (overlay (button-at (1- (point))))) | ||
| 34 | (should (overlayp overlay)) | ||
| 35 | (should (eq button overlay))) | ||
| 36 | ;; Buttons and widgets are incompatible (bug#34506). | ||
| 37 | (widget-create 'link "link widget") | ||
| 38 | (should-not (button-at (1- (point)))))) | ||
| 39 | |||
| 40 | ;;; button-tests.el ends here | ||
diff --git a/test/lisp/wid-edit-tests.el b/test/lisp/wid-edit-tests.el new file mode 100644 index 00000000000..a4350e715ed --- /dev/null +++ b/test/lisp/wid-edit-tests.el | |||
| @@ -0,0 +1,39 @@ | |||
| 1 | ;;; wid-edit-tests.el --- tests for wid-edit.el -*- lexical-binding: t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2019 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 10 | ;; (at your option) any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 19 | |||
| 20 | ;;; Code: | ||
| 21 | |||
| 22 | (require 'ert) | ||
| 23 | (require 'wid-edit) | ||
| 24 | |||
| 25 | (ert-deftest widget-at () | ||
| 26 | "Test `widget-at' behavior." | ||
| 27 | (with-temp-buffer | ||
| 28 | (should-not (widget-at)) | ||
| 29 | (let ((marco (widget-create 'link "link widget")) | ||
| 30 | (polo (widget-at (1- (point))))) | ||
| 31 | (should (widgetp polo)) | ||
| 32 | (should (eq marco polo))) | ||
| 33 | ;; Buttons and widgets are incompatible (bug#34506). | ||
| 34 | (insert-text-button "text button") | ||
| 35 | (should-not (widget-at (1- (point)))) | ||
| 36 | (insert-button "overlay button") | ||
| 37 | (should-not (widget-at (1- (point)))))) | ||
| 38 | |||
| 39 | ;;; wid-edit-tests.el ends here | ||