X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e57f766d3c97162258ec24b2b4986cdc0e98d352..f2536958ec711b50a0cf8714defb921193ea8ae4:/lisp/version.el diff --git a/lisp/version.el b/lisp/version.el index 1837cbf0a8..77188a51ee 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -1,6 +1,6 @@ ;;; version.el --- record version number of Emacs -;; Copyright (C) 1985, 1992, 1994-1995, 1999-2015 Free Software +;; Copyright (C) 1985, 1992, 1994-1995, 1999-2016 Free Software ;; Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org @@ -41,12 +41,15 @@ This variable first existed in version 19.23.") (defconst emacs-build-time (current-time) "Time at which Emacs was dumped out.") +;; I think this should be obsoleted/removed. It's just one more meaningless +;; difference between different builds. It's usually not even an fqdn. (defconst emacs-build-system (system-name) "Name of the system on which Emacs was built.") (defvar motif-version-string) (defvar gtk-version-string) (defvar ns-version-string) +(defvar cairo-version-string) (defun emacs-version (&optional here) "Return string describing the version of Emacs that is running. @@ -56,8 +59,8 @@ to the system configuration; look at `system-configuration' instead." (interactive "P") (let ((version-string (format (if (not (called-interactively-p 'interactive)) - "GNU Emacs %s (%s%s%s)\n of %s on %s" - "GNU Emacs %s (%s%s%s) of %s on %s") + "GNU Emacs %s (%s%s%s%s)\n of %s" + "GNU Emacs %s (%s%s%s%s) of %s") emacs-version system-configuration (cond ((featurep 'motif) @@ -68,13 +71,15 @@ to the system configuration; look at `system-configuration' instead." ((featurep 'ns) (format ", NS %s" ns-version-string)) (t "")) + (if (featurep 'cairo) + (format ", cairo version %s" cairo-version-string) + "") (if (and (boundp 'x-toolkit-scroll-bars) (memq x-toolkit-scroll-bars '(xaw xaw3d))) (format ", %s scroll bars" (capitalize (symbol-name x-toolkit-scroll-bars))) "") - (format-time-string "%Y-%m-%d" emacs-build-time) - emacs-build-system))) + (format-time-string "%Y-%m-%d" emacs-build-time)))) (if here (insert version-string) (if (called-interactively-p 'interactive) @@ -96,6 +101,30 @@ or if we could not determine the revision.") (define-obsolete-function-alias 'emacs-bzr-get-version 'emacs-repository-get-version "24.4") +(defun emacs-repository-version-git (dir) + "Ask git itself for the version information for directory DIR." + (message "Waiting for git...") + (with-temp-buffer + (let ((default-directory (file-name-as-directory dir))) + (and (eq 0 + (with-demoted-errors "Error running git rev-parse: %S" + (call-process "git" nil '(t nil) nil "rev-parse" "HEAD"))) + (progn (goto-char (point-min)) + (looking-at "[0-9a-fA-F]\\{40\\}")) + (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) "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. @@ -104,21 +133,43 @@ control, or if we could not determine the revision. Note that this reports on the current state of the sources, which may not correspond to the running Emacs. -Optional argument DIR is a directory to use instead of -`source-directory'. Optional argument EXTERNAL is ignored and is -retained for compatibility." +Optional argument DIR is a directory to use instead of `source-directory'. +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)) - (cond ((file-directory-p (expand-file-name ".git" dir)) - (message "Waiting for git...") - (with-temp-buffer - (let ((default-directory (file-name-as-directory dir))) - (and (eq 0 - (condition-case nil - (call-process "git" nil '(t nil) nil "rev-parse" - "HEAD") - (error nil))) - (not (zerop (buffer-size))) - (replace-regexp-in-string "\n" "" (buffer-string)))))))) + (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))