Merge remote-tracking branch 'origin/master' into feature/android

7 files changed, 304 insertions, 108 deletions

diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 35e867a3508..4effaa981ec 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9081,8 +9081,8 @@ is non-numeric or nil fetch the number specified by the
              (cl-merge 'list gnus-newsgroup-headers new-headers
                        'gnus-article-sort-by-number)))
       (setq gnus-newsgroup-articles
-            (gnus-sorted-nunion gnus-newsgroup-articles article-ids))
-      (gnus-summary-limit-include-thread id gnus-refer-thread-limit-to-thread)))
+            (gnus-sorted-nunion gnus-newsgroup-articles article-ids)))
+    (gnus-summary-limit-include-thread id gnus-refer-thread-limit-to-thread))
   (gnus-summary-show-thread))
 
 (defun gnus-summary-open-group-with-article (message-id)
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 7ad33fa3786..fe0c986d746 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -1935,10 +1935,9 @@ Use `eglot-managed-p' to determine if current buffer is managed.")
   "Return logical Eglot server for current buffer, nil if none."
   (setq eglot--cached-server
         (or eglot--cached-server
-            (cl-find major-mode
-                     (gethash (eglot--current-project) eglot--servers-by-project)
-                     :key #'eglot--major-modes
-                     :test #'memq)
+            (cl-find-if #'eglot--languageId
+                        (gethash (eglot--current-project)
+                                 eglot--servers-by-project))
             (and eglot-extend-to-xref
                  buffer-file-name
                  (gethash (expand-file-name buffer-file-name)
@@ -2360,12 +2359,20 @@ THINGS are either registrations or unregisterations (sic)."
   (append (eglot--TextDocumentIdentifier)
           `(:version ,eglot--versioned-identifier)))
 
