diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index cc5e813f018..29e05ba17e5 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -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 diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index b7b2d40caee..421559cc811 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -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{}) diff --git a/etc/NEWS b/etc/NEWS index e90000a9f58..6292cf981da 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -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 diff --git a/lisp/emacs-lisp/cond-star.el b/lisp/emacs-lisp/cond-star.el index ac448d9dcdf..0883ddc5383 100644 --- a/lisp/emacs-lisp/cond-star.el +++ b/lisp/emacs-lisp/cond-star.el @@ -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. diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 0b5720ae440..4d31c314ef5 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -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)))) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index d3dad88b7d6..11083878025 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -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." diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 0bcd0bcf1e4..53203a9e386 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -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) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index cd61f433e26..4887df63141 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -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)