mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-24 05:22:04 -08:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master'

Browse source
This commit is contained in:
Dmitry Gutov 2025-12-19 02:52:29 +02:00
commit 976e3d3d51
8 changed files with 105 additions and 105 deletions
Download patch file Download diff file Expand all files Collapse all files

5
doc/emacs/maintaining.texi
View file

@ -1707,9 +1707,8 @@ Branches}.
@item d
Delete the marked files, or the current file if no marks
(@code{vc-dir-clean-delete)}. The files will not be marked as
deleted in the version control system, so this function is mostly
useful for unregistered files.
(@code{vc-dir-delete-file)}. If the files are registered, they will be
marked as deleted in the version control system.
@end table
@cindex stashes in version control

2
doc/lispref/control.texi
View file

@ -1611,7 +1611,7 @@ Matches a vector if the @var{eltpats} match its elements. The first
Matches @var{pattern} with strict checking of @code{cdr}s. That means
that @code{list} patterns verify that the final @code{cdr} is
@code{nil}. Strict checking is the default.
@item (cdr-safe @var{pattern})
@item (cdr-ignore @var{pattern})
Matches @var{pattern} with lax checking of @code{cdr}s. That means that
@code{list} patterns do not examine the final @code{cdr}.
@item (and @var{conjuncts}@dots{})

7
etc/NEWS
View file