+(cl-defun eglot--languageId (&optional (server (eglot--current-server-or-lose)))
+  "Compute LSP \\='languageId\\=' string for current buffer.
+Doubles as an predicate telling if SERVER can manage current
+buffer."
+  (cl-loop for (mode . languageid) in
+           (eglot--languages server)
+           when (provided-mode-derived-p major-mode mode)
+           return languageid))
+
 (defun eglot--TextDocumentItem ()
   "Compute TextDocumentItem object for current buffer."
   (append
    (eglot--VersionedTextDocumentIdentifier)
-   (list :languageId
-         (alist-get major-mode (eglot--languages (eglot--current-server-or-lose)))
+   (list :languageId (eglot--languageId)
          :text
          (eglot--widening
           (buffer-substring-no-properties (point-min) (point-max))))))
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index b744a717c5c..f03b9ab56a0 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -447,25 +447,25 @@ verify FILTER, a function, and sort them by COMPARE (using KEY)."
   :package-version '(Flymake . "1.3.4"))
 
 (defface flymake-end-of-line-diagnostics-face
-  '((t :height 0.7 :box (:line-width 1)))
+  '((t :height 0.85 :box (:line-width -1)))
   "Face used for end-of-line diagnostics.
 See variable `flymake-show-diagnostics-at-end-of-line'."
-  :package-version '("Flymake" . "1.3.5"))
+  :package-version '(Flymake . "1.3.5"))
 
 (defface flymake-error-echo-at-eol
   '((t :inherit (flymake-end-of-line-diagnostics-face compilation-error)))
   "Face like `flymake-error-echo', but for end-of-line overlays."
-  :package-version '("Flymake" . "1.3.5"))
+  :package-version '(Flymake . "1.3.5"))
 
 (defface flymake-warning-echo-at-eol
   '((t :inherit (flymake-end-of-line-diagnostics-face compilation-warning)))
   "Face like `flymake-warning-echo', but for end-of-line overlays."
-  :package-version '("Flymake" . "1.3.5"))
+  :package-version '(Flymake . "1.3.5"))
 
 (defface flymake-note-echo-at-eol
   '((t :inherit (flymake-end-of-line-diagnostics-face flymake-note)))
   "Face like `flymake-note-echo', but for end-of-line overlays."
-  :package-version '("Flymake" . "1.3.5"))
+  :package-version '(Flymake . "1.3.5"))
 
 (defcustom flymake-show-diagnostics-at-end-of-line nil
   "If non-nil, add diagnostic summary messages at end-of-line."
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index ac6fd382a46..9199119b602 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -356,7 +356,9 @@ wherever possible, since it is slow."
 (eval-and-compile
   ;; Both xemacs and emacs
   (condition-case nil
-      (require 'diff)  ; diff-command and diff-switches
+      ;; `diff-command' and `diff-switches',
+      ;; although XEmacs lacks the former.
+      (require 'diff)
     (error nil))
   (condition-case nil
       (require 'compile)  ; compilation-error-regexp-alist-alist
@@ -11883,31 +11885,33 @@ If optional REGEXP, ignore differences matching it."
 This requires the external program `diff-command' to be in your `exec-path',
 and uses `diff-switches' in which you may want to have \"-u\" flag.
 Ignores WHITESPACE if t, and writes output to stdout if SHOW."
-  ;; Similar to `diff-buffer-with-file' but works on XEmacs, and doesn't
-  ;; call `diff' as `diff' has different calling semantics on different
-  ;; versions of Emacs.
+  ;; Similar to `diff-buffer-with-file' but works on Emacs 21, and
+  ;; doesn't call `diff' as `diff' has different calling semantics on
+  ;; different versions of Emacs.
   (if (not (file-exists-p f1))
-      (message "Buffer `%s' has no associated file on disk" (buffer-name b2))
-    (with-temp-buffer "*Verilog-Diff*"
-                      (let ((outbuf (current-buffer))
-                            (f2 (make-temp-file "vm-diff-auto-")))
-                        (unwind-protect
-                            (progn
-                              (with-current-buffer b2
-                                (save-restriction
-                                  (widen)
-                                  (write-region (point-min) (point-max) f2 nil 'nomessage)))
-                              (call-process diff-command nil outbuf t
-                                            diff-switches  ; User may want -u in diff-switches
-                                            (if whitespace "-b" "")
-                                            f1 f2)
-                              ;; Print out results.  Alternatively we could have call-processed
-                              ;; ourself, but this way we can reuse diff switches
-                              (when show
-                                (with-current-buffer outbuf (message "%s" (buffer-string))))))
-                        (sit-for 0)
-                        (when (file-exists-p f2)
-                          (delete-file f2))))))
+      (message "Buffer `%s' has no associated file on disk" b2)
+    (let ((outbuf (get-buffer "*Verilog-Diff*"))
+          (f2 (make-temp-file "vm-diff-auto-")))
+      (unwind-protect
+          ;; User may want -u in `diff-switches'.
+          (let ((args `(,@(if (listp diff-switches)
+                              diff-switches
+                            (list diff-switches))
+                        ,@(and whitespace '("-b"))
+                        ,f1 ,f2)))
+            (with-current-buffer b2
+              (save-restriction
+                (widen)
+                (write-region (point-min) (point-max) f2 nil 'nomessage)))
+            (apply #'call-process diff-command nil outbuf t args)
+            ;; Print out results.  Alternatively we could have call-processed
+            ;; ourself, but this way we can reuse diff switches.
+            (when show
+              (with-current-buffer outbuf (message "%s" (buffer-string)))))
+        (sit-for 0)
+        (condition-case nil
+            (delete-file f2)
+          (error nil))))))
 
 (defun verilog-diff-report (b1 b2 diffpt)
   "Report differences detected with `verilog-diff-auto'.
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 6e0246ea762..c6056c1e5bd 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -26,6 +26,7 @@
 
 (require 'vc-rcs)
 (eval-when-compile (require 'vc))
+(eval-when-compile (require 'cl-lib))
 (require 'log-view)
 
 (declare-function vc-checkout "vc" (file &optional rev))
@@ -813,7 +814,10 @@ individually should stay local."
                             'yes 'no))))))))))))
 
 (defun vc-cvs-repository-hostname (dirname)
-  "Hostname of the CVS server associated to workarea DIRNAME."
+  "Hostname of the CVS server associated to workarea DIRNAME.
+
+Returns nil if there is not hostname or the hostname could not be
+determined because the CVS/Root specification is invalid."
   (let ((rootname (expand-file-name "CVS/Root" dirname)))
     (when (file-readable-p rootname)
       (with-temp-buffer
@@ -822,73 +826,143 @@ individually should stay local."
                    default-file-name-coding-system)))
           (vc-insert-file rootname))
         (goto-char (point-min))
-        (nth 2 (vc-cvs-parse-root
-                (buffer-substring (point)
-                                  (line-end-position))))))))
-
-(defun vc-cvs-parse-uhp (path)
-  "Parse user@host/path into (user@host /path)."
-  (if (string-match "\\([^/]+\\)\\(/.*\\)" path)
-      (list (match-string 1 path) (match-string 2 path))
-      (list nil path)))
-
-(defun vc-cvs-parse-root (root)
-  "Split CVS ROOT specification string into a list of fields.
-A CVS root specification of the form
-  [:METHOD:][[USER@]HOSTNAME]:?/path/to/repository
+        (let ((hostname
+               (nth 2 (vc-cvs-parse-root
+                       (buffer-substring (point)
+                                         (line-end-position))))))
+          (unless (string= hostname "")
+            hostname))))))
+
+(cl-defun vc-cvs-parse-root (root)
+  "Split CVS Root specification string into a list of fields.
+
+A CVS Root specification of the form
+  [:METHOD:][[[USER][:PASSWORD]@]HOSTNAME][:[PORT]]/pathname/to/repository
 is converted to a normalized record with the following structure:
-  \(METHOD USER HOSTNAME CVS-ROOT).
+  \(METHOD USER HOSTNAME PATHNAME).
+
 The default METHOD for a CVS root of the form
-  /path/to/repository
-is `local'.
+  /pathname/to/repository
+is \"local\".
 The default METHOD for a CVS root of the form
-  [USER@]HOSTNAME:/path/to/repository
-is `ext'.
-For an empty string, nil is returned (invalid CVS root)."
-  ;; Split CVS root into colon separated fields (0-4).
-  ;; The `x:' makes sure, that leading colons are not lost;
-  ;; `HOST:/PATH' is then different from `:METHOD:/PATH'.
-  (let* ((root-list (cdr (split-string (concat "x:" root) ":")))
-         (len (length root-list))
-         ;; All syntactic varieties will get a proper METHOD.
-         (root-list
-          (cond
-           ((= len 0)
-            ;; Invalid CVS root
-            nil)
-           ((= len 1)
-            (let ((uhp (vc-cvs-parse-uhp (car root-list))))
-              (cons (if (car uhp) "ext" "local") uhp)))
-           ((= len 2)
-            ;; [USER@]HOST:PATH => method `ext'
-            (and (not (equal (car root-list) ""))
-                 (cons "ext" root-list)))
-           ((= len 3)
-            ;; :METHOD:PATH or :METHOD:USER@HOSTNAME/PATH
-            (cons (cadr root-list)
-                  (vc-cvs-parse-uhp (nth 2 root-list))))
-           (t
-            ;; :METHOD:[USER@]HOST:PATH
-            (cdr root-list)))))
-    (if root-list
-        (let ((method (car root-list))
-              (uhost (or (cadr root-list) ""))
-              (root (nth 2 root-list))
-              user host)
-          ;; Split USER@HOST
-          (if (string-match "\\(.*\\)@\\(.*\\)" uhost)
-              (setq user (match-string 1 uhost)
-                    host (match-string 2 uhost))
-            (setq host uhost))
-          ;; Remove empty HOST
-          (and (equal host "")
-               (setq host nil))
-          ;; Fix windows style CVS root `:local:C:\\project\\cvs\\some\\dir'
-          (and host
-               (equal method "local")
-               (setq root (concat host ":" root) host nil))
-          ;; Normalize CVS root record
-          (list method user host root)))))
+  [USER@]HOSTNAME:/pathname/to/repository
+is \"ext\".
+
+If METHOD is explicitly \"local\" or \"fork\", then the pathname
+starts immediately after the method block. This must be used on
+Windows platforms when pathnames start with a drive letter.
+
+Note that, except for METHOD, which is defaulted if not present,
+other optional fields are returned as nil if not syntactically
+present, or as the empty string if delimited but empty.
+
+Returns nil in case of an unparsable CVS root (including the
+empty string) and issues a warning. This function doesn't check
+that an explicit method is valid, or that some fields are empty
+or nil but should not for a given method."
+  (let (method user password hostname port pathname
+               ;; IDX set by `next-delim' as a side-effect
+               idx)
+    (cl-labels
+        ((invalid (reason &rest args)
+           (apply #'lwarn '(vc-cvs) :warning
+                  (concat "vc-cvs-parse-root: Can't parse '%s': " reason)
+                  root args)
+           (cl-return-from vc-cvs-parse-root))
+         (no-pathname ()
+           (invalid "No pathname"))
+         (next-delim (start)
+           ;; Search for a :, @ or /. If none is found, there can be
+           ;; no path at the end, which is an error.
+           (setq idx (string-match-p "[:@/]" root start))
+           (if idx (aref root idx) (no-pathname)))
+         (grab-user (start end)
+           (setq user (substring root start end)))
+         (at-hostname-block (start)
+           (let ((cand (next-delim start)))
+             (cl-ecase cand
+               (?:
+                ;; Could be : before PORT and PATHNAME, or before
+                ;; PASSWORD. We search for a @ to disambiguate.
+                (let ((colon-idx idx)
+                      (cand (next-delim (1+ idx))))
+                  (cl-ecase cand
+                    (?:
+                     (invalid
+                      (eval-when-compile
+                        (concat "Hostname block: Superfluous : at %s "
+                                "or missing @ before"))
+                      idx))
+                    (?@
+                     ;; USER:PASSWORD case
+                     (grab-user start colon-idx)
+                     (delimited-password (1+ colon-idx) idx))
+                    (?/
+                     ;; HOSTNAME[:[PORT]] case
+                     (grab-hostname start colon-idx)
+                     (delimited-port (1+ colon-idx) idx)))))
+               (?@
+                (grab-user start idx)
+                (at-hostname (1+ idx)))
+               (?/
+                (if (/= idx start)
+                    (grab-hostname start idx))
+                (at-pathname idx)))))
+         (delimited-password (start end)
+           (setq password (substring root start end))
+           (at-hostname (1+ end)))
+         (grab-hostname (start end)
+           (setq hostname (substring root start end)))
+         (at-hostname (start)
+           (let ((cand (next-delim start)))
+             (cl-ecase cand
+               (?:
+                (grab-hostname start idx)
+                (at-port (1+ idx)))
+               (?@
+                (invalid "Hostname: Unexpected @ after index %s" start))
+               (?/
+                (grab-hostname start idx)
+                (at-pathname idx)))))
+         (delimited-port (start end)
+           (setq port (substring root start end))
+           (at-pathname end))
+         (at-port (start)
+           (let ((end (string-match-p "/" root start)))
+             (if end (delimited-port start end) (no-pathname))))
+         (at-pathname (start)
+           (setq pathname (substring root start))))
+      (when (string= root "")
+        (invalid "Empty string"))
+      ;; Check for a starting ":"
+      (if (= (aref root 0) ?:)
+          ;; 3 possible cases:
+          ;; - :METHOD: at start. METHOD doesn't have any @.
+          ;; - :PASSWORD@ at start. Must be followed by HOSTNAME.
+          ;; - :[PORT] at start. Must be followed immediately by a "/".
+          ;; So, find the next character equal to ":", "@" or "/".
+          (let ((cand (next-delim 1)))
+            (cl-ecase cand
+              (?:
+               ;; :METHOD: case
+               (setq method (substring root 1 idx))
+               ;; Continue
+               (if (member method '("local" "fork"))
+                   (at-pathname (1+ idx))
+                 (at-hostname-block (1+ idx))))
+              (?@
+               ;; :PASSWORD@HOSTNAME case
+               (delimited-password 1 idx))
+              (?/
+               ;; :[PORT] case.
+               (at-port 1 idx))))
+        ;; No starting ":", there can't be any METHOD.
+        (at-hostname-block 0)))
+    (unless method
+      ;; Default the method if not specified
+      (setq method
+            (if (or user password hostname port) "ext" "local")))
+    (list method user hostname pathname)))
 
 ;; XXX: This does not work correctly for subdirectories.  "cvs status"
 ;; information is context sensitive, it contains lines like:
@@ -955,13 +1029,16 @@ state."
                       (cdr (assoc (char-after) translation)))
                 result)
         (cond
-         ((looking-at "cvs update: warning: \\(.*\\) was lost")
+         ((looking-at "cvs update: warning: .* was lost")
           ;; Format is:
           ;; cvs update: warning: FILENAME was lost
           ;; U FILENAME
-          (push (list (match-string 1) 'missing) result)
-          ;; Skip the "U" line
-          (forward-line 1))
+          ;; with FILENAME in the first line possibly enclosed in
+          ;; quotes (since CVS 1.12.3). To avoid problems, use the U
+          ;; line where name is never quoted.
+          (forward-line 1)
+          (when (looking-at "^U \\(.*\\)$")
+            (push (list (match-string 1) 'missing) result)))
          ((looking-at "cvs update: New directory `\\(.*\\)' -- ignored")
           (push (list (match-string 1) 'unregistered) result))))
       (forward-line 1))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 32b0d5d7556..91d3f6f70d3 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3604,7 +3604,8 @@ to provide the `find-revision' operation instead."
           (file-buffer (or (get-file-buffer file) (current-buffer))))
       (message "Checking out %s..." file)
       (let ((failed t)
-            (backup-name (car (find-backup-file-name file))))
+            (backup-name (when (file-exists-p file)
+                           (car (find-backup-file-name file)))))
         (when backup-name
           (copy-file file backup-name 'ok-if-already-exists 'keep-date)
           (unless (file-writable-p file)
diff --git a/test/lisp/vc/vc-cvs-tests.el b/test/lisp/vc/vc-cvs-tests.el
new file mode 100644
index 00000000000..99ac9c8eb96
--- /dev/null
+++ b/test/lisp/vc/vc-cvs-tests.el
@@ -0,0 +1,107 @@
+;;; vc-cvs-tests.el --- tests for vc/vc-cvs.el  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Olivier Certner <olce.emacs@certner.fr>
+;; Maintainer: emacs-devel@gnu.org
+
+;; 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:
+
+;;; Code:
+
+(require 'vc-cvs)
+
+(ert-deftest vc-cvs-test-parse-root--local-no-method ()
+  (vc-cvs-test--check-parse-root
+   "/home/joe/repo"
+   '("local" nil nil "/home/joe/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--local-windows-drive-letter ()
+  (vc-cvs-test--check-parse-root
+   ":local:c:/users/joe/repo"
+   '("local" nil nil "c:/users/joe/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--ext-no-method-host-no-port-colon ()
+  (vc-cvs-test--check-parse-root
+   "host/home/serv/repo"
+   '("ext" nil "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-host-no-port-colon ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:host/home/serv/repo"
+   '("pserver" nil "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-host-port-colon ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:host:/home/serv/repo"
+   '("pserver" nil "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--ext-no-method-user-host-no-port-colon ()
+  (vc-cvs-test--check-parse-root
+   "usr@host/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--ext-no-method-user-host-port-colon ()
+  (vc-cvs-test--check-parse-root
+   "usr@host:/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-user-password-host-no-port-colon ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:usr:passwd@host/home/serv/repo"
+   '("pserver" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-user-password-host-port-colon ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:usr:passwd@host:/home/serv/repo"
+   '("pserver" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest vc-cvs-test-parse-root--pserver-user-password-host-port ()
+  (vc-cvs-test--check-parse-root
+   ":pserver:usr:passwd@host:28/home/serv/repo"
+   '("pserver" "usr" "host" "/home/serv/repo")))
+
+;; Next 3 tests are just to err on the side of caution. It doesn't
+;; seem that CVS 1.12 can ever produce such lines.
+
+(ert-deftest
+    vc-cvs-test-parse-root--ext-no-method-user-password-host-no-port-colon
+    ()
+  (vc-cvs-test--check-parse-root
+   "usr:passwd@host/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest
+    vc-cvs-test-parse-root--ext-no-method-user-password-host-port-colon
+    ()
+  (vc-cvs-test--check-parse-root
+   "usr:passwd@host:/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+(ert-deftest
+    vc-cvs-test-parse-root--ext-no-method-user-password-host-port
+    ()
+  (vc-cvs-test--check-parse-root
+   "usr:passwd@host:28/home/serv/repo"
+   '("ext" "usr" "host" "/home/serv/repo")))
+
+
+(defun vc-cvs-test--check-parse-root (input expected-output)
+  (should (equal (vc-cvs-parse-root input) expected-output)))
+
+;;; vc-cvs-tests.el ends here