diff options
Diffstat (limited to 'test/lisp/help-tests.el')
| -rw-r--r-- | test/lisp/help-tests.el | 347 |
1 files changed, 347 insertions, 0 deletions
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el index 1c432f58560..95557c95eb7 100644 --- a/test/lisp/help-tests.el +++ b/test/lisp/help-tests.el @@ -3,6 +3,8 @@ ;; Copyright (C) 2019-2021 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,350 @@ (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"))) + +(defvar help-tests-remap-map + (let ((map (make-keymap))) + (define-key map (kbd "x") 'foo) + (define-key map (kbd "y") 'bar) + (define-key map [remap foo] 'bar) + map)) + +(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-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))) + +(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 |