@ -2501,6 +2501,13 @@ Previously, Emacs would simply refuse to make any changes.
You can customize 'vc-dir-allow-mass-mark-changes' to restore the old
behavior or dispense with the prompting.
+++
*** 'C-x v x' and VC Directory's 'd' command can now delete unregistered files.
Previously, these commands could only delete registered files.
To restore the old, more limited behavior for VC Directory, you can do
(keymap-set vc-dir-mode-map "d" #'vc-dir-clean-files)
---
*** New VC Directory bindings 'z d' and 'D' to delete Git stashes.
These correspond to the existing 'z p' to pop a stash and 'P' to pop the

2
lisp/emacs-lisp/cond-star.el
View file

@ -134,7 +134,7 @@ ATOM (meaning any other kind of non-list not described above)
\(cdr PATTERN) matches PATTERN with strict checking of cdrs.
That means that `list' patterns verify that the final cdr is nil.
Strict checking is the default.
\(cdr-safe PATTERN) matches PATTERN with lax checking of cdrs.
\(cdr-ignore PATTERN) matches PATTERN with lax checking of cdrs.
That means that `list' patterns do not examine the final cdr.
\(and CONJUNCTS...) matches each of the CONJUNCTS against the same data.
If all of them match, this pattern succeeds.

134
lisp/progmodes/eglot.el
View file

@ -4320,73 +4320,61 @@ at point. With prefix argument, prompt for ACTION-KIND."
(defvar eglot-watch-files-outside-project-root t
"If non-nil, allow watching files outside project root")
(defun eglot--list-directories (dir)
(with-temp-buffer
(condition-case oops
(call-process find-program nil t nil dir "-type" "d" "-print0")
(error
(eglot--warn "Can't list directories in %s: %s" dir oops)))
(cl-loop initially (goto-char (point-min))
for start = (point) while (search-forward "\0" nil t)
collect (expand-file-name
(buffer-substring-no-properties start (1- (point)))
dir))))
(defun eglot--watch-globs (server id globs &optional base-path)
"Set up file watching for files matching GLOBS under BASE-PATH.
GLOBS is a list of (COMPILED-GLOB . KIND) pairs, where COMPILED-GLOB
is a compiled glob predicate and KIND is a bitmask of change types.
BASE-PATH is the directory to watch (nil means entire project).
Returns success status for SERVER and registration ID."
(let* ((project (eglot--project server))
(root (project-root project))
(dirs (if (and base-path
(not (file-in-directory-p base-path root)))
;; Outside root, use faster find-based listing
(eglot--list-directories base-path)
;; Inside project or entire project: use project-files
;; which respects ignores
(delete-dups
(mapcar #'file-name-directory
(project-files project (and base-path
(list base-path)))))))
(success nil))
(cl-labels
((handle-event (event)
(pcase-let* ((`(,desc ,action ,file ,file1) event)
(action-type (cl-case action
(created 1) (changed 2) (deleted 3)))
(action-bit (when action-type
(ash 1 (1- action-type))))
(candidate (if base-path
(file-relative-name file base-path)
file)))
(cond
((and (memq action '(created changed deleted))
(cl-loop for (compiled . kind) in globs
thereis (and (> (logand kind action-bit) 0)
(funcall compiled candidate))))
(jsonrpc-notify
server :workspace/didChangeWatchedFiles
`(:changes ,(vector `(:uri ,(eglot-path-to-uri file)
:type ,action-type))))
(when (and (eq action 'created)
(file-directory-p file))
(add-watch file)))
((eq action 'renamed)
(handle-event `(,desc deleted ,file))
(handle-event `(,desc created ,file1))))))
(add-watch (dir)
(when (file-readable-p dir)
(push (file-notify-add-watch dir '(change) #'handle-event)
(gethash id (eglot--file-watches server))))))
(cl-defun eglot--watch-globs (server id globs dir in-root
&aux (project (eglot--project server))
success)
"Set up file watching for relative file names matching GLOBS under DIR.
GLOBS is a list of (COMPILED-GLOB . KIND) pairs, where COMPILED-GLOB is
a compiled glob predicate and KIND is a bitmask of change types. DIR is
the directory to watch (nil means entire project). IN-ROOT says if DIR
happens to be inside or maching the project root."
(cl-labels
((subdirs-using-project ()
(delete-dups
(mapcar #'file-name-directory
(project-files project (and dir (list dir))))))
(subdirs-using-find ()
(with-temp-buffer
(call-process find-program nil t nil dir "-type" "d" "-print0")
(cl-loop initially (goto-char (point-min))
for start = (point) while (search-forward "\0" nil t)
collect (expand-file-name
(buffer-substring-no-properties start (1- (point)))
dir))))
(handle-event (event)
(pcase-let* ((`(,desc ,action ,file ,file1) event)
(action-type (cl-case action
(created 1) (changed 2) (deleted 3)))
(action-bit (when action-type
(ash 1 (1- action-type))))
(candidate (if dir (file-relative-name file dir) file)))
(cond
((and (memq action '(created changed deleted))
(cl-loop for (compiled . kind) in globs
thereis (and (> (logand kind action-bit) 0)
(funcall compiled candidate))))
(jsonrpc-notify
server :workspace/didChangeWatchedFiles
`(:changes ,(vector `(:uri ,(eglot-path-to-uri file)
:type ,action-type))))
(when (and (eq action 'created)
(file-directory-p file))
(add-watch file)))
((eq action 'renamed)
(handle-event `(,desc deleted ,file))
(handle-event `(,desc created ,file1))))))
(add-watch (subdir)
(when (file-readable-p subdir)
(push (file-notify-add-watch subdir '(change) #'handle-event)
(gethash id (eglot--file-watches server))))))
(let ((subdirs (if (or (null dir) in-root)
(subdirs-using-project)
(condition-case _ (subdirs-using-find)
(error (subdirs-using-project))))))
(unwind-protect
(dolist (d dirs)
(add-watch d)
(setq success t))
(cl-loop for sd in subdirs do (add-watch sd) finally (setq success t))
(unless success
(eglot-unregister-capability server 'workspace/didChangeWatchedFiles id))))
success))
(eglot-unregister-capability server 'workspace/didChangeWatchedFiles id))))))
(cl-defmethod eglot-register-capability
(server (method (eql workspace/didChangeWatchedFiles)) id &key watchers
@ -4407,21 +4395,23 @@ Returns success status for SERVER and registration ID."
(when base-uri
(if (stringp base-uri)
(eglot-uri-to-path base-uri)
(eglot-uri-to-path (plist-get base-uri :uri))))))
(eglot-uri-to-path (plist-get base-uri :uri)))))
(in-root (or (null base-path)
(file-in-directory-p base-path root))))
(when (or eglot-watch-files-outside-project-root
(null base-path)
(file-in-directory-p base-path root))
in-root)
(push (cons (eglot--glob-compile pat t t)
;; the default "7" means bitwise OR of
;; WatchKind.Create (1), WatchKind.Change
;; (2), WatchKind.Delete (4)
(or kind 7))
(gethash base-path groups)))))
(gethash (cons base-path in-root) groups)))))
watchers)
;; For each group, set up watches
(maphash
(lambda (base-path globs)
(eglot--watch-globs server id globs base-path))
(eglot--watch-globs server id globs (car base-path) (cdr base-path)))
groups)))
(cl-defmethod eglot-unregister-capability
@ -4688,7 +4678,7 @@ If NOERROR, return predicate, else erroring function."
;;; Semantic tokens
(defmacro eglot--semtok-define-things ()
(cl-flet ((def-it (name def)
`(defface ,(intern (format "eglot-semantic-%s-face" name))
`(defface ,(intern (format "eglot-semantic-%s" name))
'((t (:inherit ,def)))
,(format "Face for painting a `%s' LSP semantic token" name)
:group 'eglot-semantic-fontification)))
@ -4726,10 +4716,10 @@ If NOERROR, return predicate, else erroring function."
when (cl-plusp (logand (cdr tok) (ash 1 j)))
collect m into names
and when (member m eglot-semantic-token-modifiers)
collect (intern (format "eglot-semantic-%s-face" m)) into faces
collect (intern (format "eglot-semantic-%s" m)) into faces
finally
(when (member tname eglot-semantic-token-types)
(push (intern (format "eglot-semantic-%s-face" tname)) faces))
(push (intern (format "eglot-semantic-%s" tname)) faces))
(cl-return (cons (cons tname names) faces))))
semtok-cache)
probe))))

11
lisp/vc/vc-dir.el
View file

