;;; help-tests.el --- Tests for help.el -*- lexical-binding: t; -*- ;; Copyright (C) 2019-2024 Free Software Foundation, Inc. ;; Author: Juanma Barranquero ;; Eli Zaretskii ;; Stefan Kangas ;; 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 . ;;; 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 "\\`'" "\\\\[`'‘]['’]"))) (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-" #'file-cache-minibuffer-complete "" #'previous-history-element "" #'next-history-element "" #'minibuffer-complete "" #'next-line-or-history-element "" #'next-history-element "" #'switch-to-completions "" #'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- file-cache-minibuffer-complete previous-history-element next-history-element minibuffer-complete next-line-or-history-element next-history-element switch-to-completions 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 "\\\\[abort-recursive-edit]" "C-]") (test "\\\\[eval-defun]" "C-M-x") ;; Specific map overrides advertised-binding (test "\\\\[undo]" "u") (test "\\[undo]" "C-x u"))) (defvar-keymap help-tests-remap-map :full t "x" 'foo "y" 'bar " " 'bar) (ert-deftest help-tests-substitute-command-keys/remap () (should (equal (substitute-command-keys "\\\\[foo]") "y")) (should (equal (substitute-command-keys "\\\\[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 "" '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 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) 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 -+ 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 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