487 lines
17 KiB
EmacsLisp
487 lines
17 KiB
EmacsLisp
;;; help-tests.el --- Tests for help.el -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
|
||
|
||
;; Author: Juanma Barranquero <lekktu@gmail.com>
|
||
;; Eli Zaretskii <eliz@gnu.org>
|
||
;; Stefan Kangas <stefankangas@gmail.com>
|
||
;; Keywords: help, internal
|
||
|
||
;; 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)
|
||
(eval-when-compile (require 'cl-lib))
|
||
(require 'text-property-search) ; for `text-property-search-forward'
|
||
|
||
(ert-deftest help-split-fundoc-SECTION ()
|
||
"Test new optional arg SECTION."
|
||
(let* ((doc "Doc first line.\nDoc second line.")
|
||
(usg "\n\n(fn ARG1 &optional ARG2)")
|
||
(full (concat doc usg))
|
||
(usage "(t ARG1 &optional ARG2)"))
|
||
;; Docstring has both usage and doc
|
||
(should (equal (help-split-fundoc full t nil) `(,usage . ,doc)))
|
||
(should (equal (help-split-fundoc full t t) `(,usage . ,doc)))
|
||
(should (equal (help-split-fundoc full t 'usage) usage))
|
||
(should (equal (help-split-fundoc full t 'doc) doc))
|
||
;; Docstring has no usage, only doc
|
||
(should (equal (help-split-fundoc doc t nil) nil))
|
||
(should (equal (help-split-fundoc doc t t) `(nil . ,doc)))
|
||
(should (equal (help-split-fundoc doc t 'usage) nil))
|
||
(should (equal (help-split-fundoc doc t 'doc) doc))
|
||
;; Docstring is only usage, no doc
|
||
(should (equal (help-split-fundoc usg t nil) `(,usage . nil)))
|
||
(should (equal (help-split-fundoc usg t t) `(,usage . nil)))
|
||
(should (equal (help-split-fundoc usg t 'usage) usage))
|
||
(should (equal (help-split-fundoc usg t 'doc) nil))
|
||
;; Docstring is null
|
||
(should (equal (help-split-fundoc nil t nil) nil))
|
||
(should (equal (help-split-fundoc nil t t) '(nil)))
|
||
(should (equal (help-split-fundoc nil t 'usage) nil))
|
||
(should (equal (help-split-fundoc nil t 'doc) nil))))
|
||
|
||
(ert-deftest help--key-description-fontified ()
|
||
(should (equal (help--key-description-fontified
|
||
(where-is-internal #'next-line nil t))
|
||
"C-n"))
|
||
(should-not (help--key-description-fontified nil)))
|
||
|
||
|
||
;;; substitute-command-keys
|
||
|
||
(defmacro with-substitute-command-keys-test (&rest body)
|
||
`(cl-flet* ((test
|
||
(lambda (orig result)
|
||
(should (equal (substitute-command-keys orig)
|
||
result))))
|
||
(test-re
|
||
(lambda (orig regexp)
|
||
(should (string-match (concat "\\`" regexp "\\'")
|
||
(substitute-command-keys orig))))))
|
||
,@body))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/no-change ()
|
||
(with-substitute-command-keys-test
|
||
(test "foo" "foo")
|
||
(test "\\invalid-escape" "\\invalid-escape")))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/commands ()
|
||
(with-substitute-command-keys-test
|
||
(test "foo \\[goto-char]" "foo M-g c")
|
||
(test "\\[next-line]" "C-n")
|
||
(test "\\[next-line]\n\\[next-line]" "C-n\nC-n")
|
||
(test "\\[next-line]\\[previous-line]" "C-nC-p")
|
||
(test "\\[next-line]\\=\\[previous-line]" "C-n\\[previous-line]")
|
||
;; Allow any style of quotes, since the terminal might not support
|
||
;; UTF-8. Same thing is done below.
|
||
(test-re "\\[next-line]`foo'" "C-n[`'‘]foo['’]")
|
||
(test "\\[emacs-version]" "M-x emacs-version")
|
||
(test "\\[emacs-version]\\[next-line]" "M-x emacs-versionC-n")
|
||
(test-re "\\[emacs-version]`foo'" "M-x emacs-version[`'‘]foo['’]")))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/literal-key-sequence ()
|
||
"Literal replacement."
|
||
(with-substitute-command-keys-test
|
||
(test "\\`C-m'" "C-m")
|
||
(test "\\`C-m'\\`C-j'" "C-mC-j")
|
||
(test "foo\\`C-m'bar\\`C-j'baz" "fooC-mbarC-jbaz")
|
||
(test "\\`M-x next-line'" "M-x next-line")
|
||
(test "\\`mouse-1'" "mouse-1")))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/literal-key-sequence-ignore-invalid ()
|
||
"Ignore any invalid literal key sequence."
|
||
(with-substitute-command-keys-test
|
||
(test-re "ab\\`'cd" "ab\\\\[`'‘]['’]cd")
|
||
(test-re "\\`c-c'" "\\\\[`'‘]c-c['’]")
|
||
(test-re "\\`<foo bar baz>'" "\\\\[`'‘]<foo bar baz>['’]")))
|
||
|
||
(ert-deftest help-tests-substitute-key-bindings/help-key-binding-face ()
|
||
(let ((A (substitute-command-keys "\\[next-line]"))
|
||
(B (substitute-command-keys "\\`f'")))
|
||
(should (eq (get-text-property 0 'face A) 'help-key-binding))
|
||
(should (eq (get-text-property 0 'face B) 'help-key-binding))))
|
||
|
||
(ert-deftest help-tests-substitute-key-bindings/help-key-binding-no-face ()
|
||
(let ((A (substitute-command-keys "\\[next-line]" t))
|
||
(B (substitute-command-keys "\\`f'" t)))
|
||
(should (eq (get-text-property 0 'face A) nil))
|
||
(should (eq (get-text-property 0 'face B) nil))
|
||
(should (equal A "C-n"))
|
||
(should (equal B "f"))))
|
||
|
||
(defvar-keymap help-tests--test-keymap
|
||
:doc "Just some keymap for testing."
|
||
"C-g" #'abort-minibuffers
|
||
"TAB" #'minibuffer-complete
|
||
"C-j" #'minibuffer-complete-and-exit
|
||
"RET" #'minibuffer-complete-and-exit
|
||
"SPC" #'minibuffer-complete-word
|
||
"?" #'minibuffer-completion-help
|
||
"C-<tab>" #'file-cache-minibuffer-complete
|
||
"<XF86Back>" #'previous-history-element
|
||
"<XF86Forward>" #'next-history-element
|
||
"<backtab>" #'minibuffer-complete
|
||
"<down>" #'next-line-or-history-element
|
||
"<next>" #'next-history-element
|
||
"<prior>" #'switch-to-completions
|
||
"<up>" #'previous-line-or-history-element
|
||
"M-v" #'switch-to-completions
|
||
"M-<" #'minibuffer-beginning-of-buffer
|
||
"M-n" #'next-history-element
|
||
"M-p" #'previous-history-element
|
||
"M-r" #'previous-matching-history-element
|
||
"M-s" #'next-matching-history-element
|
||
"M-g M-c" #'switch-to-completions)
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/keymaps ()
|
||
(with-substitute-command-keys-test
|
||
(test-re "\\{help-tests--test-keymap}"
|
||
"
|
||
Key Binding
|
||
-+
|
||
C-g abort-minibuffers
|
||
TAB minibuffer-complete
|
||
C-j minibuffer-complete-and-exit
|
||
RET minibuffer-complete-and-exit
|
||
SPC minibuffer-complete-word
|
||
\\? minibuffer-completion-help
|
||
C-<tab> file-cache-minibuffer-complete
|
||
<XF86Back> previous-history-element
|
||
<XF86Forward> next-history-element
|
||
<backtab> minibuffer-complete
|
||
<down> next-line-or-history-element
|
||
<next> next-history-element
|
||
<prior> switch-to-completions
|
||
<up> previous-line-or-history-element
|
||
|
||
M-< minibuffer-beginning-of-buffer
|
||
M-n next-history-element
|
||
M-p previous-history-element
|
||
M-r previous-matching-history-element
|
||
M-s next-matching-history-element
|
||
M-v switch-to-completions
|
||
|
||
M-g M-c switch-to-completions
|
||
")))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/keymap-change ()
|
||
(with-substitute-command-keys-test
|
||
;; Global binding should be found even if specifying a specific map
|
||
(test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-]")
|
||
(test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")
|
||
;; Specific map overrides advertised-binding
|
||
(test "\\<undo-repeat-map>\\[undo]" "u")
|
||
(test "\\[undo]" "C-x u")))
|
||
|
||
(defvar-keymap help-tests-remap-map
|
||
:full t
|
||
"x" 'foo
|
||
"y" 'bar
|
||
"<remap> <foo>" 'bar)
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/remap ()
|
||
(should (equal (substitute-command-keys "\\<help-tests-remap-map>\\[foo]") "y"))
|
||
(should (equal (substitute-command-keys "\\<help-tests-remap-map>\\[bar]") "y")))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/undefined-map ()
|
||
(with-substitute-command-keys-test
|
||
(test-re "\\{foobar-map}"
|
||
"\nUses keymap [`'‘]foobar-map['’], which is not currently defined.\n")))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/quotes ()
|
||
(with-substitute-command-keys-test
|
||
(let ((text-quoting-style 'curve))
|
||
(test "quotes ‘like this’" "quotes ‘like this’")
|
||
(test "`x'" "‘x’")
|
||
(test "`" "‘")
|
||
(test "'" "’")
|
||
(test "\\`" "\\‘"))
|
||
(let ((text-quoting-style 'straight))
|
||
(test "quotes `like this'" "quotes 'like this'")
|
||
(test "`x'" "'x'")
|
||
(test "`" "'")
|
||
(test "'" "'")
|
||
(test "\\`" "\\'"))
|
||
(let ((text-quoting-style 'grave))
|
||
(test "quotes `like this'" "quotes `like this'")
|
||
(test "`x'" "`x'")
|
||
(test "`" "`")
|
||
(test "'" "'")
|
||
(test "\\`" "\\`"))))
|
||
|
||
(ert-deftest help-tests-substitute-quotes ()
|
||
(let ((text-quoting-style 'curve))
|
||
(should (string= (substitute-quotes "quotes ‘like this’") "quotes ‘like this’"))
|
||
(should (string= (substitute-quotes "`x'") "‘x’"))
|
||
(should (string= (substitute-quotes "`") "‘"))
|
||
(should (string= (substitute-quotes "'") "’"))
|
||
(should (string= (substitute-quotes "\\`") "\\‘")))
|
||
(let ((text-quoting-style 'straight))
|
||
(should (string= (substitute-quotes "quotes `like this'") "quotes 'like this'"))
|
||
(should (string= (substitute-quotes "`x'") "'x'"))
|
||
(should (string= (substitute-quotes "`") "'"))
|
||
(should (string= (substitute-quotes "'") "'"))
|
||
(should (string= (substitute-quotes "\\`") "\\'")))
|
||
(let ((text-quoting-style 'grave))
|
||
(should (string= (substitute-quotes "quotes `like this'") "quotes `like this'"))
|
||
(should (string= (substitute-quotes "`x'") "`x'"))
|
||
(should (string= (substitute-quotes "`") "`"))
|
||
(should (string= (substitute-quotes "'") "'"))
|
||
(should (string= (substitute-quotes "\\`") "\\`"))))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/literals ()
|
||
(with-substitute-command-keys-test
|
||
(test "foo \\=\\[goto-char]" "foo \\[goto-char]")
|
||
(test "foo \\=\\=" "foo \\=")
|
||
(test "\\=\\=" "\\=")
|
||
(test "\\=\\[" "\\[")
|
||
(let ((text-quoting-style 'curve))
|
||
(test "\\=`x\\='" "`x'"))
|
||
(let ((text-quoting-style 'straight))
|
||
(test "\\=`x\\='" "`x'"))
|
||
(let ((text-quoting-style 'grave))
|
||
(test "\\=`x\\='" "`x'"))))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/no-change-2 ()
|
||
(with-substitute-command-keys-test
|
||
(test "\\[foobar" "\\[foobar")
|
||
(test "\\=" "\\=")))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/multibyte ()
|
||
;; Cannot use string= here, as that compares unibyte and multibyte
|
||
;; strings not equal.
|
||
(should (compare-strings
|
||
(substitute-command-keys "\200 \\[goto-char]") nil nil
|
||
"\200 M-g c" nil nil)))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/apropos ()
|
||
(save-window-excursion
|
||
(apropos "foo")
|
||
(switch-to-buffer "*Apropos*")
|
||
(goto-char (point-min))
|
||
(should (looking-at "Type RET on"))))
|
||
|
||
(defvar-keymap help-tests-major-mode-map
|
||
:full t
|
||
"x" 'foo-original
|
||
"1" 'foo-range
|
||
"2" 'foo-range
|
||
"3" 'foo-range
|
||
"4" 'foo-range
|
||
"C-e" 'foo-something
|
||
"<f1>" 'foo-function-key1
|
||
"(" 'short-range
|
||
")" 'short-range
|
||
"a" 'foo-other-range
|
||
"b" 'foo-other-range
|
||
"c" 'foo-other-range)
|
||
|
||
(define-derived-mode help-tests-major-mode nil
|
||
"Major mode for testing shadowing.")
|
||
|
||
(defvar-keymap help-tests-minor-mode-map
|
||
:full t
|
||
"x" 'foo-shadow
|
||
"C-e" 'foo-shadow)
|
||
|
||
(define-minor-mode help-tests-minor-mode
|
||
"Minor mode for testing shadowing.")
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/add-key-face ()
|
||
(should (equal (substitute-command-keys "\\[next-line]")
|
||
(propertize "C-n"
|
||
'face 'help-key-binding
|
||
'font-lock-face 'help-key-binding))))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/add-key-face-listing ()
|
||
(with-temp-buffer
|
||
(insert (substitute-command-keys "\\{help-tests-minor-mode-map}"))
|
||
(goto-char (point-min))
|
||
(text-property-search-forward 'face 'help-key-binding)
|
||
(should (looking-at "C-e"))
|
||
;; Don't fontify trailing whitespace.
|
||
(should-not (get-text-property (+ (point) 3) 'face))
|
||
(text-property-search-forward 'face 'help-key-binding)
|
||
(should (looking-at "x"))
|
||
(should-not (get-text-property (+ (point) 1) 'face))))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/test-mode ()
|
||
(with-substitute-command-keys-test
|
||
(with-temp-buffer
|
||
(help-tests-major-mode)
|
||
(test-re "\\{help-tests-major-mode-map}"
|
||
"
|
||
Key Binding
|
||
-+
|
||
1 .. 4 foo-range
|
||
a .. c foo-other-range
|
||
|
||
C-e foo-something
|
||
( .. ) short-range
|
||
x foo-original
|
||
<F1> foo-function-key1
|
||
"))))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/shadow ()
|
||
(with-substitute-command-keys-test
|
||
(with-temp-buffer
|
||
(help-tests-major-mode)
|
||
(help-tests-minor-mode)
|
||
(test-re "\\{help-tests-major-mode-map}"
|
||
"
|
||
Key Binding
|
||
-+
|
||
1 .. 4 foo-range
|
||
a .. c foo-other-range
|
||
|
||
C-e foo-something
|
||
(this binding is currently shadowed)
|
||
( .. ) short-range
|
||
x foo-original
|
||
(this binding is currently shadowed)
|
||
<F1> foo-function-key1
|
||
"))))
|
||
|
||
(ert-deftest help-tests-substitute-command-keys/command-remap ()
|
||
(with-substitute-command-keys-test
|
||
(let ((help-tests-major-mode-map (make-keymap))) ; Protect from changes.
|
||
(with-temp-buffer
|
||
(help-tests-major-mode)
|
||
(define-key help-tests-major-mode-map [remap foo] 'bar)
|
||
(test-re "\\{help-tests-major-mode-map}"
|
||
"
|
||
Key Binding
|
||
-+
|
||
<remap> <foo> bar
|
||
")))))
|
||
|
||
(ert-deftest help-tests-describe-map-tree/no-menu-t ()
|
||
(with-temp-buffer
|
||
(let ((standard-output (current-buffer))
|
||
(map '(keymap . ((1 . foo)
|
||
(menu-bar keymap
|
||
(foo menu-item "Foo" foo
|
||
:enable mark-active
|
||
:help "Help text"))))))
|
||
(help--describe-map-tree map nil nil nil nil t nil nil nil)
|
||
(should (string-match "
|
||
Key Binding
|
||
-+
|
||
C-a foo\n"
|
||
(buffer-string))))))
|
||
|
||
(ert-deftest help-tests-describe-map-tree/no-menu-nil ()
|
||
(with-temp-buffer
|
||
(let ((standard-output (current-buffer))
|
||
(map '(keymap . ((1 . foo)
|
||
(menu-bar keymap
|
||
(foo menu-item "Foo" foo
|
||
:enable mark-active
|
||
:help "Help text"))))))
|
||
(help--describe-map-tree map nil nil nil nil nil nil nil nil)
|
||
(should (string-match "
|
||
Key Binding
|
||
-+
|
||
C-a foo
|
||
|
||
<menu-bar> <foo> foo\n"
|
||
(buffer-string))))))
|
||
|
||
(ert-deftest help-tests-describe-map-tree/mention-shadow-t ()
|
||
(with-temp-buffer
|
||
(let ((standard-output (current-buffer))
|
||
(map '(keymap . ((1 . foo)
|
||
(2 . bar))))
|
||
(shadow-maps '((keymap . ((1 . baz))))))
|
||
(help--describe-map-tree map t shadow-maps nil nil t nil nil t)
|
||
(should (string-match "
|
||
Key Binding
|
||
-+
|
||
C-a foo
|
||
(this binding is currently shadowed)
|
||
C-b bar\n"
|
||
(buffer-string))))))
|
||
|
||
(ert-deftest help-tests-describe-map-tree/mention-shadow-nil ()
|
||
(with-temp-buffer
|
||
(let ((standard-output (current-buffer))
|
||
(map '(keymap . ((1 . foo)
|
||
(2 . bar))))
|
||
(shadow-maps '((keymap . ((1 . baz))))))
|
||
(help--describe-map-tree map t shadow-maps nil nil t nil nil nil)
|
||
(should (string-match "
|
||
Key Binding
|
||
-+
|
||
C-b bar\n"
|
||
(buffer-string))))))
|
||
|
||
(ert-deftest help-tests-describe-map-tree/partial-t ()
|
||
(with-temp-buffer
|
||
(let ((standard-output (current-buffer))
|
||
(map '(keymap . ((1 . foo)
|
||
(2 . undefined)))))
|
||
(help--describe-map-tree map t nil nil nil nil nil nil nil)
|
||
(should (string-match "
|
||
Key Binding
|
||
-+
|
||
C-a foo\n"
|
||
(buffer-string))))))
|
||
|
||
(ert-deftest help-tests-describe-map-tree/partial-nil ()
|
||
(with-temp-buffer
|
||
(let ((standard-output (current-buffer))
|
||
(map '(keymap . ((1 . foo)
|
||
(2 . undefined)))))
|
||
(help--describe-map-tree map nil nil nil nil nil nil nil nil)
|
||
(should (string-match "
|
||
Key Binding
|
||
-+
|
||
C-a foo
|
||
C-b undefined\n"
|
||
(buffer-string))))))
|
||
|
||
(defvar help-tests--was-in-buffer nil)
|
||
|
||
(ert-deftest help-substitute-command-keys/menu-filter-in-correct-buffer ()
|
||
"Evaluate menu-filter in the original buffer. See Bug#39149."
|
||
(unwind-protect
|
||
(progn
|
||
(define-key global-map (kbd "C-c C-l r")
|
||
`(menu-item "2" identity
|
||
:filter ,(lambda (cmd)
|
||
(setq help-tests--was-in-buffer
|
||
(current-buffer))
|
||
cmd)))
|
||
(with-temp-buffer
|
||
(substitute-command-keys "\\[identity]")
|
||
(should (eq help-tests--was-in-buffer
|
||
(current-buffer)))))
|
||
(setq help-tests--was-in-buffer nil)
|
||
(define-key global-map (kbd "C-c C-l r") nil)
|
||
(define-key global-map (kbd "C-c C-l") nil)))
|
||
|
||
(ert-deftest help-substitute-command-keys/preserves-text-properties ()
|
||
"Check that we preserve text properties (Bug#17052)."
|
||
(should (equal (substitute-command-keys
|
||
(propertize "foo \\[save-buffer]" 'face 'bold))
|
||
(propertize "foo C-x C-s" 'face 'bold))))
|
||
|
||
(provide 'help-tests)
|
||
|
||
;;; help-tests.el ends here
|