@ -279,8 +279,8 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and
'(menu-item "Open File" vc-dir-find-file
:help "Find the file on the current line"))
(define-key map [delete]
'(menu-item "Delete" vc-dir-clean-files
:help "Delete the unregistered marked files"))
'(menu-item "Delete" vc-dir-delete-files
:help "Delete marked files"))
(define-key map [sepvcdet] '("--"))
;; FIXME: This needs a key binding. And maybe a better name
;; ("Insert" like PCL-CVS uses does not sound that great either)...
@ -318,8 +318,6 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and
'(menu-item "Revert to Base Version" vc-revert
:help "Revert working copies of the selected fileset to their repository contents."))
(define-key map [next-action]
;; FIXME: This really really really needs a better name!
;; And a key binding too.
'(menu-item "Check In/Out" vc-next-action
:help "Do the next logical version control operation on the current fileset"))
(define-key map [register]
@ -364,7 +362,7 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and
;; bound by `special-mode'.
;; Marking.
(define-key map "m" #'vc-dir-mark)
(define-key map "d" #'vc-dir-clean-files)
(define-key map "d" #'vc-dir-delete-file)
(define-key map "M" #'vc-dir-mark-all-files)
(define-key map "u" #'vc-dir-unmark)
(define-key map "U" #'vc-dir-unmark-all-files)
@ -1030,8 +1028,7 @@ tracked by a VCS."
The files will also be marked as deleted in the version control
system."
(interactive)
(mapc #'vc-delete-file (or (vc-dir-marked-files)
(list (vc-dir-current-file)))))
(vc-delete-file (or (vc-dir-marked-files) (vc-dir-current-file))))
(defun vc-dir-find-file ()
"Find the file on the current line."

2
lisp/vc/vc-git.el
View file

@ -1891,7 +1891,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
;; but since Git is one of the two backends that support this operation
;; so far, it's hard to tell; hg doesn't need this.
(with-temp-buffer
(vc-call-backend 'git 'diff (list file) "HEAD" nil (current-buffer))
(vc-call-backend 'Git 'diff (list file) "HEAD" nil (current-buffer))
(goto-char (point-min))
(let ((last-offset 0)
(from-offset nil)

47
lisp/vc/vc.el
View file

@ -2794,18 +2794,25 @@ Return t if the buffer had changes, nil otherwise."
(if async 'async 1) "diff" file
(append (vc-switches nil 'diff) `(,(null-device)))))))
(setq files (nreverse filtered))))
(set-buffer buffer)
;; Make the *vc-diff* buffer read only, the diff-mode key
;; bindings are nicer for read only buffers. pcl-cvs does the
;; same thing.
(setq buffer-read-only t)
(diff-mode)
(setq-local diff-vc-backend (car vc-fileset))
(setq-local diff-vc-revisions (list rev1 rev2))
(setq-local revert-buffer-function
(lambda (_ignore-auto _noconfirm)
(vc-diff-internal async vc-fileset rev1 rev2 verbose)))
(with-current-buffer buffer
;; Make the *vc-diff* buffer read only, the diff-mode key
;; bindings are nicer for read only buffers. pcl-cvs does the
;; same thing.
(setq buffer-read-only t)
;; Set the major mode and some local variables before calling into
;; the backend. This means that the backend can itself set local
;; variables and enable minor modes in BUFFER if it wants to.
;; Call into the backend with the old current buffer, though, so
;; that its operation can be influenced by local variables in that
;; buffer (some discussion in bug#80005).
(diff-mode)
(setq-local diff-vc-backend (car vc-fileset))
(setq-local diff-vc-revisions (list rev1 rev2))
(setq-local revert-buffer-function
(lambda (_ignore-auto _noconfirm)
(vc-diff-internal async vc-fileset rev1 rev2 verbose))))
(vc-call-backend (car vc-fileset) 'diff files rev1 rev2 buffer async)
(set-buffer buffer)
(if (and (zerop (buffer-size))
(not (get-buffer-process (current-buffer))))
;; Treat this case specially so as not to pop the buffer.
@ -4485,10 +4492,8 @@ file names."
(dolist (file file-or-files)
(let ((buf (get-file-buffer file))
(backend (vc-backend file)))
(unless backend
(error "File %s is not under version control"
(file-name-nondirectory file)))
(unless (vc-find-backend-function backend 'delete-file)
(unless (or (not backend)
(vc-find-backend-function backend 'delete-file))
(error "Deleting files under %s is not supported in VC" backend))
(when (and buf (buffer-modified-p buf))
(error "Please save or undo your changes before deleting %s" file))
@ -4511,11 +4516,13 @@ file names."
(with-current-buffer (or buf (find-file-noselect file))
(let ((backup-inhibited nil))
(backup-buffer))))
;; Bind `default-directory' so that the command that the backend
;; runs to remove the file is invoked in the correct context.
(let ((default-directory (file-name-directory file)))
(vc-call-backend backend 'delete-file file))
;; If the backend hasn't deleted the file itself, let's do it for him.
(when backend
;; Bind `default-directory' so that the command that the backend
;; runs to remove the file is invoked in the correct context.
(let ((default-directory (file-name-directory file)))
(vc-call-backend backend 'delete-file file)))
;; For the case of unregistered files, or if the backend didn't
;; actually delete the file.
(when (file-exists-p file) (delete-file file))
;; Forget what VC knew about the file.
(vc-file-clearprops file)