diff options
Diffstat (limited to 'test/lisp/help-tests.el')
| -rw-r--r-- | test/lisp/help-tests.el | 486 |
1 files changed, 486 insertions, 0 deletions
diff --git a/test/lisp/help-tests.el b/test/lisp/help-tests.el new file mode 100644 index 00000000000..0fcaacb6443 --- /dev/null +++ b/test/lisp/help-tests.el @@ -0,0 +1,486 @@ +;;; help-tests.el --- Tests for help.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2019-2022 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")))))) + (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")))))) + (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)))))) + (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)))))) + (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))))) + (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))))) + (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 |