procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Read Windows OS info for report-emacs-bug from Registry

Browse source 
* 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.
This commit is contained in:
Eli Zaretskii 2018-09-07 17:41:21 +03:00
parent 2c8520e19c
commit 752a05b17d
2 changed files with 75 additions and 41 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
lisp/mail/emacsbug.el
View file

@ -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

99
lisp/w32-fns.el
View file

@ -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