From 5ea2dd8722430d257c5e50b49bac0c8af344b58a Mon Sep 17 00:00:00 2001
From: dickmao <dick.r.chiang@gmail.com>
Date: Thu, 30 Jun 2022 16:54:57 -0400
Subject: [PATCH] Round up to nonempty line gnus server mode

* doc/lispref/text.texi (Property Search): Typo.
* lisp/gnus/gnus-srvr.el (gnus-server--server-name,
gnus-server-server-name, gnus-server-named-server):
Round up to nearest nonempty line.
* test/lisp/gnus/gnus-tests.el (gnus-test-basic-op,
gnus-test-server-at-eob): Test it.
---
 doc/lispref/text.texi        |  2 +-
 lisp/gnus/gnus-srvr.el       | 15 +++++--
 test/lisp/gnus/gnus-tests.el | 78 ++++++++++++++++++++++++++++++++++--
 3 files changed, 87 insertions(+), 8 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 622f03d2a85..0c04d01261b 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -3485,7 +3485,7 @@ Property Search
 @end defun
 
 @defun text-property-search-backward prop &optional value predicate not-current
-This is just like @code{text-property-search-backward}, but searches
+This is just like @code{text-property-search-forward}, but searches
 backward instead.  Point is placed at the beginning of the matched
 region instead of the end, though.
 @end defun
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index a520bfcd8b1..9600503645a 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -338,15 +338,22 @@ gnus-server-prepare
   (goto-char (point-min))
   (gnus-server-position-point))
 
+(defsubst gnus-server--server-name (which)
+  (when-let ((server
+              (save-excursion
+                (let (prop)
+                  (while (and (null (setq prop (get-text-property (point-at-bol) which)))
+                              (zerop (forward-line -1))))
+                  prop))))
+    (symbol-name server)))
+
 (defun gnus-server-server-name ()
-  (let ((server (get-text-property (point-at-bol) 'gnus-server)))
-    (and server (symbol-name server))))
+  (gnus-server--server-name 'gnus-server))
 
 (defun gnus-server-named-server ()
   "Return a server name that matches one of the names returned by
 `gnus-method-to-server'."
-  (let ((server (get-text-property (point-at-bol) 'gnus-named-server)))
-    (and server (symbol-name server))))
+  (gnus-server--server-name 'gnus-named-server))
 
 (defalias 'gnus-server-position-point 'gnus-goto-colon)
 
diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/gnus/gnus-tests.el
index 4c5a6a8191c..11f06b50d41 100644
--- a/test/lisp/gnus/gnus-tests.el
+++ b/test/lisp/gnus/gnus-tests.el
@@ -25,9 +25,81 @@
 ;; tests that are not standalone.
 
 ;;; Code:
-;; registry.el is required by gnus-registry.el but this way we're explicit.
-(require 'registry)
-(require 'gnus-registry)
+(require 'cl-macs)
+(require 'message)
+(require 'gnus)
+(require 'gnus-start)
+(require 'gnus-group)
+(require 'nsm)
+
+(defconst gnus-tests-load-file-name (or load-file-name
+                                        (buffer-file-name)))
+
+(defmacro gnus-tests-let-customs (bindings &rest forms)
+  (declare (indent defun))
+  `(progn
+     (funcall #'custom-set-variables
+              ,@(mapcar (apply-partially #'list 'quote) bindings))
+     ,@forms))
+
+(cl-defmacro gnus-tests-doit (&rest
+                              body
+                              &key
+                              (select-method)
+                              (customs)
+                              &allow-other-keys
+                              &aux
+                              (body
+                               (cl-loop until (not (keywordp (car body)))
+                                        do (setq body (nthcdr 2 body))
+                                        finally return body)))
+  (declare (indent defun))
+  `(let* ((parent-dir (file-name-directory gnus-tests-load-file-name))
+          (default-directory (file-name-as-directory (concat parent-dir "gnus-tests")))
+	  (user-emacs-directory default-directory))
+     (unless (file-exists-p default-directory)
+       (make-directory default-directory))
+     (gnus-tests-let-customs
+       ((gnus-verbose 8)
+        (gnus-home-directory default-directory)
+        (gnus-use-dribble-file nil)
+        (network-security-level (quote low))
+        (gnus-interactive-exit (quote quiet))
+        ,@(when select-method (list `(gnus-select-method ',select-method)))
+        (message-directory (concat gnus-home-directory "Mail"))
+        (mail-source-directory (concat gnus-home-directory "Mail"))
+        (mail-source-crash-box (concat gnus-home-directory ".whatev"))
+        (gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc.eld"))
+        (gnus-init-file (nnheader-concat gnus-home-directory ".gnus"))
+        (gnus-directory (nnheader-concat gnus-home-directory "News/"))
+        ,@customs)
+       (unwind-protect
+           (progn ,@body)
+         (cl-macrolet ((safe-delete
+                         (x)
+                         `(if (cl-search "gnus-tests/" ,x)
+                              (delete-directory ,x t)
+                            (error "Attempted delete of %s!" ,x))))
+           (safe-delete gnus-home-directory))))))
+
+(ert-deftest gnus-test-basic-op ()
+  (gnus-tests-doit :select-method (nnfolder "")
+    (call-interactively #'gnus)
+    (call-interactively #'gnus-group-exit)))
+
+(ert-deftest gnus-test-server-at-eob ()
+  "`gnus-server-read-server' looks to nearest nonempty line."
+  (gnus-tests-doit :select-method (nnfolder "")
+    (call-interactively #'gnus)
+    (call-interactively #'gnus-group-enter-server-mode)
+    (with-current-buffer gnus-server-buffer
+      (should-error (search-forward "foobar"))
+      (search-forward "nnfolder")
+      (goto-char (point-max))
+      (should (gnus-server-server-name))
+      (goto-char (point-min))
+      (should (gnus-server-server-name)))
+    (call-interactively #'gnus-group-exit)))
 
 (provide 'gnus-tests)
 ;;; gnus-tests.el ends here
-- 
2.36.1