From 752a05b17dfb1bfb27867f1cf3a7548dbb570d26 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 7 Sep 2018 17:41:21 +0300 Subject: [PATCH] Read Windows OS info for report-emacs-bug from Registry * lisp/w32-fns.el (w32--os-description): New function. * lisp/mail/emacsbug.el (report-emacs-bug--os-description): Use 'w32--os-description' instead of launching the 'systeminfo' program, which can be very slow, and is also missing on versions of Windows before XP Professional. --- lisp/mail/emacsbug.el | 17 +------- lisp/w32-fns.el | 99 ++++++++++++++++++++++++++++++++----------- 2 files changed, 75 insertions(+), 41 deletions(-) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 92b005d47d2..8cacad8726d 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -134,22 +134,7 @@ This requires either the macOS \"open\" command, or the freedesktop os)) ((eq system-type 'windows-nt) (or report-emacs-bug--os-description - (setq - report-emacs-bug--os-description - (let (os) - (with-temp-buffer - ;; Seems like this command can be slow, because it - ;; unconditionally queries a bunch of other stuff - ;; we don't care about. - (when (eq 0 (ignore-errors - (call-process "systeminfo" nil '(t nil) nil))) - (dolist (s '("OS Name" "OS Version")) - (goto-char (point-min)) - (if (re-search-forward - (format "^%s\\s-*:\\s-+\\(.*\\)$" s) - nil t) - (setq os (concat os " " (match-string 1))))))) - os)))) + (setq report-emacs-bug--os-description (w32--os-description)))) ((eq system-type 'berkeley-unix) (with-temp-buffer (when diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index a8a41c453a0..91fe5186bc9 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -39,6 +39,8 @@ ;; same buffer. (setq find-file-visit-truename t)) +;;;; Shells + (defun w32-shell-name () "Return the name of the shell being used." (or (bound-and-true-p shell-file-name) @@ -120,6 +122,8 @@ You should set this to t when using a non-system shell.\n\n")))) (add-hook 'after-init-hook 'w32-check-shell-configuration) +;;;; Coding-systems, locales, etc. + ;; Override setting chosen at startup. (defun w32-set-default-process-coding-system () ;; Most programs on Windows will accept Unix line endings on input @@ -187,31 +191,6 @@ You should set this to t when using a non-system shell.\n\n")))) ;; (setq source-directory (file-name-as-directory ;; (expand-file-name ".." exec-directory))))) -(defun w32-convert-standard-filename (filename) - "Convert a standard file's name to something suitable for MS-Windows. -This means to guarantee valid names and perhaps to canonicalize -certain patterns. - -This function is called by `convert-standard-filename'. - -Replace invalid characters and turn Cygwin names into native -names." - (save-match-data - (let ((name - (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) - (replace-match "\\1:/" t nil filename) - (copy-sequence filename))) - (start 0)) - ;; leave ':' if part of drive specifier - (if (and (> (length name) 1) - (eq (aref name 1) ?:)) - (setq start 2)) - ;; destructively replace invalid filename characters with ! - (while (string-match "[?*:<>|\"\000-\037]" name start) - (aset name (match-beginning 0) ?!) - (setq start (match-end 0))) - name))) - (defun w32-set-system-coding-system (coding-system) "Set the coding system used by the Windows system to CODING-SYSTEM. This is used for things like passing font names with non-ASCII @@ -297,6 +276,76 @@ bit output with no translation." (w32-add-charset-info "tis620-0" 'w32-charset-thai 874) (w32-add-charset-info "iso8859-1" 'w32-charset-ansi 1252)) +;;;; Standard filenames + +(defun w32-convert-standard-filename (filename) + "Convert a standard file's name to something suitable for MS-Windows. +This means to guarantee valid names and perhaps to canonicalize +certain patterns. + +This function is called by `convert-standard-filename'. + +Replace invalid characters and turn Cygwin names into native +names." + (save-match-data + (let ((name + (if (string-match "\\`/cygdrive/\\([a-zA-Z]\\)/" filename) + (replace-match "\\1:/" t nil filename) + (copy-sequence filename))) + (start 0)) + ;; leave ':' if part of drive specifier + (if (and (> (length name) 1) + (eq (aref name 1) ?:)) + (setq start 2)) + ;; destructively replace invalid filename characters with ! + (while (string-match "[?*:<>|\"\000-\037]" name start) + (aset name (match-beginning 0) ?!) + (setq start (match-end 0))) + name))) + +;;;; System name and version for emacsbug.el + +(defun w32--os-description () + "Return a string describing the underlying OS and its version." + (let* ((w32ver (car (w32-version))) + (w9x-p (< w32ver 5)) + (key (if w9x-p + "SOFTWARE/Microsoft/Windows/CurrentVersion" + "SOFTWARE/Microsoft/Windows NT/CurrentVersion")) + (os-name (w32-read-registry 'HKLM key "ProductName")) + (os-version (if w9x-p + (w32-read-registry 'HKLM key "VersionNumber") + (let ((vmajor + (w32-read-registry 'HKLM key + "CurrentMajorVersionNumber")) + (vminor + (w32-read-registry 'HKLM key + "CurrentMinorVersionNumber"))) + (if (and vmajor vmajor) + (format "%d.%d" vmajor vminor) + (w32-read-registry 'HKLM key "CurrentVersion"))))) + (os-csd (w32-read-registry 'HKLM key "CSDVersion")) + (os-rel (or (w32-read-registry 'HKLM key "ReleaseID") + (w32-read-registry 'HKLM key "CSDBuildNumber") + "0")) ; No Release ID before Windows Vista + (os-build (w32-read-registry 'HKLM key "CurrentBuildNumber")) + (os-rev (w32-read-registry 'HKLM key "UBR")) + (os-rev (if os-rev (format "%d" os-rev)))) + (if w9x-p + (concat + (if (not (string-match "\\`Microsoft " os-name)) "Microsoft ") + os-name + " (v" os-version ")") + (concat + (if (not (string-match "\\`Microsoft " os-name)) "Microsoft ") + os-name ; Windows 7 Enterprise + " " + os-csd ; Service Pack 1 + (if (and os-csd (> (length os-csd) 0)) " " "") + "(v" + os-version "." os-rel "." os-build (if os-rev (concat "." os-rev)) + ")")))) + ;;;; Support for build process -- 2.39.5