Avoid delving into Git internals for version
* lisp/loadup.el (exec-path): Set it to nil later, so that emacs-repository-get-version can invoke git commands in the PATH. * lisp/version.el (emacs-repository--version-git-1): Remove. (emacs-repository-get-version): Let Git do it rather than delving into Git internals.
This commit is contained in:
parent
4428f5a97b
commit
1e5539e0b3
2 changed files with 8 additions and 61 deletions
|
@ -78,10 +78,6 @@
|
||||||
(expand-file-name "textmodes" dir)
|
(expand-file-name "textmodes" dir)
|
||||||
(expand-file-name "vc" dir)))))
|
(expand-file-name "vc" dir)))))
|
||||||
|
|
||||||
;; Prevent build-time PATH getting stored in the binary.
|
|
||||||
;; Mainly cosmetic, but helpful for Guix. (Bug#20330)
|
|
||||||
(setq exec-path nil)
|
|
||||||
|
|
||||||
(if (eq t purify-flag)
|
(if (eq t purify-flag)
|
||||||
;; Hash consing saved around 11% of pure space in my tests.
|
;; Hash consing saved around 11% of pure space in my tests.
|
||||||
(setq purify-flag (make-hash-table :test 'equal :size 80000)))
|
(setq purify-flag (make-hash-table :test 'equal :size 80000)))
|
||||||
|
@ -431,6 +427,12 @@ lost after dumping")))
|
||||||
(message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others"
|
(message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others"
|
||||||
strings vectors conses bytecodes others)))
|
strings vectors conses bytecodes others)))
|
||||||
|
|
||||||
|
;; Prevent build-time PATH getting stored in the binary.
|
||||||
|
;; Mainly cosmetic, but helpful for Guix. (Bug#20330)
|
||||||
|
;; Do this here, rather than earlier, so that the above code
|
||||||
|
;; can invoke Git commands and the like.
|
||||||
|
(setq exec-path nil)
|
||||||
|
|
||||||
;; Avoid error if user loads some more libraries now and make sure the
|
;; Avoid error if user loads some more libraries now and make sure the
|
||||||
;; hash-consing hash table is GC'd.
|
;; hash-consing hash table is GC'd.
|
||||||
(setq purify-flag nil)
|
(setq purify-flag nil)
|
||||||
|
|
|
@ -116,18 +116,6 @@ or if we could not determine the revision.")
|
||||||
(looking-at "[0-9a-fA-F]\\{40\\}"))
|
(looking-at "[0-9a-fA-F]\\{40\\}"))
|
||||||
(match-string 0)))))
|
(match-string 0)))))
|
||||||
|
|
||||||
(defun emacs-repository--version-git-1 (file dir)
|
|
||||||
"Internal subroutine of `emacs-repository-get-version'."
|
|
||||||
(when (file-readable-p 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)
|
(defun emacs-repository-get-version (&optional dir external)
|
||||||
"Try to return as a string the repository revision of the Emacs sources.
|
"Try to return as a string the repository revision of the Emacs sources.
|
||||||
The format of the returned string is dependent on the VCS in use.
|
The format of the returned string is dependent on the VCS in use.
|
||||||
|
@ -137,51 +125,8 @@ this reports on the current state of the sources, which may not
|
||||||
correspond to the running Emacs.
|
correspond to the running Emacs.
|
||||||
|
|
||||||
Optional argument DIR is a directory to use instead of `source-directory'.
|
Optional argument DIR is a directory to use instead of `source-directory'.
|
||||||
Optional argument EXTERNAL non-nil means to just ask the VCS itself,
|
Optional argument EXTERNAL is ignored."
|
||||||
if the sources appear to be under version control. Otherwise only ask
|
(emacs-repository-version-git (or dir source-directory)))
|
||||||
the VCS if we cannot find any information ourselves."
|
|
||||||
(or dir (setq dir source-directory))
|
|
||||||
(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)
|
|
||||||
(or
|
|
||||||
(let ((packed-refs (expand-file-name "packed-refs" base-dir)))
|
|
||||||
(if (file-readable-p packed-refs)
|
|
||||||
(with-temp-buffer
|
|
||||||
(insert-file-contents packed-refs)
|
|
||||||
(when (re-search-forward
|
|
||||||
"^\\([0-9a-fA-F]\\{40\\}\\) refs/heads/master$"
|
|
||||||
nil t)
|
|
||||||
(match-string 1)))))
|
|
||||||
(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.
|
;; 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))
|
(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
|
||||||
|
|
Loading…
Add table
Reference in a new issue