mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-05 11:21:04 -08:00
Code Issues Projects Releases Wiki Activity

Distinguish buttons from widgets (bug#34506)

Browse source 
* lisp/button.el (button-at):
* lisp/wid-edit.el (widget-at): Avoid returning a false positive
when looking for a button and finding a widget, or vice versa.
* test/lisp/button-tests.el:
* test/lisp/wid-edit-tests.el: New files.
This commit is contained in:
Basil L. Contovounesios 2019-04-07 03:36:47 +01:00
parent 43f4c7ddd2
commit 08235af38c
4 changed files with 88 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

8
lisp/button.el
View file

@ -382,10 +382,12 @@ Also see `make-text-button'."
If the button at POS is a text property button, the return value
is a marker pointing to POS."
(let ((button (get-char-property pos 'button)))
(if (or (overlayp button) (null button))
(and button (get-char-property pos 'category)
(if (overlayp button)
button
;; Must be a text-property button; return a marker pointing to it.
(copy-marker pos t))))
;; Must be a text-property button;
;; return a marker pointing to it.
(copy-marker pos t)))))
(defun next-button (pos &optional count-current)
"Return the next button after position POS in the current buffer.

5
lisp/wid-edit.el
View file

@ -1163,8 +1163,9 @@ When not inside a field, signal an error."
(defun widget-at (&optional pos)
"The button or field at POS (default, point)."
(or (get-char-property (or pos (point)) 'button)
(widget-field-at pos)))
(let ((widget (or (get-char-property (or pos (point)) 'button)
(widget-field-at pos))))
(and (widgetp widget) widget)))
;;;###autoload
(defun widget-setup ()

40
test/lisp/button-tests.el Normal file
View file

@ -0,0 +1,40 @@
;;; button-tests.el --- tests for button.el -*- lexical-binding: t -*-
;; Copyright (C) 2019 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(ert-deftest button-at ()
"Test `button-at' behavior."
(with-temp-buffer
(should-not (button-at (point)))
(let ((button (insert-text-button "text button"))
(marker (button-at (1- (point)))))
(should (markerp marker))
(should (= (button-end button) (button-end marker) (point))))
(let ((button (insert-button "overlay button"))
(overlay (button-at (1- (point)))))
(should (overlayp overlay))
(should (eq button overlay)))
;; Buttons and widgets are incompatible (bug#34506).
(widget-create 'link "link widget")
(should-not (button-at (1- (point))))))
;;; button-tests.el ends here

39
test/lisp/wid-edit-tests.el Normal file
View file

@ -0,0 +1,39 @@
;;; wid-edit-tests.el --- tests for wid-edit.el -*- lexical-binding: t -*-
;; Copyright (C) 2019 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'wid-edit)
(ert-deftest widget-at ()
"Test `widget-at' behavior."
(with-temp-buffer
(should-not (widget-at))
(let ((marco (widget-create 'link "link widget"))
(polo (widget-at (1- (point)))))
(should (widgetp polo))
(should (eq marco polo)))
;; Buttons and widgets are incompatible (bug#34506).
(insert-text-button "text button")
(should-not (widget-at (1- (point))))
(insert-button "overlay button")
(should-not (widget-at (1- (point))))))
;;; wid-edit-tests.el ends here