[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android 5b314731894: Merge remote-tracking branch 'origin/master
|
From: |
Po Lu |
|
Subject: |
feature/android 5b314731894: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Tue, 18 Apr 2023 21:15:16 -0400 (EDT) |
branch: feature/android
commit 5b314731894f09bb71fd02c76add45263e2d4f77
Merge: 55388c288a0 9a2c723f1bc
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
lisp/gnus/gnus-sum.el | 4 +-
lisp/progmodes/eglot.el | 19 ++--
lisp/progmodes/flymake.el | 10 +-
lisp/progmodes/verilog-mode.el | 54 ++++++-----
lisp/vc/vc-cvs.el | 215 ++++++++++++++++++++++++++++-------------
lisp/vc/vc.el | 3 +-
test/lisp/vc/vc-cvs-tests.el | 107 ++++++++++++++++++++
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