summaryrefslogtreecommitdiff
path: root/test/lisp/help-tests.el
diff options
context:
space:
mode:
Diffstat (limited to 'test/lisp/help-tests.el')
-rw-r--r--test/lisp/help-tests.el330
1 files changed, 330 insertions, 0 deletions
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el
index 0862d1264c7..b6dffb2a405 100644
--- a/test/lisp/help-tests.el
+++ b/test/lisp/help-tests.el
@@ -3,6 +3,8 @@
;; Copyright (C) 2019-2020 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.
@@ -23,6 +25,7 @@
;;; Code:
(require 'ert)
+(eval-when-compile (require 'cl-lib))
(ert-deftest help-split-fundoc-SECTION ()
"Test new optional arg SECTION."
@@ -51,6 +54,333 @@
(should (equal (help-split-fundoc nil t 'usage) nil))
(should (equal (help-split-fundoc nil t 'doc) nil))))
+
+;;; substitute-command-keys
+
+(defmacro with-substitute-command-keys-test (&rest body)
+ `(cl-flet* ((test
+ (lambda (orig result)
+ (should (equal-including-properties
+ (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/keymaps ()
+ (with-substitute-command-keys-test
+ (test "\\{minibuffer-local-must-match-map}"
+ "\
+key binding
+--- -------
+
+C-g abort-recursive-edit
+TAB minibuffer-complete
+C-j minibuffer-complete-and-exit
+RET minibuffer-complete-and-exit
+ESC Prefix Command
+SPC minibuffer-complete-word
+? minibuffer-completion-help
+<C-tab> file-cache-minibuffer-complete
+<XF86Back> previous-history-element
+<XF86Forward> next-history-element
+<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
+
+")))
+
+(ert-deftest help-tests-substitute-command-keys/keymap-change ()
+ (with-substitute-command-keys-test
+ (test "\\<minibuffer-local-must-match-map>\\[abort-recursive-edit]" "C-g")
+ (test "\\<emacs-lisp-mode-map>\\[eval-defun]" "C-M-x")))
+
+(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-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 ()
+ (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 help-tests-major-mode-map
+ (let ((map (make-keymap)))
+ (define-key map "x" 'foo-original)
+ (define-key map "1" 'foo-range)
+ (define-key map "2" 'foo-range)
+ (define-key map "3" 'foo-range)
+ (define-key map "4" 'foo-range)
+ (define-key map (kbd "C-e") 'foo-something)
+ (define-key map '[F1] 'foo-function-key1)
+ (define-key map "(" 'short-range)
+ (define-key map ")" 'short-range)
+ (define-key map "a" 'foo-other-range)
+ (define-key map "b" 'foo-other-range)
+ (define-key map "c" 'foo-other-range)
+ map))
+
+(define-derived-mode help-tests-major-mode nil
+ "Major mode for testing shadowing.")
+
+(defvar help-tests-minor-mode-map
+ (let ((map (make-keymap)))
+ (define-key map "x" 'foo-shadow)
+ (define-key map (kbd "C-e") 'foo-shadow)
+ map))
+
+(define-minor-mode help-tests-minor-mode
+ "Minor mode for testing shadowing.")
+
+(ert-deftest help-tests-substitute-command-keys/test-mode ()
+ (with-substitute-command-keys-test
+ (with-temp-buffer
+ (help-tests-major-mode)
+ (test "\\{help-tests-major-mode-map}"
+ "\
+key binding
+--- -------
+
+( .. ) short-range
+1 .. 4 foo-range
+a .. c foo-other-range
+
+C-e foo-something
+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 "\\{help-tests-major-mode-map}"
+ "\
+key binding
+--- -------
+
+( .. ) short-range
+1 .. 4 foo-range
+a .. c foo-other-range
+
+C-e foo-something
+ (this binding is currently shadowed)
+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 "\\{help-tests-major-mode-map}"
+ "\
+key binding
+--- -------
+
+<remap> Prefix Command
+
+<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"))))))
+ (describe-map-tree map nil nil nil nil t nil nil nil)
+ (should (equal (buffer-string) "key binding
+--- -------
+
+C-a foo
+
+")))))
+
+(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"))))))
+ (describe-map-tree map nil nil nil nil nil nil nil nil)
+ (should (equal (buffer-string) "key binding
+--- -------
+
+C-a foo
+<menu-bar> Prefix Command
+
+<menu-bar> <foo> foo
+
+")))))
+
+(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))))))
+ (describe-map-tree map t shadow-maps nil nil t nil nil t)
+ (should (equal (buffer-string) "key binding
+--- -------
+
+C-a foo
+ (this binding is currently shadowed)
+C-b bar
+
+")))))
+
+(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))))))
+ (describe-map-tree map t shadow-maps nil nil t nil nil nil)
+ (should (equal (buffer-string) "key binding
+--- -------
+
+C-b bar
+
+")))))
+
+(ert-deftest help-tests-describe-map-tree/partial-t ()
+ (with-temp-buffer
+ (let ((standard-output (current-buffer))
+ (map '(keymap . ((1 . foo)
+ (2 . undefined)))))
+ (describe-map-tree map t nil nil nil nil nil nil nil)
+ (should (equal (buffer-string) "key binding
+--- -------
+
+C-a foo
+
+")))))
+
+(ert-deftest help-tests-describe-map-tree/partial-nil ()
+ (with-temp-buffer
+ (let ((standard-output (current-buffer))
+ (map '(keymap . ((1 . foo)
+ (2 . undefined)))))
+ (describe-map-tree map nil nil nil nil nil nil nil nil)
+ (should (equal (buffer-string) "key binding
+--- -------
+
+C-a foo
+C-b undefined
+
+")))))
+
+(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)))
+
(provide 'help-tests)
;;; help-tests.el ends here