diff options
| author | Glenn Morris | 2018-01-29 23:01:11 -0800 |
|---|---|---|
| committer | Glenn Morris | 2018-01-29 23:01:28 -0800 |
| commit | b937381e51df28551463da410577c72fb5fa6ace (patch) | |
| tree | e56356ed134bc2e17e2155985f255483ce7106d5 | |
| parent | 29abae3572090a86beedb66822ccf34356c8a00c (diff) | |
| download | emacs-b937381e51df28551463da410577c72fb5fa6ace.tar.gz emacs-b937381e51df28551463da410577c72fb5fa6ace.zip | |
Recognize more system descriptions in report-emacs-bug
* lisp/mail/emacsbug.el (report-emacs-bug--os-description):
New function, split from report-emacs-bug. Also parse the
standard /etc files that can contain release information.
(report-emacs-bug): Call report-emacs-bug--os-description.
| -rw-r--r-- | lisp/mail/emacsbug.el | 90 |
1 files changed, 66 insertions, 24 deletions
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 43e8d3b526c..d4caeed7888 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el | |||
| @@ -116,6 +116,71 @@ This requires either the macOS \"open\" command, or the freedesktop | |||
| 116 | (concat "mailto:" to))) | 116 | (concat "mailto:" to))) |
| 117 | (error "Subject, To or body not found"))))) | 117 | (error "Subject, To or body not found"))))) |
| 118 | 118 | ||
| 119 | (defun report-emacs-bug--os-description () | ||
| 120 | "Return a string describing the operating system, or nil." | ||
| 121 | (cond ((eq system-type 'darwin) | ||
| 122 | (let (os) | ||
| 123 | (with-temp-buffer | ||
| 124 | (when (eq 0 (ignore-errors | ||
| 125 | (call-process "sw_vers" nil '(t nil) nil))) | ||
| 126 | (dolist (s '("ProductName" "ProductVersion")) | ||
| 127 | (goto-char (point-min)) | ||
| 128 | (if (re-search-forward (format "^%s\\s-*:\\s-+\\(.*\\)$" s) | ||
| 129 | nil t) | ||
| 130 | (setq os (concat os " " (match-string 1))))))) | ||
| 131 | os)) | ||
| 132 | ;; TODO include other branches here. | ||
| 133 | ;; MS Windows: systeminfo ? | ||
| 134 | ;; Cygwin, *BSD, etc: ? | ||
| 135 | (t | ||
| 136 | (or (let ((file "/etc/os-release")) | ||
| 137 | (and (file-readable-p file) | ||
| 138 | (with-temp-buffer | ||
| 139 | (insert-file-contents file) | ||
| 140 | (if (re-search-forward | ||
| 141 | "^\\sw*PRETTY_NAME=\"?\\(.+?\\)\"?$" nil t) | ||
| 142 | (match-string 1) | ||
| 143 | (let (os) | ||
| 144 | (when (re-search-forward | ||
| 145 | "^\\sw*NAME=\"?\\(.+?\\)\"?$" nil t) | ||
| 146 | (setq os (match-string 1)) | ||
| 147 | (if (re-search-forward | ||
| 148 | "^\\sw*VERSION=\"?\\(.+?\\)\"?$" nil t) | ||
| 149 | (setq os (concat os " " (match-string 1)))) | ||
| 150 | os)))))) | ||
| 151 | (with-temp-buffer | ||
| 152 | (when (eq 0 (ignore-errors | ||
| 153 | (call-process "lsb_release" nil '(t nil) | ||
| 154 | nil "-d"))) | ||
| 155 | (goto-char (point-min)) | ||
| 156 | (if (looking-at "^\\sw+:\\s-+") | ||
| 157 | (goto-char (match-end 0))) | ||
| 158 | (buffer-substring (point) (line-end-position)))) | ||
| 159 | (let ((file "/etc/lsb-release")) | ||
| 160 | (and (file-readable-p file) | ||
| 161 | (with-temp-buffer | ||
| 162 | (insert-file-contents file) | ||
| 163 | (if (re-search-forward | ||
| 164 | "^\\sw*DISTRIB_DESCRIPTION=\"?\\(.*release.*?\\)\"?$" nil t) | ||
| 165 | (match-string 1))))) | ||
| 166 | (catch 'found | ||
| 167 | (dolist (f (append (file-expand-wildcards "/etc/*-release") | ||
| 168 | '("/etc/debian_version"))) | ||
| 169 | (and (not (member (file-name-nondirectory f) | ||
| 170 | '("lsb-release" "os-release"))) | ||
| 171 | (file-readable-p f) | ||
| 172 | (with-temp-buffer | ||
| 173 | (insert-file-contents f) | ||
| 174 | (if (not (zerop (buffer-size))) | ||
| 175 | (throw 'found | ||
| 176 | (format "%s%s" | ||
| 177 | (if (equal (file-name-nondirectory f) | ||
| 178 | "debian_version") | ||
| 179 | "Debian " "") | ||
| 180 | (buffer-substring | ||
| 181 | (line-beginning-position) | ||
| 182 | (line-end-position))))))))))))) | ||
| 183 | |||
| 119 | ;; It's the default mail mode, so it seems OK to use its features. | 184 | ;; It's the default mail mode, so it seems OK to use its features. |
| 120 | (autoload 'message-bogus-recipient-p "message") | 185 | (autoload 'message-bogus-recipient-p "message") |
| 121 | (autoload 'message-make-address "message") | 186 | (autoload 'message-make-address "message") |
| @@ -232,30 +297,7 @@ usually do not have translators for other languages.\n\n"))) | |||
| 232 | "', version " | 297 | "', version " |
| 233 | (mapconcat 'number-to-string (x-server-version) ".") "\n") | 298 | (mapconcat 'number-to-string (x-server-version) ".") "\n") |
| 234 | (error t))) | 299 | (error t))) |
| 235 | (let (os) | 300 | (let ((os (ignore-errors (report-emacs-bug--os-description)))) |
| 236 | ;; Maybe this should be factored out in a standalone function, | ||
| 237 | ;; eg emacs-os-description. | ||
| 238 | (cond ((eq system-type 'darwin) | ||
| 239 | (with-temp-buffer | ||
| 240 | (when (eq 0 (ignore-errors | ||
| 241 | (call-process "sw_vers" nil '(t nil) nil))) | ||
| 242 | (dolist (s '("ProductName" "ProductVersion")) | ||
| 243 | (goto-char (point-min)) | ||
| 244 | (if (re-search-forward (format "^%s\\s-*:\\s-+\\(.*\\)$" s) | ||
| 245 | nil t) | ||
| 246 | (setq os (concat os " " (match-string 1)))))))) | ||
| 247 | ;; TODO include other branches here. | ||
| 248 | ;; MS Windows: systeminfo ? | ||
| 249 | ;; Cygwin, *BSD, etc: ? | ||
| 250 | (t | ||
| 251 | (with-temp-buffer | ||
| 252 | (when (eq 0 (ignore-errors | ||
| 253 | (call-process "lsb_release" nil '(t nil) | ||
| 254 | nil "-d"))) | ||
| 255 | (goto-char (point-min)) | ||
| 256 | (if (looking-at "^\\sw+:\\s-+") | ||
| 257 | (goto-char (match-end 0))) | ||
| 258 | (setq os (buffer-substring (point) (line-end-position))))))) | ||
| 259 | (if (stringp os) | 301 | (if (stringp os) |
| 260 | (insert "System Description: " os "\n\n"))) | 302 | (insert "System Description: " os "\n\n"))) |
| 261 | (let ((message-buf (get-buffer "*Messages*"))) | 303 | (let ((message-buf (get-buffer "*Messages*"))) |