[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master efd239c 2/3: Add a new command to mark a region as a test in erts
From: |
Lars Ingebrigtsen |
Subject: |
master efd239c 2/3: Add a new command to mark a region as a test in erts-mode |
Date: |
Fri, 1 Oct 2021 07:25:56 -0400 (EDT) |
branch: master
commit efd239c1475de43806a739702583316cfb297003
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Add a new command to mark a region as a test in erts-mode
* lisp/progmodes/erts-mode.el (erts-mode--in-test-p): Fix test.
(erts-tag-region): New command and keystroke.
---
lisp/progmodes/erts-mode.el | 41 +++++++++++++++++++++++++++++++++++++++--
1 file changed, 39 insertions(+), 2 deletions(-)
diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el
index cf7eca5..6f3e5b3 100644
--- a/lisp/progmodes/erts-mode.el
+++ b/lisp/progmodes/erts-mode.el
@@ -23,6 +23,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup erts-mode nil
"Major mode for editing Emacs test files."
:group 'lisp)
@@ -64,6 +66,7 @@
(defvar erts-mode-map
(let ((map (make-keymap)))
(set-keymap-parent map prog-mode-map)
+ (define-key map "\C-c\C-r" 'erts-tag-region)
map))
(defvar erts-mode-font-lock-keywords
@@ -100,7 +103,8 @@
(beginning-of-line)
(if (looking-at "=-=\\(-=\\)?$")
t
- (let ((test-start (re-search-backward "^=-=\n" nil t)))
+ (let ((test-start (save-excursion
+ (re-search-backward "^=-=\n" nil t))))
;; Before the first test.
(and test-start
(let ((test-end (re-search-backward "^=-=-=\n" nil t)))
@@ -111,9 +115,42 @@
;;;###autoload
(define-derived-mode erts-mode prog-mode "erts"
"Major mode for editing erts (Emacs testing) files.
-This mode mainly provides some font locking."
+This mode mainly provides some font locking.
+
+\\{erts-mode-map}"
(setq-local font-lock-defaults '(erts-mode-font-lock-keywords t)))
+(defun erts-tag-region (start end name)
+ "Tag the region between START and END as a test.
+Interactively, this is the region.
+
+NAME should be a string appropriate for output by ert if the test fails.
+If NAME is nil or the empty string, a name will be auto-generated."
+ (interactive "r\nsTest name: ")
+ ;; Automatically make a name.
+ (when (zerop (length name))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((names nil))
+ (while (re-search-forward "^Name:[ \t]*\\(.*\\)" nil t)
+ (let ((name (match-string 1)))
+ (unless (erts-mode--in-test-p (point))
+ (push name names))))
+ (setq name
+ (cl-loop with base = (file-name-sans-extension (buffer-name))
+ for i from 1
+ for name = (format "%s%d" base i)
+ unless (member name names)
+ return name)))))
+ (save-excursion
+ (goto-char end)
+ (unless (bolp)
+ (insert "\n"))
+ (insert "=-=-=\n")
+ (goto-char start)
+ (insert "Name: " name "\n\n")
+ (insert "=-=\n")))
+
(provide 'erts-mode)
;;; erts-mode.el ends here