appears in the mode line. See also the similar @code{subword-mode}
(@pxref{MixedCase Words}).
-@findex electric-layout-mode
- Electric Layout mode (@kbd{M-x electric-layout-mode}) is a global
-minor mode that automatically inserts newlines when you type certain
-characters; for example, @samp{@{}, @samp{@}} and @samp{;} in Javascript
-mode.
-
Apart from Hideshow mode (@pxref{Hideshow}), another way to
selectively display parts of a program is to use the selective display
feature (@pxref{Selective Display}). Programming modes often also
(defun electric-pair--insert (char times)
(let ((last-command-event char)
(blink-matching-paren nil)
- (electric-pair-mode nil)
- ;; When adding the "closer" delimiter, a job his function is
- ;; frequently used for, we don't want to munch any extra
- ;; newlines above us. That would be the default behavior of
- ;; `electric-layout-mode', which potentially kicked in before
- ;; us to add these newlines, and is probably about to kick in
- ;; again after we add the closer.
- (electric-layout-allow-duplicate-newlines t))
+ (electric-pair-mode nil))
(self-insert-command times)))
(defun electric-pair--syntax-ppss (&optional pos where)
(progn
(add-hook 'post-self-insert-hook
#'electric-pair-post-self-insert-function
- ;; Prioritize this to kick in after
- ;; `electric-layout-post-self-insert-function': that
- ;; considerably simplifies interoperation when
- ;; `electric-pair-mode', `electric-layout-mode' and
- ;; `electric-indent-mode' are used together.
- ;; Use `vc-region-history' on these lines for more info.
50)
(add-hook 'post-self-insert-hook
#'electric-pair-open-newline-between-pairs-psif
(condition-case-unless-debug ()
(indent-according-to-mode)
(error (throw 'indent-error nil))))
- (unless (eq electric-indent-inhibit 'electric-layout-mode)
- ;; Unless we're operating under
- ;; `electric-layout-mode' (Bug#35254), the goal here
- ;; will be to remove the trailing whitespace after
- ;; reindentation of the previous line because that
- ;; may have (re)introduced it.
- (goto-char before)
- ;; We were at EOL in marker `before' before the call
- ;; to `indent-according-to-mode' but after we may
- ;; not be (Bug#15767).
- (when (and (eolp))
- (delete-horizontal-space t))))))
+ (goto-char before)
+ ;; We were at EOL in marker `before' before the call
+ ;; to `indent-according-to-mode' but after we may
+ ;; not be (Bug#15767).
+ (when (and (eolp))
+ (delete-horizontal-space t)))))
(unless (and electric-indent-inhibit
(not at-newline))
(condition-case-unless-debug ()
(define-globalized-minor-mode electric-indent-mode
electric-indent-local-mode electric-indent-local-mode)
-;;; Electric newlines after/before/around some chars.
-
-(defvar electric-layout-rules nil
- "List of rules saying where to automatically insert newlines.
-
-Each rule has the form (CHAR . WHERE), the rule matching if the
-character just inserted was CHAR. WHERE specifies where to
-insert newlines, and can be:
-
-* one of the symbols `before', `after', `around', `after-stay',
- or nil.
-
-* a list of the preceding symbols, processed in order of
- appearance to insert multiple newlines;
-
-* a function of no arguments that returns one of the previous
- values.
-
-Each symbol specifies where, in relation to the position POS of
-the character inserted, the newline character(s) should be
-inserted. `after-stay' means insert a newline after POS but stay
-in the same place.
-
-Instead of the (CHAR . WHERE) form, a rule can also be just a
-function of a single argument, the character just inserted. It
-is called at that position, and should return a value compatible with
-WHERE if the rule matches, or nil if it doesn't match.
-
-If multiple rules match, only first one is executed.")
-
-;; TODO: Make this a defcustom?
-(defvar electric-layout-allow-duplicate-newlines nil
- "If non-nil, allow duplication of `before' newlines.")
-
-(defun electric-layout-post-self-insert-function ()
- (when electric-layout-mode
- (electric-layout-post-self-insert-function-1)))
-
-(defvar electric-pair-open-newline-between-pairs)
-
-;; for edebug's sake, a separate function
-(defun electric-layout-post-self-insert-function-1 ()
- (let* ((pos (electric--after-char-pos))
- probe
- (rules electric-layout-rules)
- (rule
- (catch 'done
- (when pos
- (while (setq probe (pop rules))
- (cond ((and (consp probe)
- (eq (car probe) last-command-event))
- (throw 'done (cdr probe)))
- ((functionp probe)
- (let ((res
- (save-excursion
- (goto-char pos)
- (funcall probe last-command-event))))
- (when res (throw 'done res))))))))))
- (when rule
- (goto-char pos)
- (when (functionp rule) (setq rule (funcall rule)))
- (dolist (sym (if (symbolp rule) (list rule) rule))
- (let* ((nl-after
- (lambda ()
- ;; FIXME: we use `newline', which calls
- ;; `self-insert-command' and ran
- ;; `post-self-insert-hook' recursively. It happened
- ;; to make `electric-indent-mode' work automatically
- ;; with `electric-layout-mode' (at the cost of
- ;; re-indenting lines multiple times), but I'm not
- ;; sure it's what we want.
- ;;
- ;; JT@19/02/22: Indeed in the case of `before'
- ;; newlines, re-indentation is prevented.
- ;;
- ;; FIXME: when `newline'ing, we exceptionally
- ;; prevent a specific behavior of
- ;; `electric-pair-mode', that of opening an extra
- ;; newline between newly inserted matching paris.
- ;; In theory that behavior should be provided by
- ;; `electric-layout-mode' instead, which should be
- ;; possible given the current API.
- ;;
- ;; FIXME: check eolp before inserting \n?
- (let ((electric-layout-mode nil)
- (electric-pair-open-newline-between-pairs nil))
- (newline 1 t))))
- (nl-before
- (lambda ()
- (save-excursion
- (goto-char (1- pos))
- ;; Normally, we don't duplicate newlines, but when
- ;; we're being called for i.e. a closer brace for
- ;; `electric-pair-mode' generally make sense. So
- ;; consult `electric-layout-allow-duplicate-newlines'
- (unless (and (not electric-layout-allow-duplicate-newlines)
- (progn (skip-chars-backward " \t")
- (bolp)))
- ;; FIXME: JT@19/03/22: Make sure the `before'
- ;; newline being inserted here does not trigger
- ;; reindentation. It doesn't seem to be our job
- ;; to do so and it break with `cc-mode's
- ;; indentation function. Later on we can add a
- ;; before-and-maybe-indent, or if the user
- ;; really wants to reindent, then
- ;; `last-command-event' should be in
- ;; `electric-indent-chars'.
- (let ((electric-indent-inhibit 'electric-layout-mode))
- (funcall nl-after)))))))
- (pcase sym
- ('before (funcall nl-before))
- ('after (funcall nl-after))
- ('after-stay (save-excursion (funcall nl-after)))
- ('around (funcall nl-before) (funcall nl-after))))))))
-
-;;;###autoload
-(define-minor-mode electric-layout-mode
- "Automatically insert newlines around some chars.
-
-The variable `electric-layout-rules' says when and how to insert newlines."
- :global t :group 'electricity
- (cond (electric-layout-mode
- (add-hook 'post-self-insert-hook
- #'electric-layout-post-self-insert-function
- 40))
- (t
- (remove-hook 'post-self-insert-hook
- #'electric-layout-post-self-insert-function))))
-
-;;;###autoload
-(define-minor-mode electric-layout-local-mode
- "Toggle `electric-layout-mode' only in this buffer."
- :variable ( electric-layout-mode .
- (lambda (val) (setq-local electric-layout-mode val)))
- (cond
- ((eq electric-layout-mode (default-value 'electric-layout-mode))
- (kill-local-variable 'electric-layout-mode))
- ((not (default-value 'electric-layout-mode))
- ;; Locally enabled, but globally disabled.
- (electric-layout-mode 1) ; Setup the hooks.
- (setq-default electric-layout-mode nil) ; But keep it globally disabled.
- )))
-
;;; Electric quoting.
(defcustom electric-quote-comment t
(require 'rx))
(defvar ido-cur-list)
-(defvar electric-layout-rules)
(declare-function ido-mode "ido" (&optional arg))
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(setq-local comment-multi-line t)
(setq-local electric-indent-chars
(append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*".
- (setq-local electric-layout-rules
- '((?\; . after) (?\{ . after) (?\} . before)))
(let ((c-buffer-is-cc-mode t))
;; FIXME: These are normally set by `c-basic-common-init'. Should
;; Electric-indent.
(setq-local electric-indent-chars
(append "{}():;,<>/" electric-indent-chars)) ;FIXME: js2-mode adds "[]*".
- (setq-local electric-layout-rules
- '((?\; . after) (?\{ . after) (?\} . before)))
(setq-local syntax-propertize-function #'js-ts--syntax-propertize)
;; Tree-sitter setup.
["Auto Fill" auto-fill-mode
:style toggle :selected auto-fill-function
:help "Automatic line breaking"]
- ["Electric Layout" electric-layout-mode
- :style toggle :selected electric-layout-mode
- :help "Automatically insert newlines around some chars"]
"---"
("Debug"
["Send Current Line" octave-send-line t]
(put-text-property (match-beginning 1) (match-end 1)
'syntax-table (string-to-syntax "\"'")))))
-(defvar electric-layout-rules)
-
;; FIXME: cc-mode.el also adds an entry for .m files, mapping them to
;; objc-mode. We here rely on the fact that loaddefs.el is filled in
;; alphabetical order, so cc-mode.el comes before octave-mode.el, which lets
(setq-local electric-indent-chars
(cons ?\; electric-indent-chars))
- ;; IIUC matlab-mode takes the opposite approach: it makes RET insert
- ;; a ";" at those places where it's correct (i.e. outside of parens).
- (setq-local electric-layout-rules '((?\; . after)))
(setq-local comment-use-syntax t)
(setq-local comment-start octave-comment-start)
(add-hook 'syntax-propertize-extend-region-functions
#'syntax-propertize-multiline 'append 'local)
;; Electricity.
- ;; FIXME: setup electric-layout-rules.
(setq-local electric-indent-chars
(append '(?\{ ?\} ?\; ?\:) electric-indent-chars))
(add-hook 'electric-indent-functions #'perl-electric-noindent-p nil t)
Interactively, prompt for FILENAME, defaulting to the root directory of
the current project."
- (interactive
- (list (read-file-name "Find file in project: "
- (project-root (project-current t)) nil
- (confirm-nonexistent-file-or-buffer))))
+ (declare (interactive-only find-file))
+ (interactive (list (read-file-name "Find project file: "
+ (project-root (project-current t)) nil
+ (confirm-nonexistent-file-or-buffer))))
(find-file filename t))
;;;###autoload
;; Electric
(setq-local electric-indent-chars
(append "{}():;,<>/" electric-indent-chars))
- (setq-local electric-layout-rules
- '((?\; . after) (?\{ . after) (?\} . before)))
;; Navigation.
(setq-local treesit-defun-type-regexp
(regexp-opt '("class_declaration"
"Insert a newline, and move to left margin of the new line.
With prefix argument ARG, insert that many newlines.
-If `electric-indent-mode' is enabled, this indents the final new line
-that it adds, and reindents the preceding line. To just insert
-a newline, use \\[electric-indent-just-newline].
-
If `auto-fill-mode' is enabled, this may cause automatic line
breaking of the preceding line. A non-nil ARG inhibits this.
+++ /dev/null
-;;; calculator-tests.el --- Test suite for calculator. -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
-
-;; 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)
-(require 'calculator)
-
-(ert-deftest calculator-test-calculator-string-to-number ()
- (dolist (x '(("" 0.0)
- ("+" 0.0)
- ("-" 0.0)
- ("." 0.0)
- ("+." 0.0)
- ("-." -0.0)
- (".-" 0.0)
- ("--." 0.0)
- ("-0.0e" -0.0)
- ("1e1" 10.0)
- ("1e+1" 10.0)
- ("1e-1" 0.1)
- ("+1e1" 10.0)
- ("-1e1" -10.0)
- ("+1e-1" 0.1)
- ("-1e-1" -0.1)
- (".1.e1" 0.1)
- (".1..e1" 0.1)
- ("1e+1.1" 10.0)
- ("-2e-1.1" -0.2)))
- (pcase x
- (`(,str ,expected)
- (let ((calculator-input-radix nil))
- (should (equal (calculator-string-to-number str) expected)))))))
-
-(ert-deftest calculator-expt ()
- (should (= (calculator-expt 2 -1) 0.5))
- (should (= (calculator-expt -2 2) 4))
- (should (= (calculator-expt -2 3) -8))
- (should (= (calculator-expt 2 64) 18446744073709551616)))
-
-(provide 'calculator-tests)
-;;; calculator-tests.el ends here
(defun call-with-saved-electric-modes (fn)
(let ((saved-electric (if electric-pair-mode 1 -1))
- (saved-layout (if electric-layout-mode 1 -1))
(saved-indent (if electric-indent-mode 1 -1))
(blink-paren-function nil))
(electric-pair-mode -1)
- (electric-layout-mode -1)
(electric-indent-mode -1)
(unwind-protect
(funcall fn)
(electric-pair-mode saved-electric)
- (electric-indent-mode saved-indent)
- (electric-layout-mode saved-layout))))
+ (electric-indent-mode saved-indent))))
(defmacro save-electric-modes (&rest body)
(declare (indent defun) (debug t))
:bindings '((electric-pair-text-pairs . ((?\` . ?\')))))
\f
-;;; `js-mode' has `electric-layout-rules' for '{ and '}
-;;;
(define-electric-pair-test js-mode-braces
"" "{" :expected-string "{}" :expected-point 2
:modes '(js-mode)
:fixture-fn (lambda ()
(electric-pair-mode 1)))
-
-(define-electric-pair-test js-mode-braces-with-layout
- "" "{" :expected-string "{\n\n}" :expected-point 3
- :modes '(js-mode)
- :test-in-comments nil
- :test-in-strings nil
- :fixture-fn (lambda ()
- (electric-layout-mode 1)
- (electric-pair-mode 1)))
-
-(define-electric-pair-test js-mode-braces-with-layout-and-indent
- "" "{" :expected-string "{\n \n}" :expected-point 7
- :modes '(js-mode)
- :test-in-comments nil
- :test-in-strings nil
- :fixture-fn (lambda ()
- (electric-pair-mode 1)
- (electric-indent-mode 1)
- (electric-layout-mode 1)))
-
\f
;;; Backspacing
;;; TODO: better tests
:bindings '((comment-start . "<!--") (comment-use-syntax . t))
:test-in-comments nil :test-in-strings nil)
-\f
-;;; tests for `electric-layout-mode'
-
-(define-derived-mode plainer-c-mode c-mode "pC"
- "A plainer/saner C-mode with no internal electric machinery."
- (c-toggle-electric-state -1)
- (setq-local electric-indent-local-mode-hook nil)
- (setq-local electric-indent-mode-hook nil)
- (electric-indent-local-mode 1)
- (dolist (key '(?\" ?\' ?\{ ?\} ?\( ?\) ?\[ ?\]))
- (local-set-key (vector key) 'self-insert-command)))
-
-(defun electric-layout-for-c-style-du-jour (inserted)
- "A function to use in `electric-layout-rules'."
- (when (memq inserted '(?\{ ?\}))
- (save-excursion
- (backward-char 2) (c-point-syntax) (forward-char) ; silly, but needed
- (c-brace-newlines (c-point-syntax)))))
-
-(ert-deftest electric-layout-plainer-c-mode-use-c-style ()
- (ert-with-test-buffer ()
- (plainer-c-mode)
- (electric-layout-local-mode 1)
- (electric-pair-local-mode 1)
- (electric-indent-local-mode 1)
- (setq-local electric-layout-rules
- '(electric-layout-for-c-style-du-jour))
- (insert "int main () ")
- (let ((last-command-event ?\{))
- (call-interactively (key-binding `[,last-command-event])))
- (should (equal (buffer-string) "int main ()\n{\n \n}\n"))))
-
-(ert-deftest electric-layout-int-main-kernel-style ()
- (ert-with-test-buffer ()
- (plainer-c-mode)
- (electric-layout-local-mode 1)
- (electric-pair-local-mode 1)
- (electric-indent-local-mode 1)
- (setq-local electric-layout-rules
- '((?\{ . (after))
- (?\} . (before))))
- (insert "int main () ")
- (let ((last-command-event ?\{))
- (call-interactively (key-binding `[,last-command-event])))
- (should (equal (buffer-string) "int main () {\n \n}"))))
-
-(ert-deftest electric-layout-control-reindentation ()
- "Same as `electric-layout-int-main-kernel-style', but checking
-Bug#35254."
- (ert-with-test-buffer ()
- (plainer-c-mode)
- (electric-layout-local-mode 1)
- (electric-pair-local-mode 1)
- (electric-indent-local-mode 1)
- (setq-local electric-layout-rules
- '((?\{ . (after))
- (?\} . (before))))
- (insert "int main () ")
- (let ((last-command-event ?\{))
- (call-interactively (key-binding `[,last-command-event])))
- (should (equal (buffer-string) "int main () {\n \n}"))
- ;; insert an additional newline and check indentation and
- ;; reindentation
- (call-interactively 'newline)
- (should (equal (buffer-string) "int main () {\n\n \n}"))))
-
-(ert-deftest electric-modes-int-main-allman-style ()
- (ert-with-test-buffer ()
- (plainer-c-mode)
- (electric-layout-local-mode 1)
- (electric-pair-local-mode 1)
- (electric-indent-local-mode 1)
- (setq-local electric-layout-rules
- '((?\{ . (before after))
- (?\} . (before))))
- (insert "int main () ")
- (let ((last-command-event ?\{))
- (call-interactively (key-binding `[,last-command-event])))
- (should (equal (buffer-string) "int main ()\n{\n \n}"))))
-
-(ert-deftest electric-pair-mode-newline-between-parens ()
- (ert-with-test-buffer ()
- (plainer-c-mode)
- (electric-layout-local-mode -1) ;; ensure e-l-m mode is off
- (electric-pair-local-mode 1)
- (insert-before-markers "int main () {}")
- (backward-char 1)
- (let ((last-command-event ?\r))
- (call-interactively (key-binding `[,last-command-event])))
- (should (equal (buffer-string) "int main () {\n \n}"))))
-
-(ert-deftest electric-layout-mode-newline-between-parens-without-e-p-m ()
- (ert-with-test-buffer ()
- (plainer-c-mode)
- (electric-layout-local-mode 1)
- (electric-pair-local-mode -1) ;; ensure e-p-m mode is off
- (electric-indent-local-mode 1)
- (setq-local electric-layout-rules
- '((?\n
- .
- (lambda ()
- (when (eq (save-excursion
- (skip-chars-backward "\t\s")
- (char-before (1- (point))))
- (matching-paren (char-after)))
- '(after-stay))))))
- (insert "int main () {}")
- (backward-char 1)
- (let ((last-command-event ?\r))
- (call-interactively (key-binding `[,last-command-event])))
- (should (equal (buffer-string) "int main () {\n \n}"))))
-
-(ert-deftest electric-layout-mode-newline-between-parens-without-e-p-m-2 ()
- (ert-with-test-buffer ()
- (plainer-c-mode)
- (electric-layout-local-mode 1)
- (electric-pair-local-mode -1) ;; ensure e-p-m mode is off
- (electric-indent-local-mode 1)
- (setq-local electric-layout-rules
- '((lambda (char)
- (when (and
- (eq char ?\n)
- (eq (save-excursion
- (skip-chars-backward "\t\s")
- (char-before (1- (point))))
- (matching-paren (char-after))))
- '(after-stay)))))
- (insert "int main () {}")
- (backward-char 1)
- (let ((last-command-event ?\r))
- (call-interactively (key-binding `[,last-command-event])))
- (should (equal (buffer-string) "int main () {\n \n}"))))
-
(provide 'electric-tests)
;;; electric-tests.el ends here
+++ /dev/null
-;;; mh-limit-tests.el --- tests for mh-limit.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
-
-;; 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)
-(require 'mh-limit)
-
-(ert-deftest mh-pick-args-list ()
- "Test `mh-pick-args-list'."
- (should (equal '() (mh-pick-args-list "")))
- (should (equal '("-subject" "a") (mh-pick-args-list "-subject a")))
- (should (equal '("-subject" "a") (mh-pick-args-list " -subject a ")))
- (should (equal '("-subject" "a" "-from" "b")
- (mh-pick-args-list "-subject a -from b")))
- (should (equal '("-subject" "a b" "-from" "c d")
- (mh-pick-args-list "-subject a b -from c d"))))
-
-;;; mh-limit-tests.el ends here
+++ /dev/null
-;;; mh-thread-tests.el --- tests for mh-thread.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
-
-;; 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)
-(require 'mh-thread)
-(eval-when-compile (require 'cl-lib))
-
-(defun mh-thread-tests-before-from ()
- "Generate the fields of a scan line up to where the \"From\" field would start.
-The exact contents are not important, but the number of characters is."
- (concat (make-string mh-cmd-note ?9)
- (make-string mh-scan-cmd-note-width ?A)
- (make-string mh-scan-destination-width ?t)
- (make-string mh-scan-date-width ?/)
- (make-string mh-scan-date-flag-width ?*)))
-
-;;; Tests of support routines
-
-(ert-deftest mh-thread-current-indentation-level ()
- "Test that `mh-thread-current-indentation-level' identifies the level."
- (with-temp-buffer
- (insert (mh-thread-tests-before-from) "[Sender One] Subject of msg 1\n")
- (insert (mh-thread-tests-before-from) " [Sender Two] Subject of msg 2\n")
- (goto-char (point-min))
- (should (equal 0 (mh-thread-current-indentation-level)))
- (forward-line)
- (should (equal 2 (mh-thread-current-indentation-level)))))
-
-(ert-deftest mh-thread-find-children ()
- "Test `mh-thread-find-children'."
- (let (expected-start expected-end)
- (with-temp-buffer
- (insert (mh-thread-tests-before-from) "[Sender One] line 1\n")
- (setq expected-start (point))
- (insert (mh-thread-tests-before-from) " [Sender Two] line 2\n")
- (insert (mh-thread-tests-before-from) " [Sender Three] line 3\n")
- (insert (mh-thread-tests-before-from) " [Sender Four] line 4\n")
- (setq expected-end (1- (point)))
- (insert (mh-thread-tests-before-from) " [Sender Five] line 5\n")
- (goto-char (1+ expected-start))
- (should (equal (list expected-start expected-end)
- (mh-thread-find-children))))))
-
-(ert-deftest mh-thread-immediate-ancestor ()
- "Test that `mh-thread-immediate-ancestor' moves to the correct message."
- (with-temp-buffer
- (insert (mh-thread-tests-before-from) "[Sender Other] line 1\n")
- (insert (mh-thread-tests-before-from) "[Sender One] line 2\n")
- (insert (mh-thread-tests-before-from) " [Sender Two] line 3\n")
- (insert (mh-thread-tests-before-from) " [Sender Three] line 4\n")
- (insert (mh-thread-tests-before-from) " [Sender Four] line 5\n")
- (insert (mh-thread-tests-before-from) " [Sender Five] line 6\n")
- (forward-line -1)
- (should (equal (line-number-at-pos) 6))
- (mh-thread-immediate-ancestor)
- (should (equal (line-number-at-pos) 4)) ;skips over sibling
- (mh-thread-immediate-ancestor)
- (should (equal (line-number-at-pos) 3)) ;goes up only one level at a time
- (mh-thread-immediate-ancestor)
- (should (equal (line-number-at-pos) 2))
- (mh-thread-immediate-ancestor)
- (should (equal (line-number-at-pos) 2)))) ;no further motion at thread root
-
-;;; Tests of MH-Folder Commands
-
-(ert-deftest mh-thread-sibling-and-ancestor ()
- "Test motion by `mh-thread-ancestor' and `mh-thread-next-sibling'."
- (with-temp-buffer
- (insert (mh-thread-tests-before-from) "[Sender Other] line 1\n")
- (insert (mh-thread-tests-before-from) "[Sender One] line 2\n")
- (insert (mh-thread-tests-before-from) " [Sender Two] line 3\n")
- (insert (mh-thread-tests-before-from) " [Sender Three] line 4\n")
- (insert (mh-thread-tests-before-from) " [Sender Four] line 5\n")
- (insert (mh-thread-tests-before-from) " [Sender Five] line 6\n")
- (forward-line -1)
- (let ((mh-view-ops '(unthread))
- (show-count 0))
- (cl-letf (((symbol-function 'mh-maybe-show)
- (lambda ()
- (setq show-count (1+ show-count)))))
- (should (equal (line-number-at-pos) 6))
- ;; test mh-thread-ancestor
- (mh-thread-ancestor)
- (should (equal (line-number-at-pos) 4)) ;skips over sibling
- (should (equal show-count 1))
- (mh-thread-ancestor t)
- (should (equal (line-number-at-pos) 2)) ;root flag skips to root
- (should (equal show-count 2))
- (mh-thread-ancestor)
- (should (equal (line-number-at-pos) 2)) ;do not move from root
- (should (equal show-count 2)) ;do not re-show at root
- ;; test mh-thread-sibling
- (mh-thread-next-sibling)
- (should (equal (line-number-at-pos) 2)) ;no next sibling, no motion
- (should (equal show-count 2)) ;no sibling, no show
- (mh-thread-next-sibling t)
- (should (equal (line-number-at-pos) 1))
- (should (equal show-count 3))
- (mh-thread-next-sibling t)
- (should (equal (line-number-at-pos) 1)) ;no previous sibling
- (should (equal show-count 3))
- (goto-char (point-max))
- (forward-line -1)
- (should (equal (line-number-at-pos) 6))
- (mh-thread-next-sibling t)
- (should (equal (line-number-at-pos) 5))
- (should (equal show-count 4))
- (mh-thread-next-sibling t)
- (should (equal (line-number-at-pos) 5)) ;no previous sibling
- (should (equal show-count 4))
- ))))
-
-;;; mh-thread-tests.el ends here
+++ /dev/null
-;;; mh-utils-tests.el --- tests for mh-utils.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
-
-;; 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/>.
-
-;;; Commentary:
-
-;; This test suite runs tests that use and depend on MH programs
-;; installed on the system.
-
-;; When running such tests, MH-E can use a particular MH variant
-;; installed on the system, or it can use the mocks provided here.
-;; (Setup is done by the `with-mh-test-env' macro.)
-
-;; By setting environment variable TEST_MH_PATH, you can select which of
-;; the installed MH variants to use, or ignore them all and use mocks.
-;; See also the script test-all-mh-variants.sh in this directory.
-
-;; 1. To run these tests against the default MH variant installed on
-;; this system:
-;; cd ../.. && make lisp/mh-e/mh-utils-tests
-
-;; 2. To run these tests against an MH variant installed in a
-;; specific directory, set TEST_MH_PATH, as in this example:
-;; cd ../.. && make lisp/mh-e/mh-utils-tests TEST_MH_PATH=/usr/local/nmh/bin
-
-;; 3. To search for and run these tests against all MH variants
-;; installed on this system:
-;; ./test-all-mh-variants.sh
-
-;; Setting the environment variable TEST_MH_DEBUG or the Lisp variable
-;; mh-test-utils-debug-mocks logs access to the file system during the test.
-
-;;; Code:
-
-(require 'ert)
-(require 'mh-utils)
-(eval-when-compile
- (require 'cl-lib)
- (require 'subr-x))
-
-(ert-deftest mh-quote-pick-expr ()
- "Test `mh-quote-pick-expr'."
- (should (equal nil (mh-quote-pick-expr nil)))
- (should (equal '() (mh-quote-pick-expr '())))
- (should (equal '("foo") (mh-quote-pick-expr '("foo"))))
- (should (equal '("^\\[foo]?\\*+\\.\\$")
- (mh-quote-pick-expr '("^[foo]?*+.$"))))
- (should (equal '("^\\[foo]?\\*+\\.\\$" "bar" "baz\\$")
- (mh-quote-pick-expr '("^[foo]?*+.$" "bar" "baz$")))))
-
-(ert-deftest mh-normalize-folder-name ()
- "Test `mh-normalize-folder-name'."
- (should (equal nil (mh-normalize-folder-name nil)))
- (should (equal "+" (mh-normalize-folder-name "")))
- (should (equal "" (mh-normalize-folder-name "" t)))
- (should (equal nil (mh-normalize-folder-name "" nil nil t)))
- (should (equal nil (mh-normalize-folder-name "+" nil nil t)))
- (should (equal nil (mh-normalize-folder-name "+" t t t)))
- (should (equal "+inbox" (mh-normalize-folder-name "inbox")))
- (should (equal "+inbox" (mh-normalize-folder-name "+inbox")))
- (should (equal "+inbox" (mh-normalize-folder-name "+inbox/")))
- (should (equal "+inbox/" (mh-normalize-folder-name "+inbox/" t t t)))
- (should (equal "+inbox/" (mh-normalize-folder-name "+inbox/" nil t)))
- (should (equal "+news" (mh-normalize-folder-name "+inbox////../news")))
- (should (equal "+news" (mh-normalize-folder-name "+inbox////../news/")))
- (should (equal "+news/"
- (mh-normalize-folder-name "+inbox////../news/" nil t)))
- (should (equal "+inbox/news" (mh-normalize-folder-name "+inbox////./news"))))
-
-(ert-deftest mh-sub-folders-parse-no-folder ()
- "Test `mh-sub-folders-parse' with no starting folder."
- (let (others-position)
- (with-temp-buffer
- (insert "lines without has-string are ignored\n")
- (insert "onespace has no messages.\n")
- (insert "twospace has no messages.\n")
- (insert " precedingblanks has no messages.\n")
- (insert ".leadingdot has no messages.\n")
- (insert "#leadinghash has no messages.\n")
- (insert ",leadingcomma has no messages.\n")
- (insert "withothers has no messages ; (others)")
- (setq others-position (point))
- (insert ".\n")
- (insert "curf has no messages.\n")
- (insert "curf+ has 123 messages.\n")
- (insert "curf2+ has 17 messages.\n")
- (insert "\ntotal after blank line is ignored has no messages.\n")
- (should (equal
- (mh-sub-folders-parse nil "curf+")
- (list '("onespace") '("twospace") '("precedingblanks")
- (cons "withothers" others-position)
- '("curf") '("curf") '("curf2+")))))))
-
-(ert-deftest mh-sub-folders-parse-relative-folder ()
- "Test `mh-sub-folders-parse' with folder."
- (let (others-position)
- (with-temp-buffer
- (insert "testf+ has no messages.\n")
- (insert "testf/sub1 has no messages.\n")
- (insert "testf/sub2 has no messages ; (others)")
- (setq others-position (point))
- (insert ".\n")
- (should (equal
- (mh-sub-folders-parse "+testf" "testf+")
- (list '("sub1") (cons "sub2" others-position)))))))
-
-(ert-deftest mh-sub-folders-parse-root-folder ()
- "Test `mh-sub-folders-parse' with root folder."
- (with-temp-buffer
- (insert "/+ has no messages.\n")
- (insert "/ has no messages.\n")
- (insert "//nmh-style has no messages.\n")
- (insert "/mu-style has no messages.\n")
- (should (equal
- (mh-sub-folders-parse "+/" "inbox+")
- '(("") ("nmh-style") ("mu-style"))))))
-
-
-;; Folder names that are used by the following tests.
-(defvar mh-test-rel-folder "rela-folder")
-(defvar mh-test-abs-folder "/abso-folder")
-(defvar mh-test-no-such-folder "/testdir/none" "A folder that does not exist.")
-
-(defvar mh-test-utils-variants nil
- "The value of `mh-variants' used for these tests.
-This variable allows setting `mh-variants' to a limited set for targeted
-testing. Its value can be different from the normal value when
-environment variable TEST_MH_PATH is set. By remembering the value, we
-can log the choice only once, which makes the batch log easier to read.")
-
-(defvar mh-test-variant-logged-already nil
- "Whether `with-mh-test-env' has written the MH variant to the log.")
-
-(defvar mh-test-utils-debug-mocks (> (length (getenv "TEST_MH_DEBUG")) 0)
- "Whether to log detailed behavior of mock functions.")
-
-(defvar mh-test-call-process-real (symbol-function 'call-process))
-(defvar mh-test-file-directory-p-real (symbol-function 'file-directory-p))
-
-;;; The macro with-mh-test-env wraps tests that touch the file system
-;;; and/or run programs.
-
-(defmacro with-mh-test-env (&rest body)
- "Evaluate BODY with a test mail environment.
-Functions that touch the file system or run MH programs are either
-mocked out or pointed at a test tree. Uses `mh-test-utils-setup' to
-select which."
- (declare (indent 0) (debug t))
- `(cl-letf ((temp-home-dir nil)
- ;; make local bindings for things we will modify for test env
- (mh-user-path)
- (mh-test-abs-folder)
- ((symbol-function 'call-process))
- ((symbol-function 'file-directory-p))
- ;; the test always gets its own sub-folders cache
- (mh-sub-folders-cache (make-hash-table :test #'equal))
- ;; Allow envvar TEST_MH_PATH to control mh-variants.
- (mh-variants mh-test-utils-variants)
- ;; remember the original value
- (original-mh-test-variant-logged mh-test-variant-logged-already)
- (original-mh-path mh-path)
- (original-mh-sys-path mh-sys-path)
- (original-exec-path exec-path)
- (original-mh-variant-in-use mh-variant-in-use)
- (original-mh-progs mh-progs)
- (original-mh-lib mh-lib)
- (original-mh-lib-progs mh-lib-progs)
- (original-mh-envvar (getenv "MH")))
- (unwind-protect
- (progn
- (setq temp-home-dir (mh-test-utils-setup))
- ,@body)
- (unless noninteractive
- ;; If interactive, forget that we logged the variant and
- ;; restore any changes TEST_MH_PATH made.
- (setq mh-test-variant-logged-already original-mh-test-variant-logged
- mh-path original-mh-path
- mh-sys-path original-mh-sys-path
- exec-path original-exec-path
- mh-variant-in-use original-mh-variant-in-use
- mh-progs original-mh-progs
- mh-lib original-mh-lib
- mh-lib-progs original-mh-lib-progs))
- (if temp-home-dir (delete-directory temp-home-dir t))
- (setenv "MH" original-mh-envvar))))
-
-(defun mh-test-utils-setup ()
- "Set dynamically bound variables needed by mock and/or variants.
-Call `mh-variant-set' to look through the directories named by
-environment variable `TEST_MH_PATH' (default: `mh-path' and `mh-sys-path')
-to find the MH variant to use, if any.
-Return the name of the root of the created directory tree, if any."
- (when (getenv "TEST_MH_PATH")
- ;; force mh-variants to use only TEST_MH_PATH
- (setq mh-path (split-string (getenv "TEST_MH_PATH") path-separator t)
- mh-sys-path nil
- exec-path '("/bin" "/usr/bin")))
- (unless mh-test-variant-logged-already
- (mh-variant-set mh-variant)
- (setq mh-test-utils-variants mh-variants)
- (setq mh-test-variant-logged-already t))
- (when (native-comp-available-p)
- ;; As `call-process'' and `file-directory-p' will be redefined, the
- ;; native compiler will invoke `call-process' to compile the
- ;; respective trampolines. To avoid interference with the
- ;; `call-process' mocking, we build these ahead of time.
- (mapc #'comp-subr-trampoline-install '(call-process file-directory-p)))
- (if mh-variant-in-use
- (mh-test-utils-setup-with-variant)
- (mh-test-utils-setup-with-mocks)))
-
-(defun mh-test-utils-setup-with-mocks ()
- "Set dynamically bound variables so that MH programs are mocked out.
-The tests use this method if no configured MH variant is found."
- (setq mh-user-path "/testdir/Mail/")
- (mh-populate-sub-folders-cache "+")
- (mh-populate-sub-folders-cache "+rela-folder")
- (mh-populate-sub-folders-cache "+rela-folder/bar")
- (mh-populate-sub-folders-cache "+rela-folder/foo")
- (mh-populate-sub-folders-cache "+rela-folder/food")
- (fset 'call-process #'mh-test-utils-mock-call-process)
- (fset 'file-directory-p #'mh-test-utils-mock-file-directory-p)
- ;; no temp directory created
- nil)
-
-(defun mh-test-utils-mock-call-process (program
- &optional _infile _destination _display
- &rest args)
- "A mocked version of `call-process' that calls no processes."
- (let ((argument-responses
- ;; assoc list of program arguments and lines to output.
- '((("folder" "-fast") . ("rela-folder"))
- (("folders" "-noheader" "-norecurse" "-nototal") .
- ("rela-folder has no messages."))
- (("folders" "-noheader" "-norecurse" "-nototal" "+rela-folder") .
- ("rela-folder+ has no messages."
- "rela-folder/bar has no messages."
- "rela-folder/foo has no messages."
- "rela-folder/food has no messages."))
- (("folders" "-noheader" "-norecurse" "-nototal" "+rela-folder/foo") .
- ("rela-folder/foo+ has no messages."))
- (("folders" "-noheader" "-norecurse" "-nototal" "+") .
- ("+ has no messages."))
- (("folders" "-noheader" "-norecurse" "-nototal" "+/abso-folder") .
- ("/abso-folder+ has no messages."
- "/abso-folder/bar has no messages."
- "/abso-folder/foo has no messages."
- "/abso-folder/food has no messages."))
- (("folders" "-noheader" "-norecurse" "-nototal" "+/") .
- ("/+ has no messages ; (others)."
- "/abso-folder has no messages ; (others)."
- "/tmp has no messages ; (others)."))
- ))
- (arglist (cons (file-name-base program) args)))
- (let ((response-list-cons (assoc arglist argument-responses)))
- (cond (response-list-cons
- (let ((response-list (cdr response-list-cons)))
- (when mh-test-utils-debug-mocks
- (message "call-process mock arglist %s" arglist)
- (message " -> response %S" response-list))
- (while response-list
- (insert (car response-list) "\n")
- (setq response-list (cdr response-list))))
- 0)
- (t
- (message "call-process mock unexpected arglist %s" arglist)
- 1)))))
-
-(defun mh-test-utils-mock-file-directory-p (filename)
- "A mocked version of `file-directory-p' that does not access the file system."
- (let ((directories '("" "/" "/tmp" "/abso-folder" "/abso-folder/foo"
- "/testdir/Mail" "/testdir/Mail/rela-folder"
- "/testdir/Mail/rela-folder/foo"
- "rela-folder" "rela-folder/foo"))
- (non-directories '("/abso-folder/fo" "rela-folder/fo"
- "/testdir/Mail/rela-folder/fo"
- "/testdir/Mail/nosuchfolder"
- "/nosuchfolder" "nosuchfolder")))
- (cond ((member (directory-file-name filename) directories)
- (when mh-test-utils-debug-mocks
- (message "file-directory-p mock: %S -> t" filename))
- t)
- ((member (directory-file-name filename) non-directories)
- (when mh-test-utils-debug-mocks
- (message "file-directory-p mock: %S -> nil" filename))
- nil)
- (t
- (message "file-directory-p mock unexpected filename: %S" filename)
- nil))))
-
-(defun mh-test-utils-setup-with-variant ()
- "Create a temporary directory structure for actual MH programs to read.
-Return the name of the root of the created directory tree.
-Set dynamically bound variables so that MH programs may log.
-The tests use this method if a configured MH variant is found."
- (let* ((temp-home-dir
- (make-temp-file "emacs-mh-e-unit-test-" t))
- (profile (expand-file-name
- ".mh_profile" temp-home-dir))
- (mail-dir (expand-file-name "Mail" temp-home-dir))
- (rela-folder (expand-file-name
- "rela-folder" mail-dir))
- (abso-folder (expand-file-name
- "abso-folder" temp-home-dir)))
- (with-temp-file profile
- (insert "Path: " mail-dir "\n" "Welcome: disable\n"))
- (setenv "MH" profile)
- (make-directory (expand-file-name "bar" rela-folder) t)
- (make-directory (expand-file-name "foo" rela-folder) t)
- (make-directory (expand-file-name "food" rela-folder) t)
- (setq mh-user-path (file-name-as-directory mail-dir))
- (make-directory (expand-file-name "bar" abso-folder) t)
- (make-directory (expand-file-name "foo" abso-folder) t)
- (make-directory (expand-file-name "food" abso-folder) t)
- (setq mh-test-abs-folder abso-folder)
- (fset 'call-process #'mh-test-utils-log-call-process)
- (fset 'file-directory-p #'mh-test-utils-log-file-directory-p)
- temp-home-dir))
-
-(defun mh-test-utils-log-call-process (program
- &optional infile destination display
- &rest args)
- "A wrapper around `call-process' that can log the program args and output.
-Both args and output are written with `message' if `mh-test-utils-debug-mocks'
-is non-nil."
- (let (process-output)
- (when mh-test-utils-debug-mocks
- (message "call-process arglist %s" (cons program args)))
- (with-temp-buffer
- (apply mh-test-call-process-real program infile destination display args)
- (setq process-output (buffer-string)))
- (when mh-test-utils-debug-mocks
- (message " -> response:\n%s" process-output))
- (insert process-output)))
-
-(defun mh-test-utils-log-file-directory-p (filename)
- "A wrapper around `file-directory-p' that can log calls.
-Both FILENAME and the return value are written with `message'
-if `mh-test-utils-debug-mocks' is non-nil."
- (let ((result (funcall mh-test-file-directory-p-real filename)))
- (when mh-test-utils-debug-mocks
- (message "file-directory-p: %S -> %s" filename result))
- result))
-
-(defun mh-test-variant-handles-plus-slash (variant)
- "Returns non-nil if this MH variant handles \"folders +/\".
-Mailutils 3.5, 3.7, and 3.13 are known not to."
- (cond ((not (stringp variant))) ;our mock handles it
- ((string-search "GNU Mailutils" variant)
- (let ((mu-version (string-remove-prefix "GNU Mailutils " variant)))
- (version<= "3.13.91" mu-version)))
- (t))) ;no other known failures
-
-
-(ert-deftest mh-sub-folders-actual ()
- "Test `mh-sub-folders-actual'."
- ;; Note that mh-sub-folders-actual expects the folder to have
- ;; already been normalized with
- ;; (mh-normalize-folder-name folder nil nil t)
- (with-mh-test-env
- (should (member
- mh-test-rel-folder
- (mapcar (lambda (x) (car x)) (mh-sub-folders-actual nil))))
- ;; Empty string and "+" not tested since mh-normalize-folder-name
- ;; would change them to nil.
- (should (member "foo"
- (mapcar (lambda (x) (car x))
- (mh-sub-folders-actual
- (format "+%s" mh-test-rel-folder)))))
- ;; Folder with trailing slash not tested since
- ;; mh-normalize-folder-name would strip it.
- (should (equal
- nil
- (mh-sub-folders-actual (format "+%s/foo" mh-test-rel-folder))))
-
- (should (equal
- (list (list "bar") (list "foo") (list "food"))
- (mh-sub-folders-actual (format "+%s" mh-test-abs-folder))))
-
- (when (mh-test-variant-handles-plus-slash mh-variant-in-use)
- (should (member "tmp" (mapcar (lambda (x) (car x))
- (mh-sub-folders-actual "+/")))))
-
- ;; FIXME: mh-sub-folders-actual doesn't (yet) expect to be given a
- ;; nonexistent folder.
- ;; (should (equal nil
- ;; (mh-sub-folders-actual "+nosuchfolder")))
- ;; (should (equal nil
- ;; (mh-sub-folders-actual "+/nosuchfolder")))
- ))
-
-(ert-deftest mh-sub-folders ()
- "Test `mh-sub-folders'."
- (with-mh-test-env
- (should (member mh-test-rel-folder
- (mapcar (lambda (x) (car x)) (mh-sub-folders nil))))
- (should (member mh-test-rel-folder
- (mapcar (lambda (x) (car x)) (mh-sub-folders ""))))
- (should-not (member mh-test-no-such-folder
- (mapcar (lambda (x) (car x)) (mh-sub-folders "+"))))
- (should (equal (list (list "bar") (list "foo") (list "food"))
- (mh-sub-folders (format "+%s" mh-test-rel-folder))))
- (should (equal (list (list "bar") (list "foo") (list "food"))
- (mh-sub-folders (format "+%s/" mh-test-rel-folder))))
- (should (equal nil
- (mh-sub-folders (format "+%s/foo/" mh-test-rel-folder))))
- (should (equal nil
- (mh-sub-folders (format "+%s/foo" mh-test-rel-folder))))
- (should (equal (list (list "bar") (list "foo") (list "food"))
- (mh-sub-folders (format "+%s" mh-test-abs-folder))))
- (when (mh-test-variant-handles-plus-slash mh-variant-in-use)
- (should (member "tmp"
- (mapcar (lambda (x) (car x)) (mh-sub-folders "+/")))))
-
- ;; FIXME: mh-sub-folders doesn't (yet) expect to be given a
- ;; nonexistent folder.
- ;; (should (equal nil
- ;; (mh-sub-folders "+nosuchfolder")))
- ;; (should (equal nil
- ;; (mh-sub-folders "+/nosuchfolder")))
- ))
-
-
-(defmacro mh-test-folder-completion-1 (name
- nil-expected t-expected lambda-expected)
- "Helper for testing `mh-folder-completion-function'.
-Ask for completion on NAME three times, with three different
-values for the FLAG argument of `mh-folder-completion-function'.
-NIL-EXPECTED is the expected value with FLAG nil.
-T-EXPECTED is the expected value with FLAG t.
-LAMBDA-EXPECTED is the expected value with FLAG lambda."
- (declare (debug t))
- `(with-mh-test-env
- (mh-test-folder-completion-2 ,nil-expected ;case "a"
- (mh-folder-completion-function ,name nil nil))
- (mh-test-folder-completion-2 ,t-expected ;case "b"
- (mh-folder-completion-function ,name nil t))
- (mh-test-folder-completion-2 ,lambda-expected ;case "c"
- (mh-folder-completion-function ,name nil
- 'lambda))))
-
-(defmacro mh-test-folder-completion-2 (expected actual)
- "Inner helper for testing `mh-folder-completion-function'.
-ACTUAL should evaluate to either EXPECTED or to a list containing EXPECTED.
-ACTUAL may be evaluated twice, but this gives a clearer error on failure,
-and the `should' macro requires idempotent evaluation anyway."
- (declare (debug t))
- `(if (and (not (consp ,expected)) (consp ,actual))
- (should (member ,expected ,actual))
- (should (equal ,expected ,actual))))
-
-
-(ert-deftest mh-folder-completion-function-02-empty ()
- "Test `mh-folder-completion-function' with empty name."
- (mh-test-folder-completion-1 "" "+" (format "%s/" mh-test-rel-folder) nil))
-
-(ert-deftest mh-folder-completion-function-03-plus ()
- "Test `mh-folder-completion-function' with `+'."
- (mh-test-folder-completion-1 "+" "+" (format "%s/" mh-test-rel-folder) nil))
-
-(ert-deftest mh-folder-completion-function-04-rel-folder ()
- "Test `mh-folder-completion-function' with `+rela-folder'."
- (mh-test-folder-completion-1 (format "+%s" mh-test-rel-folder)
- (format "+%s/" mh-test-rel-folder)
- (list (format "%s/" mh-test-rel-folder))
- t))
-
-(ert-deftest mh-folder-completion-function-05-rel-folder-slash ()
- "Test `mh-folder-completion-function' with `+rela-folder/'."
- (mh-test-folder-completion-1 (format "+%s/" mh-test-rel-folder)
- (format "+%s/" mh-test-rel-folder)
- (list "bar" "foo" "food")
- t))
-
-(ert-deftest mh-folder-completion-function-06-rel-folder-slash-foo ()
- "Test `mh-folder-completion-function' with `+rela-folder/foo'."
- (mh-test-folder-completion-1 (format "+%s/foo" mh-test-rel-folder)
- (format "+%s/foo" mh-test-rel-folder)
- (list "foo" "food")
- t)
- (with-mh-test-env
- (should (equal nil
- (mh-folder-completion-function
- (format "+%s/fo" mh-test-rel-folder) nil 'lambda)))))
-
-(ert-deftest mh-folder-completion-function-07-rel-folder-slash-foo-slash ()
- "Test `mh-folder-completion-function' with `+rela-folder/foo/'."
- (mh-test-folder-completion-1 (format "+%s/foo/" mh-test-rel-folder)
- nil
- nil
- t))
-
-(ert-deftest mh-folder-completion-function-08-plus-slash ()
- "Test `mh-folder-completion-function' with `+/'."
- (with-mh-test-env
- (skip-unless (mh-test-variant-handles-plus-slash mh-variant-in-use)))
- (mh-test-folder-completion-1 "+/" "+/" "tmp/" t)
- ;; case "bb"
- (with-mh-test-env
- (should (equal nil
- (member (format "+%s/" mh-test-rel-folder)
- (mh-folder-completion-function "+/" nil t))))))
-
-(ert-deftest mh-folder-completion-function-09-plus-slash-tmp ()
- "Test `mh-folder-completion-function' with `+/tmp'."
- (with-mh-test-env
- (skip-unless (mh-test-variant-handles-plus-slash mh-variant-in-use)))
- (mh-test-folder-completion-1 "+/tmp" "+/tmp/" "tmp/" t))
-
-(ert-deftest mh-folder-completion-function-10-plus-slash-abs-folder ()
- "Test `mh-folder-completion-function' with `+/abso-folder'."
- (mh-test-folder-completion-1 (format "+%s/" mh-test-abs-folder)
- (format "+%s/" mh-test-abs-folder)
- (list "bar" "foo" "food")
- t))
-
-(ert-deftest mh-folder-completion-function-11-plus-slash-abs-folder-slash-foo ()
- "Test `mh-folder-completion-function' with `+/abso-folder/foo'."
- (mh-test-folder-completion-1 (format "+%s/foo" mh-test-abs-folder)
- (format "+%s/foo" mh-test-abs-folder)
- (list "foo" "food")
- t)
- (with-mh-test-env
- (should (equal nil
- (mh-folder-completion-function
- (format "+%s/fo" mh-test-abs-folder) nil 'lambda)))))
-
-(ert-deftest mh-folder-completion-function-12-plus-nosuchfolder ()
- "Test `mh-folder-completion-function' with `+nosuchfolder'."
- (mh-test-folder-completion-1 "+nosuchfolder" nil nil nil))
-
-(ert-deftest mh-folder-completion-function-13-plus-slash-nosuchfolder ()
- "Test `mh-folder-completion-function' with `+/nosuchfolder'."
- (mh-test-folder-completion-1 "+/nosuchfolder" nil nil nil))
-
-;;; mh-utils-tests.el ends here
+++ /dev/null
-;;; mh-xface-tests.el --- tests for mh-xface.el -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
-
-;; 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)
-(require 'mh-xface)
-
-(ert-deftest mh-x-image-url-sane-p ()
- "Test that `mh-x-image-url-sane-p' accepts a URL exactly if it is sane."
- (should (equal (mh-x-image-url-sane-p (concat "http://"
- (make-string 101 ?a)))
- nil)) ;too long
- (should (equal (mh-x-image-url-sane-p "http") nil)) ;too short
- (should (equal (mh-x-image-url-sane-p "http:") t))
- (should (equal (mh-x-image-url-sane-p "https") nil)) ;too short
- (should (equal (mh-x-image-url-sane-p "https:") t))
- (should (equal (mh-x-image-url-sane-p "https://www.example.com/me.png") t))
- (should (equal (mh-x-image-url-sane-p "abcde:") nil)))
-
-(ert-deftest mh-x-image-url-cache-canonicalize ()
- "Test `mh-x-image-url-cache-canonicalize'."
- (should (equal (format "%s/%s" mh-x-image-cache-directory "%21foo%21bar.png")
- (mh-x-image-url-cache-canonicalize "/foo/bar")))
- (should (equal (format "%s/%s" mh-x-image-cache-directory
- "http%3A%21%21domain.com%21foo%21bar.png")
- (mh-x-image-url-cache-canonicalize
- "http://domain.com/foo/bar")))
- ;; All Windows invalid characters.
- (should (equal (format "%s/%s" mh-x-image-cache-directory
- "%21%3C%3E%3A%2A%3F%22%5C%7C%21bar.png")
- (mh-x-image-url-cache-canonicalize "/<>:*?\"\\|/bar"))))
-
-;;; mh-xface-tests.el ends here
+++ /dev/null
-#! /bin/bash
-# Run the mh-utils-tests against all MH variants found on this system.
-
-# Copyright (C) 2021-2024 Free Software Foundation, Inc.
-
-# 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/>.
-
-# Commentary:
-
-# By default runs all tests; test names or Emacs-style regexps may be
-# given on the command line to run just those tests.
-#
-# Option -d turns on Emacs variable mh-test-utils-debug-mocks, which
-# causes the tests to output all interactions with the file system.
-
-# If you want to run the tests for only one MH variant, you don't need
-# to use this script, because "make" can do it. See the commentary at
-# the top of ./mh-utils-tests.el for the recipe.
-
-debug=
-if [[ "$1" = -* ]]; then
- if [[ "$1" != -d ]]; then
- echo "Usage: $(basename "$0") [-d] [test ...]" >&2
- exit 2
- fi
- debug=t
- shift
-fi
-
-shopt -s extglob
-ert_test_list=()
-for tst; do
- # Guess the type the test spec
- case $tst in
- *[\[\].*+\\]*) # Regexp: put in string quotes
- ert_test_list+=("\"$tst\"")
- ;;
- *) # Lisp expression, keyword, or symbol: use as is
- ert_test_list+=("$tst")
- ;;
- esac
-done
-if [[ ${#ert_test_list[@]} -eq 0 ]]; then
- # t means true for all tests, runs everything
- ert_test_list=(t)
-fi
-
-# This script is 3 directories down in the Emacs source tree.
-cd "$(dirname "$0")"
-cd ../../..
-emacs=(src/emacs --batch -Q)
-
-# MH-E has a good list of directories where an MH variant might be installed,
-# so we look in each of those.
-read -r -a mh_sys_path \
- < <("${emacs[@]}" -l mh-e --eval "(princ mh-sys-path)" | sed 's/[()]//g')
-
-have_done_mocked_variant=false
-declare -i tests_total=0 tests_passed=0
-
-for path in "${mh_sys_path[@]}"; do
- if [[ ! -x "$path/mhparam" ]]; then
- if [[ "$have_done_mocked_variant" = false ]]; then
- have_done_mocked_variant=true
- else
- continue
- fi
- fi
- echo "** Testing with PATH $path"
- ((++tests_total))
- # The LD_LIBRARY_PATH setting is needed
- # to run locally installed Mailutils.
- TEST_MH_PATH=$path TEST_MH_DEBUG=$debug \
- LD_LIBRARY_PATH=/usr/local/lib HOME=/nonexistent \
- "${emacs[@]}" -l ert \
- --eval "(setq load-prefer-newer t)" \
- --eval "(load \"$PWD/test/lisp/mh-e/mh-utils-tests\" nil t)" \
- --eval "(ert-run-tests-batch-and-exit '(or ${ert_test_list[*]}))" \
- && ((++tests_passed))
-done
-
-if (( tests_total == 0 )); then
- echo "NO tests run"
- exit 1
-elif (( tests_total == tests_passed )); then
- echo "All tested variants pass: $tests_passed/$tests_total"
-else
- echo "Tested variants passing: $tests_passed/$tests_total," \
- "FAILING: $((tests_total - tests_passed))/$tests_total"
- exit 1
-fi
(newline 1))
'("(a b \n" . "c d)"))))
-(ert-deftest newline-indent ()
- (should (equal (simple-test--dummy-buffer
- (electric-indent-local-mode 1)
- (newline 1))
- '("(a b\n" . " c d)")))
- (should (equal (simple-test--dummy-buffer
- (electric-indent-local-mode 1)
- (newline 1 'interactive))
- '("(a b\n " . "c d)")))
- (should (equal (simple-test--dummy-buffer
- (electric-indent-local-mode 1)
- (let ((current-prefix-arg nil))
- (call-interactively #'newline)
- (call-interactively #'newline)))
- '("(a b\n\n " . "c d)")))
- (should (equal (simple-test--dummy-buffer
- (electric-indent-local-mode 1)
- (newline 5 'interactive))
- '("(a b\n\n\n\n\n " . "c d)")))
- (should (equal (simple-test--dummy-buffer
- (electric-indent-local-mode 1)
- (let ((current-prefix-arg 5))
- (call-interactively #'newline)))
- '("(a b\n\n\n\n\n " . "c d)")))
- (should (equal (simple-test--dummy-buffer
- (forward-char 1)
- (electric-indent-local-mode 1)
- (newline 1 'interactive))
- '("(a b\n " . "c d)"))))
-
\f
;;; `open-line'
(ert-deftest open-line ()
projects / emacs.git / commitdiff