OSDN Git Service

c266437926b28cb107706e4ef60582a1b24f0e69
[howm/howm.git] / honest-report.el
1 ;;; honest-report.el --- make bug report with screenshot and keylog
2
3 ;; Copyright (C) 2005-2018
4 ;;   HIRAOKA Kazuyuki <khi@users.osdn.me>
5 ;;
6 ;; This program is free software; you can redistribute it and/or modify
7 ;; it under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 1, or (at your option)
9 ;; any later version.
10 ;;
11 ;; This program is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 ;; GNU General Public License for more details.
15 ;;
16 ;; The GNU General Public License is available by anonymouse ftp from
17 ;; prep.ai.mit.edu in pub/gnu/COPYING.  Alternately, you can write to
18 ;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139,
19 ;; USA.
20
21 ;;; Commentary:
22
23 ;; (For users)
24 ;; This small tool helps you write clear bug report.
25 ;; Just type M-x honest-report to show recent keys and screen shots.
26 ;; Copy them into your bug report.
27
28 ;; (For programmers)
29 ;; Write a wrapper of `honest-report' with your favorite header and footer.
30
31 ;; (Bug)
32 ;; Text properties are ignored in screen shot.
33 ;; In particular, too large region can be copied for outline-mode
34 ;; because all closed items are shown as opened.
35
36 ;;; Code:
37
38 (defun honest-report (&optional header footer)
39   (interactive)
40   (let ((ver (honest-report-version))
41         (key (honest-report-recent-keys))
42         (msg (honest-report-message))
43         (scr (honest-report-screenshot)))
44     (honest-report-setup)
45     (mapc (lambda (a) (apply #'honest-report-insert a))
46           `(
47             ("Header"          ,header)
48             ("Emacs version"   ,ver)
49             ("Recent keys"     ,key)
50             ("Recent messages" ,msg)
51             ("Screen shot"     ,scr)
52             ("Footer"          ,footer)
53             ))
54     (goto-char (point-max))))
55
56 (defun honest-report-insert (title content)
57   (when content
58     (insert "* " title ":\n\n" content "\n\n")))
59
60 ;;;;;;;;;;;;;
61
62 (defun honest-report-setup ()
63   (let ((report-buf (format-time-string "honest-report-%Y%m%d-%H%M%S")))
64     (switch-to-buffer report-buf)))
65
66 ;; snap:///usr/share/emacs/21.4/lisp/mail/emacsbug.el#136:(insert (mapconcat (lambda (key)
67 (defun honest-report-recent-keys ()
68   (mapconcat (lambda (key)
69                (if (or (integerp key)
70                        (symbolp key)
71                        (listp key))
72                    (single-key-description key)
73                  (prin1-to-string key nil)))
74              (recent-keys)
75              " "))
76
77 (defun honest-report-screenshot ()
78   (mapconcat (lambda (w)
79                (with-current-buffer (window-buffer w)
80                  (let ((b (max (window-start w) (point-min)))
81                        (e (min (window-end w t) (point-max))))
82                    (format "--- %s ---\n%s"
83                            w
84                            (buffer-substring-no-properties b e)))))
85              (honest-report-window-list)
86              "\n"))
87
88 (defun honest-report-window-list ()
89   "Mimic `window-list'.
90 This function exists only for emacs20 (and meadow-1.15),
91 which lack `window-list'."
92   (let ((ws nil))
93     (walk-windows (lambda (w) (setq ws (cons w ws))))
94     (reverse ws)))
95
96 (defun honest-report-message ()
97   (with-current-buffer (or (get-buffer "*Messages*")
98                            (get-buffer " *Message-Log*"))
99     (save-excursion
100       (goto-char (point-max))
101       (forward-line -10)
102       (buffer-substring-no-properties (point) (point-max)))))
103
104 (defun honest-report-version ()
105   (mapconcat (lambda (sv) (format "[%s] %s" (car sv) (cdr sv)))
106              (honest-report-version-assoc)
107              "\n"))
108
109 (defun honest-report-version-assoc ()
110   (remove nil
111           `(
112             ("Emacs" . ,(format "%s (%s) of %s"
113                               emacs-version
114                               system-configuration
115                               (honest-report-emacs-build-time)))
116             ("system" . ,system-type)
117             ("window system" . ,window-system)
118             ,(let ((f 'Meadow-version))
119                ;; cheat to avoid warning while byte-compilation.
120                (and (fboundp f)
121                     (cons "Meadow" (funcall f))))
122             ("ENV" . ,(mapconcat (lambda (v) (format "%s=%s" v (getenv v)))
123                                  '("LC_ALL" "LC_CTYPE" "LANGUAGE" "LANG")
124                                  ", "))
125             )))
126
127 (defun honest-report-emacs-build-time ()
128   (if (stringp emacs-build-time)
129       emacs-build-time  ;; xemacs
130     (format-time-string "%Y-%m-%d"
131                         emacs-build-time)))
132
133 ;;;;;;;;;;;;;
134
135 (provide 'honest-report)
136
137 ;;; honest-report.el ends here