Discover repository version in linked worktrees (bug#21930)
* lisp/version.el (emacs-repository--version-git-1): Do not assume HEAD is at .git/HEAD, it can also be at .git/worktrees/<branch>/HEAD. (emacs-repository-get-version): Grok linked worktrees when EXTERNAL is nil too.
This commit is contained in:
parent
32845e3aad
commit
c210b8b128
1 changed files with 41 additions and 23 deletions
|
@ -113,17 +113,17 @@ or if we could not determine the revision.")
|
|||
(looking-at "[0-9a-fA-F]\\{40\\}"))
|
||||
(match-string 0)))))
|
||||
|
||||
(defun emacs-repository--version-git-1 (file)
|
||||
(defun emacs-repository--version-git-1 (file dir)
|
||||
"Internal subroutine of `emacs-repository-get-version'."
|
||||
(when (file-readable-p file)
|
||||
(erase-buffer)
|
||||
(insert-file-contents file)
|
||||
(cond ((looking-at "[0-9a-fA-F]\\{40\\}")
|
||||
(match-string 0))
|
||||
((looking-at "ref: \\(.*\\)")
|
||||
(emacs-repository--version-git-1
|
||||
(expand-file-name (match-string 1)
|
||||
(file-name-directory file)))))))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(cond ((looking-at "[0-9a-fA-F]\\{40\\}")
|
||||
(match-string 0))
|
||||
((looking-at "ref: \\(.*\\)")
|
||||
(emacs-repository--version-git-1
|
||||
(expand-file-name (match-string 1) dir)
|
||||
dir))))))
|
||||
|
||||
(defun emacs-repository-get-version (&optional dir external)
|
||||
"Try to return as a string the repository revision of the Emacs sources.
|
||||
|
@ -138,20 +138,38 @@ Optional argument EXTERNAL non-nil means to just ask the VCS itself,
|
|||
if the sources appear to be under version control. Otherwise only ask
|
||||
the VCS if we cannot find any information ourselves."
|
||||
(or dir (setq dir source-directory))
|
||||
(when (file-directory-p (expand-file-name ".git" dir))
|
||||
(if external
|
||||
(emacs-repository-version-git dir)
|
||||
(or (let ((files '("HEAD" "refs/heads/master"))
|
||||
file rev)
|
||||
(with-temp-buffer
|
||||
(while (and (not rev)
|
||||
(setq file (car files)))
|
||||
(setq file (expand-file-name (format ".git/%s" file) dir)
|
||||
files (cdr files)
|
||||
rev (emacs-repository--version-git-1 file))))
|
||||
rev)
|
||||
;; AFAICS this doesn't work during dumping (bug#20799).
|
||||
(emacs-repository-version-git dir)))))
|
||||
(let* ((base-dir (expand-file-name ".git" dir))
|
||||
(in-main-worktree (file-directory-p base-dir))
|
||||
(in-linked-worktree nil)
|
||||
sub-dir)
|
||||
;; If the sources are in a linked worktree, .git is a file that points to
|
||||
;; the location of the main worktree and the repo's administrative files.
|
||||
(when (and (not in-main-worktree)
|
||||
(file-regular-p base-dir)
|
||||
(file-readable-p base-dir))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents base-dir)
|
||||
(when (looking-at "gitdir: \\(.*\.git\\)\\(.*\\)$")
|
||||
(setq base-dir (match-string 1)
|
||||
sub-dir (concat base-dir (match-string 2))
|
||||
in-linked-worktree t))))
|
||||
;; We've found a worktree, either main or linked.
|
||||
(when (or in-main-worktree in-linked-worktree)
|
||||
(if external
|
||||
(emacs-repository-version-git dir)
|
||||
(or (if in-linked-worktree
|
||||
(emacs-repository--version-git-1
|
||||
(expand-file-name "HEAD" sub-dir) base-dir)
|
||||
(let ((files '("HEAD" "refs/heads/master"))
|
||||
file rev)
|
||||
(while (and (not rev)
|
||||
(setq file (car files)))
|
||||
(setq file (expand-file-name file base-dir)
|
||||
files (cdr files)
|
||||
rev (emacs-repository--version-git-1 file base-dir)))
|
||||
rev))
|
||||
;; AFAICS this doesn't work during dumping (bug#20799).
|
||||
(emacs-repository-version-git dir))))))
|
||||
|
||||
;; We put version info into the executable in the form that `ident' uses.
|
||||
(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
|
||||
|
|
Loading…
Add table
Reference in a new issue