diff --git a/lisp/textmodes/markdown-ts-mode.el b/lisp/textmodes/markdown-ts-mode.el index fb895c9231f..ff889efa49b 100644 --- a/lisp/textmodes/markdown-ts-mode.el +++ b/lisp/textmodes/markdown-ts-mode.el @@ -5133,6 +5133,7 @@ commands in a table context." :menu nil "" #'markdown-ts-table-next-row "S-" #'markdown-ts-table-previous-row + "M-RET" #'markdown-ts-table-insert-row-below "" #'markdown-ts-table-next-cell "" #'markdown-ts-table-previous-cell "M-" #'markdown-ts-table-move-row-up diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 45128aaf829..a44c9f3b181 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1313,8 +1313,7 @@ that file." (defun vc-dir-resynch-file (&optional fname) "Update the entries for FNAME in any directory buffers that list it." - (let* ((file (or fname buffer-file-name)) - (file-tn (file-truename file)) + (let* ((file (file-truename (or fname buffer-file-name))) (drop '())) (save-current-buffer ;; look for a vc-dir buffer that might show this file. @@ -1333,20 +1332,20 @@ that file." ;; `default-directory' in order to do its work, ;; but that's irrelevant to us here. (buffer-local-toplevel-value 'default-directory)))) - (when (file-in-directory-p file-tn ddir) - (if (file-directory-p file-tn) + (when (file-in-directory-p file ddir) + (if (file-directory-p file) (progn - (vc-dir-resync-directory-files file-tn) + (vc-dir-resync-directory-files file) (ewoc-set-hf vc-ewoc (vc-dir-headers vc-dir-backend ddir) "")) (let* ((complete-state - ;; Pass FILE not FILE-TN here. See bug#80967. - (vc-dir-recompute-file-state file ddir)) + (vc-dir-recompute-file-state file + (file-truename ddir))) (state (cadr complete-state))) - (vc-dir-update - (list complete-state) - status-buf (or (not state) - (eq state 'up-to-date))))))))))) + (vc-dir-update (list complete-state) + status-buf + (or (not state) + (eq state 'up-to-date))))))))))) ;; Remove out-of-date entries from vc-dir-buffers. (setq vc-dir-buffers (cl-nset-difference vc-dir-buffers drop :test #'eq)))) diff --git a/test/lisp/vc/vc-tests/resources/vc-tests-helpers.el b/test/lisp/vc/vc-tests/resources/vc-tests-helpers.el new file mode 100644 index 00000000000..73afef4075b --- /dev/null +++ b/test/lisp/vc/vc-tests/resources/vc-tests-helpers.el @@ -0,0 +1,100 @@ +;;; vc-test-helper.el --- VC test suite helpers -*- lexical-binding:t -*- + +;; Copyright (C) 2014-2026 Free Software Foundation, Inc. + +;; Author: Michael Albinus +;; Sean Whitton + +;; 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 . + +;;; Commentary: + +;;; Code: + +(defun vc-test--create-repo-function (backend) + "Run the `vc-create-repo' backend function. +For backends which don't support it, it is emulated." + (cond + ((eq backend 'CVS) + (let ((tmp-dir + (expand-file-name + (make-temp-name "vc-test") temporary-file-directory))) + (make-directory (expand-file-name "module" tmp-dir) 'parents) + (make-directory (expand-file-name "CVSROOT" tmp-dir) 'parents) + (if (not (fboundp 'w32-application-type)) + (shell-command-to-string (format "cvs -Q -d:local:%s co module" + tmp-dir)) + (let ((cvs-prog (executable-find "cvs")) + (tdir tmp-dir)) + ;; If CVS executable is an MSYS program, reformat the file + ;; name of TMP-DIR to have the /d/foo/bar form supported by + ;; MSYS programs. (FIXME: What about Cygwin cvs.exe?) + (if (eq (w32-application-type cvs-prog) 'msys) + (setq tdir + (concat "/" (substring tmp-dir 0 1) (substring tmp-dir 2)))) + (shell-command-to-string (format "cvs -Q -d:local:%s co module" + tdir)))) + (rename-file "module/CVS" default-directory) + (delete-directory "module" 'recursive) + ;; We must cleanup the "remote" CVS repo as well. + (add-hook 'vc-test--cleanup-hook + (lambda () (delete-directory tmp-dir 'recursive))))) + + ((eq backend 'Arch) + (let ((archive-name (format "%s--%s" user-mail-address (random)))) + (when (string-match + "no arch user id set" (shell-command-to-string "tla my-id")) + (shell-command-to-string + (format "tla my-id \"<%s>\"" user-mail-address))) + (shell-command-to-string + (format "tla make-archive %s %s" archive-name default-directory)) + (shell-command-to-string + (format "tla my-default-archive %s" archive-name)))) + + ((eq backend 'Mtn) + (let ((archive-name "foo.mtn")) + (shell-command-to-string + (format + "mtn db init --db=%s" + (expand-file-name archive-name default-directory))) + (shell-command-to-string + (format "mtn --db=%s --branch=foo setup ." archive-name)))) + + (t (vc-create-repo backend)))) + +(defvar vc-hg-global-switches) + +(defmacro vc-test--with-author-identity (backend &rest body) + (declare (indent 1) (debug t)) + `(let ((process-environment process-environment) + (vc-hg-global-switches (bound-and-true-p vc-hg-global-switches))) + ;; git tries various approaches to guess a user name and email, + ;; which can fail depending on how the system is configured. + ;; Eg if the user account has no GECOS, git commit can fail with + ;; status 128 "fatal: empty ident name". + (when (memq ,backend '(Bzr Git)) + (push "EMAIL=joh.doe@example.com" process-environment)) + (when (eq ,backend 'Git) + (setq process-environment (append '("GIT_AUTHOR_NAME=A" + "GIT_COMMITTER_NAME=C") + process-environment))) + + ;; Mercurial fails to autodetect an identity on MS-Windows. + (when (eq ,backend 'Hg) + (push "--config=ui.username=john@doe.ee" vc-hg-global-switches)) + ,@body)) + +(provide 'vc-tests-helpers) diff --git a/test/lisp/vc/vc-tests/vc-test-misc.el b/test/lisp/vc/vc-tests/vc-test-misc.el index 72dc8de22bf..bb2ee8af1f7 100644 --- a/test/lisp/vc/vc-tests/vc-test-misc.el +++ b/test/lisp/vc/vc-tests/vc-test-misc.el @@ -25,6 +25,14 @@ (require 'ert-x) (require 'vc) +(require 'vc-git) +(require 'vc-dir) +(require 'log-edit) + +(require 'vc-tests-helpers + (ert-resource-file "vc-tests-helpers")) + +(defvar vc-hg-global-switches) (ert-deftest vc-test-buffer-sync-fileset () "Test `vc-buffer-sync-fileset'." @@ -242,5 +250,50 @@ (should (eq (vc--match-branch-name-regexps "master") 'topic)) (should (eq (vc--match-branch-name-regexps "foo") 'trunk))))) +(ert-deftest vc-test-vc-dir-on-symlink () + "Test VC-Dir on a symlink to a repository. +See bug#80803 and bug#80967." + (skip-unless (executable-find vc-git-program)) + (vc-test--with-author-identity 'Git + (let ((vc-handled-backends '(Git))) + (ert-with-temp-directory tempdir + (let* ((default-directory tempdir) + (src (expand-file-name "src/" tempdir)) + (dest (expand-file-name "dest/" tempdir)) + (file (expand-file-name "foo" dest)) + file-buf truename-dir symlink-dir) + (make-directory dest) + (let ((default-directory dest) + vc-async-checkin) + (vc-test--create-repo-function 'Git) + (write-region "foo\n" nil file nil 'nomessage) + (with-current-buffer (setq file-buf (find-file-noselect file)) + (vc-register `(Git (,file))) + (vc-checkin (list file) 'Git) + (insert "Initial commit") + (let (vc-async-checkin) + (log-edit-done)))) + (make-symbolic-link dest src) + ;; Emulate an interactive call to `vc-dir'. + (vc-dir (file-truename src) 'Git) + (while (vc-dir-busy) (sit-for 0.05)) + (should (equal default-directory dest)) + (setq truename-dir (current-buffer)) + ;; Now a `vc-dir' pointed at the symlink, which is unlike an + ;; interactive call to `vc-dir'. + (vc-dir src 'Git) + (while (vc-dir-busy) (sit-for 0.05)) + (should (equal default-directory src)) + (setq symlink-dir (current-buffer)) + (with-current-buffer file-buf + (insert "bar") + (basic-save-buffer)) + (dolist (buf (list truename-dir symlink-dir)) + (with-current-buffer buf + (should (equal (vc-dir-fileinfo->name + (ewoc-data + (ewoc-nth vc-ewoc 1))) + (file-name-nondirectory file)))))))))) + (provide 'vc-test-misc) ;;; vc-test-misc.el ends here diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 8e2ae2c4454..f190db103d5 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -120,6 +120,10 @@ (require 'project) (require 'cl-lib) +(require 'vc-tests-helpers + (ert-resource-file "vc-tests-helpers")) + +(defvar vc-hg-global-switches) (declare-function w32-application-type "w32proc.c") ;; The working horses. @@ -132,58 +136,6 @@ Don't set it globally, the functions should be let-bound.") "Run the `revision-granularity' backend function." (vc-call-backend backend 'revision-granularity)) -(defun vc-test--create-repo-function (backend) - "Run the `vc-create-repo' backend function. -For backends which don't support it, it is emulated." - - (cond - ((eq backend 'CVS) - (let ((tmp-dir - (expand-file-name - (make-temp-name "vc-test") temporary-file-directory))) - (make-directory (expand-file-name "module" tmp-dir) 'parents) - (make-directory (expand-file-name "CVSROOT" tmp-dir) 'parents) - (if (not (fboundp 'w32-application-type)) - (shell-command-to-string (format "cvs -Q -d:local:%s co module" - tmp-dir)) - (let ((cvs-prog (executable-find "cvs")) - (tdir tmp-dir)) - ;; If CVS executable is an MSYS program, reformat the file - ;; name of TMP-DIR to have the /d/foo/bar form supported by - ;; MSYS programs. (FIXME: What about Cygwin cvs.exe?) - (if (eq (w32-application-type cvs-prog) 'msys) - (setq tdir - (concat "/" (substring tmp-dir 0 1) (substring tmp-dir 2)))) - (shell-command-to-string (format "cvs -Q -d:local:%s co module" - tdir)))) - (rename-file "module/CVS" default-directory) - (delete-directory "module" 'recursive) - ;; We must cleanup the "remote" CVS repo as well. - (add-hook 'vc-test--cleanup-hook - (lambda () (delete-directory tmp-dir 'recursive))))) - - ((eq backend 'Arch) - (let ((archive-name (format "%s--%s" user-mail-address (random)))) - (when (string-match - "no arch user id set" (shell-command-to-string "tla my-id")) - (shell-command-to-string - (format "tla my-id \"<%s>\"" user-mail-address))) - (shell-command-to-string - (format "tla make-archive %s %s" archive-name default-directory)) - (shell-command-to-string - (format "tla my-default-archive %s" archive-name)))) - - ((eq backend 'Mtn) - (let ((archive-name "foo.mtn")) - (shell-command-to-string - (format - "mtn db init --db=%s" - (expand-file-name archive-name default-directory))) - (shell-command-to-string - (format "mtn --db=%s --branch=foo setup ." archive-name)))) - - (t (vc-create-repo backend)))) - (defmacro vc--fix-home-for-bzr (tempdir) ;; See the comment in `vc-bzr-test-bug9726'. `(when (eq backend 'Bzr) @@ -718,28 +670,6 @@ This checks also `vc-backend' and `vc-responsible-backend'." (ignore-errors (run-hooks 'vc-test--cleanup-hook)))))) -(defvar vc-hg-global-switches) - -(defmacro vc-test--with-author-identity (backend &rest body) - (declare (indent 1) (debug t)) - `(let ((process-environment process-environment) - (vc-hg-global-switches vc-hg-global-switches)) - ;; git tries various approaches to guess a user name and email, - ;; which can fail depending on how the system is configured. - ;; Eg if the user account has no GECOS, git commit can fail with - ;; status 128 "fatal: empty ident name". - (when (memq ,backend '(Bzr Git)) - (push "EMAIL=joh.doe@example.com" process-environment)) - (when (eq ,backend 'Git) - (setq process-environment (append '("GIT_AUTHOR_NAME=A" - "GIT_COMMITTER_NAME=C") - process-environment))) - - ;; Mercurial fails to autodetect an identity on MS-Windows. - (when (eq ,backend 'Hg) - (push "--config=ui.username=john@doe.ee" vc-hg-global-switches)) - ,@body)) - (declare-function log-edit-done "vc/log-edit") (defun vc-test--version-diff (backend)