diff options
| author | Paul Eggert | 2016-06-01 13:25:09 -0700 |
|---|---|---|
| committer | Paul Eggert | 2016-06-01 13:26:30 -0700 |
| commit | 1e5539e0b35d2a7fcd1f1772c4532430cb18471b (patch) | |
| tree | c4c11c574537659dacff45cc858eb6edba822451 | |
| parent | 4428f5a97b942652e6894f22c4c251457a1edc8b (diff) | |
| download | emacs-1e5539e0b35d2a7fcd1f1772c4532430cb18471b.tar.gz emacs-1e5539e0b35d2a7fcd1f1772c4532430cb18471b.zip | |
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.
| -rw-r--r-- | lisp/loadup.el | 10 | ||||
| -rw-r--r-- | lisp/version.el | 59 |
2 files changed, 8 insertions, 61 deletions
diff --git a/lisp/loadup.el b/lisp/loadup.el index db3c36d1f01..5c16464282b 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el | |||
| @@ -78,10 +78,6 @@ | |||
| 78 | (expand-file-name "textmodes" dir) | 78 | (expand-file-name "textmodes" dir) |
| 79 | (expand-file-name "vc" dir))))) | 79 | (expand-file-name "vc" dir))))) |
| 80 | 80 | ||
| 81 | ;; Prevent build-time PATH getting stored in the binary. | ||
| 82 | ;; Mainly cosmetic, but helpful for Guix. (Bug#20330) | ||
| 83 | (setq exec-path nil) | ||
| 84 | |||
| 85 | (if (eq t purify-flag) | 81 | (if (eq t purify-flag) |
| 86 | ;; Hash consing saved around 11% of pure space in my tests. | 82 | ;; Hash consing saved around 11% of pure space in my tests. |
| 87 | (setq purify-flag (make-hash-table :test 'equal :size 80000))) | 83 | (setq purify-flag (make-hash-table :test 'equal :size 80000))) |
| @@ -431,6 +427,12 @@ lost after dumping"))) | |||
| 431 | (message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others" | 427 | (message "Pure-hashed: %d strings, %d vectors, %d conses, %d bytecodes, %d others" |
| 432 | strings vectors conses bytecodes others))) | 428 | strings vectors conses bytecodes others))) |
| 433 | 429 | ||
| 430 | ;; Prevent build-time PATH getting stored in the binary. | ||
| 431 | ;; Mainly cosmetic, but helpful for Guix. (Bug#20330) | ||
| 432 | ;; Do this here, rather than earlier, so that the above code | ||
| 433 | ;; can invoke Git commands and the like. | ||
| 434 | (setq exec-path nil) | ||
| 435 | |||
| 434 | ;; Avoid error if user loads some more libraries now and make sure the | 436 | ;; Avoid error if user loads some more libraries now and make sure the |
| 435 | ;; hash-consing hash table is GC'd. | 437 | ;; hash-consing hash table is GC'd. |
| 436 | (setq purify-flag nil) | 438 | (setq purify-flag nil) |
diff --git a/lisp/version.el b/lisp/version.el index 2f71aeb228f..d4cb92ec86a 100644 --- a/lisp/version.el +++ b/lisp/version.el | |||
| @@ -116,18 +116,6 @@ or if we could not determine the revision.") | |||
| 116 | (looking-at "[0-9a-fA-F]\\{40\\}")) | 116 | (looking-at "[0-9a-fA-F]\\{40\\}")) |
| 117 | (match-string 0))))) | 117 | (match-string 0))))) |
| 118 | 118 | ||
| 119 | (defun emacs-repository--version-git-1 (file dir) | ||
| 120 | "Internal subroutine of `emacs-repository-get-version'." | ||
| 121 | (when (file-readable-p file) | ||
| 122 | (with-temp-buffer | ||
| 123 | (insert-file-contents file) | ||
| 124 | (cond ((looking-at "[0-9a-fA-F]\\{40\\}") | ||
| 125 | (match-string 0)) | ||
| 126 | ((looking-at "ref: \\(.*\\)") | ||
| 127 | (emacs-repository--version-git-1 | ||
| 128 | (expand-file-name (match-string 1) dir) | ||
| 129 | dir)))))) | ||
| 130 | |||
| 131 | (defun emacs-repository-get-version (&optional dir external) | 119 | (defun emacs-repository-get-version (&optional dir external) |
| 132 | "Try to return as a string the repository revision of the Emacs sources. | 120 | "Try to return as a string the repository revision of the Emacs sources. |
| 133 | The format of the returned string is dependent on the VCS in use. | 121 | 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 | |||
| 137 | correspond to the running Emacs. | 125 | correspond to the running Emacs. |
| 138 | 126 | ||
| 139 | Optional argument DIR is a directory to use instead of `source-directory'. | 127 | Optional argument DIR is a directory to use instead of `source-directory'. |
| 140 | Optional argument EXTERNAL non-nil means to just ask the VCS itself, | 128 | Optional argument EXTERNAL is ignored." |
| 141 | if the sources appear to be under version control. Otherwise only ask | 129 | (emacs-repository-version-git (or dir source-directory))) |
| 142 | the VCS if we cannot find any information ourselves." | ||
| 143 | (or dir (setq dir source-directory)) | ||
| 144 | (let* ((base-dir (expand-file-name ".git" dir)) | ||
| 145 | (in-main-worktree (file-directory-p base-dir)) | ||
| 146 | (in-linked-worktree nil) | ||
| 147 | sub-dir) | ||
| 148 | ;; If the sources are in a linked worktree, .git is a file that points to | ||
| 149 | ;; the location of the main worktree and the repo's administrative files. | ||
| 150 | (when (and (not in-main-worktree) | ||
| 151 | (file-regular-p base-dir) | ||
| 152 | (file-readable-p base-dir)) | ||
| 153 | (with-temp-buffer | ||
| 154 | (insert-file-contents base-dir) | ||
| 155 | (when (looking-at "gitdir: \\(.*\.git\\)\\(.*\\)$") | ||
| 156 | (setq base-dir (match-string 1) | ||
| 157 | sub-dir (concat base-dir (match-string 2)) | ||
| 158 | in-linked-worktree t)))) | ||
| 159 | ;; We've found a worktree, either main or linked. | ||
| 160 | (when (or in-main-worktree in-linked-worktree) | ||
| 161 | (if external | ||
| 162 | (emacs-repository-version-git dir) | ||
| 163 | (or (if in-linked-worktree | ||
| 164 | (emacs-repository--version-git-1 | ||
| 165 | (expand-file-name "HEAD" sub-dir) base-dir) | ||
| 166 | (or | ||
| 167 | (let ((packed-refs (expand-file-name "packed-refs" base-dir))) | ||
| 168 | (if (file-readable-p packed-refs) | ||
| 169 | (with-temp-buffer | ||
| 170 | (insert-file-contents packed-refs) | ||
| 171 | (when (re-search-forward | ||
| 172 | "^\\([0-9a-fA-F]\\{40\\}\\) refs/heads/master$" | ||
| 173 | nil t) | ||
| 174 | (match-string 1))))) | ||
| 175 | (let ((files '("HEAD" "refs/heads/master")) | ||
| 176 | file rev) | ||
| 177 | (while (and (not rev) | ||
| 178 | (setq file (car files))) | ||
| 179 | (setq file (expand-file-name file base-dir) | ||
| 180 | files (cdr files) | ||
| 181 | rev (emacs-repository--version-git-1 file base-dir))) | ||
| 182 | rev))) | ||
| 183 | ;; AFAICS this doesn't work during dumping (bug#20799). | ||
| 184 | (emacs-repository-version-git dir)))))) | ||
| 185 | 130 | ||
| 186 | ;; We put version info into the executable in the form that `ident' uses. | 131 | ;; We put version info into the executable in the form that `ident' uses. |
| 187 | (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version)) | 132 | (purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version)) |