branch: master
commit ac8f004b1f82110ed5d09880ae05fcfc8bde08c9
Author: Artur Malabarba <bruce.connor...@gmail.com>
Commit: Artur Malabarba <bruce.connor...@gmail.com>
packages/bug-hunter: Interactive hunt
---
packages/bug-hunter/bug-hunter.el | 236 +++++++++++++++++++++++++------------
1 files changed, 163 insertions(+), 73 deletions(-)
diff --git a/packages/bug-hunter/bug-hunter.el
b/packages/bug-hunter/bug-hunter.el
index 2d0fc50..0538ac6 100644
--- a/packages/bug-hunter/bug-hunter.el
+++ b/packages/bug-hunter/bug-hunter.el
@@ -4,7 +4,7 @@
;; Author: Artur Malabarba <em...@endlessparentheses.com>
;; URL: http://github.com/Malabarba/elisp-bug-hunter
-;; Version: 0.2
+;; Version: 0.5
;; Keywords: lisp
;; Package-Requires: ((seq "1.3") (cl-lib "0.5"))
@@ -22,27 +22,46 @@
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
-;;
-;; The Bug Hunter is an Emacs library that finds the source of an error or
-;; unexpected behavior inside an elisp configuration file (typically
-;; `init.el' or `.emacs').
+;; An Emacs library that finds the source of an error or unexpected
+;; behavior inside an elisp configuration file (typically `init.el' or
+;; `.emacs').
;;
;; Usage Examples
;; ==============
;;
+;; Automated error hunting
+;; ~~~~~~~~~~~~~~~~~~~~~~~
+;;
;; If your Emacs init file signals an error during startup, but you don’t
;; know why, simply issue
;; ,----
-;; | M-x bug-hunter-init-file RET RET
+;; | M-x bug-hunter-init-file RET e
;; `----
;; and The Bug Hunter will find it for you. Note that your `init.el' (or
;; `.emacs') must be idempotent for this to work.
;;
+;;
+;; Interactive hunt
+;; ~~~~~~~~~~~~~~~~
+;;
;; If Emacs starts up without errors but something is not working as it
-;; should, invoke the same command, but give it in an assertion.
-;; Essentially, if you can write a snippet that detects the issue and
-;; returns non-nil, just provide this snippet as the assertion and the
-;; Bug Hunter will do a bisection search for you.
+;; should, invoke the same command, but choose the interactive option:
+;; ,----
+;; | M-x bug-hunter-init-file RET i
+;; `----
+;; The Bug Hunter will start a separate Emacs frame several times, and
+;; then it will ask you each time whether that frame presented the
+;; problem you have. After doing this about 5--12 times, you’ll be given
+;; the results.
+;;
+;;
+;; Assertion hunt
+;; ~~~~~~~~~~~~~~
+;;
+;; The Bug Hunter can also find your issue based on an assertion.
+;; Essentially, if you can write a code snippet that returns non-nil when
+;; it detects the issue, just provide this snippet as the assertion and
+;; the Bug Hunter will do the rest.
;;
;; For example, let’s say there’s something in your init file that’s
;; loading the `cl' library, and you don’t want that. You /know/ you’re
@@ -50,12 +69,12 @@
;; package is responsible for this outrage?
;;
;; ,----
-;; | M-x bug-hunter-init-file RET (featurep 'cl) RET
+;; | M-x bug-hunter-init-file RET a (featurep 'cl) RET
;; `----
;;
;; *That’s it!* You’ll be given a nice buffer reporting the results:
;;
-;; - Are you getting obscure errors when trying to open /“.tex”/ files?
+;; - Are you getting obscure errors when trying to open /".tex"/ files?
;; - Don’t despair! Just use `(find-file "dummy.tex")' as the
;; assertion.
;; - Did `ox-html' stop working due to some arcane misconfiguration?
@@ -66,13 +85,26 @@
;; you!
;;
;; Finally, you can also use `bug-hunter-file' to hunt in other files.
-
+;;
+;;
+;; init.org and other literate-style configs
+;; =========================================
+;;
+;; Please see the full Readme on http://github.com/Malabarba/elisp-bug-hunter
;;; Code:
(require 'seq)
(require 'cl-lib)
-(defvar bug-hunter--assertion-reminder
+(defconst bug-hunter--interactive-explanation
+ "You have asked to do an interactive hunt, here's how it goes.
+1) I will start a new Emacs frame.
+2) You will try to reproduce your problem on the new frame.
+3) When you’re done, close that frame.
+4) I will ask you if you managed to reproduce the problem.
+5) We will repeat steps up to %s times, so hang tight!")
+
+(defconst bug-hunter--assertion-reminder
"Remember, the assertion must be an expression that returns
non-nil in your current (problematic) Emacs state, AND that
returns nil on a clean Emacs instance."
@@ -133,6 +165,7 @@ R is passed to `format' and inserted."
R is passed to `bug-hunter--report-print'."
(declare (indent 1))
(apply #'bug-hunter--report-print r)
+ (redisplay)
(apply #'message r))
(defun bug-hunter--report-user-error (&rest r)
@@ -140,18 +173,22 @@ R is passed to `bug-hunter--report-print'."
R is passed to `bug-hunter--report-print'."
(declare (indent 1))
(apply #'bug-hunter--report-print r)
- (bug-hunter--report-print "\xc")
+ (bug-hunter--report-print "\xc\n")
(apply #'user-error r))
(defvar compilation-error-regexp-alist)
-(defun bug-hunter--init-report-buffer ()
- "Create and prepare the \"*Bug-Hunter Report*\" buffer."
- (or (get-buffer "*Bug-Hunter Report*")
- (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
- (compilation-mode "Bug Hunt")
- (set (make-local-variable 'compilation-error-regexp-alist)
- '(comma))
- (current-buffer))))
+(defun bug-hunter--init-report-buffer (assertion steps)
+ "Create and prepare the \"*Bug-Hunter Report*\" buffer.
+Also add some descriptions depending on ASSERTION."
+ (with-current-buffer (get-buffer-create "*Bug-Hunter Report*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (compilation-mode "Bug Hunt")
+ (set (make-local-variable 'compilation-error-regexp-alist)
+ '(comma))
+ (pcase assertion
+ (`interactive (insert (format bug-hunter--interactive-explanation (+ 2
steps))))))
+ (current-buffer)))
(defun bug-hunter--pretty-format (value padding)
"Return a VALUE as a string with PADDING spaces on the left."
@@ -207,42 +244,75 @@ the file."
(when expression
(bug-hunter--report " Caused by the following expression:\n%s"
(bug-hunter--pretty-format expression 4)))
- (bug-hunter--report "\xc")
+ (bug-hunter--report "\xc\n")
`[,error ,line ,column ,expression])
;;; Execution functions
-(defun bug-hunter--run-form (form)
- "Run FORM with \"emacs -Q\" and return the result."
+(defun bug-hunter--print-to-temp (sexp)
+ "Print SEXP to a temp file and return the file name."
+ (let ((print-length nil)
+ (print-level nil)
+ (file (make-temp-file "bug-hunter")))
+ (with-temp-file file
+ (print sexp (current-buffer)))
+ file))
+
+(defun bug-hunter--run-emacs (file &rest args)
+ "Start an Emacs process to run FILE and return the output buffer.
+ARGS are passed before \"-l FILE\"."
(let ((out-buf (generate-new-buffer "*Bug-Hunter Command*"))
(exec (file-truename (expand-file-name invocation-name
- invocation-directory)))
- (file-name (make-temp-file "bug-hunter")))
+ invocation-directory))))
+ (apply #'call-process exec nil out-buf nil
+ (append args (list "-l" file)))
+ out-buf))
+
+(defun bug-hunter--run-form (form)
+ "Run FORM with \"emacs -Q\" and return the result."
+ (let ((file-name (bug-hunter--print-to-temp (list 'prin1 form))))
(unwind-protect
- (let ((print-length nil)
- (print-level nil))
- (with-temp-file file-name
- (print (list 'prin1 form) (current-buffer)))
- (call-process exec nil out-buf nil
- "-Q" "--batch" "-l" file-name)
- (with-current-buffer out-buf
- (goto-char (point-max))
- (forward-sexp -1)
- (prog1 (read (current-buffer))
- (kill-buffer (current-buffer)))))
+ (with-current-buffer (bug-hunter--run-emacs file-name "-Q" "--batch")
+ (goto-char (point-max))
+ (forward-sexp -1)
+ (prog1 (read (current-buffer))
+ (kill-buffer (current-buffer))))
(delete-file file-name))))
+(defun bug-hunter--run-form-interactively (form)
+ "Run FORM in a graphical frame and ask user about the outcome."
+ (let ((file-name (bug-hunter--print-to-temp (list 'prin1 form))))
+ (unwind-protect
+ (bug-hunter--run-emacs file-name "-Q")
+ (delete-file file-name))
+ (y-or-n-p "Did you find the problem/bug in this instance? ")))
+
+(defun bug-hunter--wrap-forms-for-eval (forms)
+ "Return FORMS wrapped in initialization code."
+ `(let ((server-name (make-temp-file "bug-hunter-temp-server-file")))
+ (delete-file server-name)
+ (if site-run-file (load site-run-file t t))
+ (run-hooks 'before-init-hook)
+ ,@forms
+ (package-initialize)
+ (run-hooks 'after-init-hook)))
+
(defun bug-hunter--run-and-test (forms assertion)
"Execute FORMS in the background and test ASSERTION.
-See `bug-hunter' for a description on the ASSERTION."
- (bug-hunter--run-form
- `(condition-case er
- (let ((server-name (make-temp-file "bug-hunter-temp-server-file")))
- (delete-file server-name)
- ,@forms
- (run-hooks 'after-init-hook)
- ,assertion)
- (error (cons 'bug-caught er)))))
+See `bug-hunter' for a description on the ASSERTION.
+
+If ASSERTION is 'interactive, the form is run through
+`bug-hunter--run-form-interactively'. Otherwise, a slightly
+modified version of the form combined with ASSERTION is run
+through `bug-hunter--run-form'."
+ (if (eq assertion 'interactive)
+ (bug-hunter--run-form-interactively
+ (bug-hunter--wrap-forms-for-eval forms))
+ (bug-hunter--run-form
+ `(condition-case er
+ ,(append (bug-hunter--wrap-forms-for-eval forms)
+ (list assertion))
+ (error (cons 'bug-caught er))))))
@@ -290,7 +360,6 @@ ASSERTION's return value.
If ASSERTION is nil, n is the position of the first form to
signal an error and value is (bug-caught . ERROR-SIGNALED)."
(let ((bug-hunter--i 0)
- (bug-hunter--estimate (ceiling (log (length forms) 2)))
(bug-hunter--current-head nil))
(condition-case-unless-debug nil
(apply #'bug-hunter--bisect assertion nil (bug-hunter--split forms))
@@ -318,10 +387,16 @@ Bug hunter will refuse to hunt if (i) an error is
signaled or the
assertion is triggered while running emacs -Q, or (ii) no errors
are signaled and the assertion is not triggered after all EXPRs
are evaluated."
- (pop-to-buffer (bug-hunter--init-report-buffer))
(let ((expressions (unless (eq (car-safe rich-forms) 'bug-caught)
- (mapcar #'car rich-forms))))
+ (mapcar #'car rich-forms)))
+ (bug-hunter--estimate (ceiling (log (length rich-forms) 2))))
+ ;; Prepare buffer, and make sure they've seen it.
+ (switch-to-buffer (bug-hunter--init-report-buffer assertion
bug-hunter--estimate))
+ (when (eq assertion 'interactive)
+ (read-char-choice "Please the instructions above and type 6 when ready.
" '(?6)))
+
(cond
+ ;; Check for errors when reading the init file.
((not expressions)
(apply #'bug-hunter--report-error (cdr rich-forms))
(apply #'vector (cdr rich-forms)))
@@ -368,34 +443,49 @@ There's nothing more I can do here.")
(list 'assertion-triggered ret)
(car linecol) (cadr linecol) expression)))))))))
+(defconst bug-hunter--hunt-type-prompt
+ "To bisect interactively, type i
+To use automatic error detection, type e
+To provide a lisp assertion, type a
+=> ")
+
(defun bug-hunter--read-from-minibuffer ()
"Read a list of expressions from the minibuffer.
-Wraps them in a progn if necessary."
- (require 'simple)
- (let ((exprs
- (with-temp-buffer
- ;; Copied from `read--expression'.
- (let ((minibuffer-completing-symbol t))
- (minibuffer-with-setup-hook
- (lambda ()
- (add-hook 'completion-at-point-functions
- #'elisp-completion-at-point nil t)
- (run-hooks 'eval-expression-minibuffer-setup-hook))
- (insert
- (read-from-minibuffer
- "Expression that returns nil if all is well (optional): "
- nil read-expression-map nil 'read-expression-history))))
- (goto-char (point-min))
- (mapcar #'car (bug-hunter--read-buffer)))))
- (if (cdr exprs)
- (cons #'progn exprs)
- (car exprs))))
+Wraps them in a progn if necessary to always return a single
+form.
+
+The user may decide to not provide input, in which case
+'interactive is returned. Note, this is different from the user
+typing `RET' at an empty prompt, in which case nil is returned."
+ (pcase (read-char-choice bug-hunter--hunt-type-prompt '(?i ?e ?a))
+ (`?i 'interactive)
+ (`?e nil)
+ (_
+ (require 'simple)
+ (let ((exprs
+ (with-temp-buffer
+ ;; Copied from `read--expression'.
+ (let ((minibuffer-completing-symbol t))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'completion-at-point-functions
+ #'elisp-completion-at-point nil t)
+ (run-hooks 'eval-expression-minibuffer-setup-hook))
+ (insert
+ (read-from-minibuffer
+ "Provide an assertion. This is a lisp expression that
returns nil if (and only if) everything is fine:\n => "
+ nil read-expression-map nil 'read-expression-history))))
+ (goto-char (point-min))
+ (mapcar #'car (bug-hunter--read-buffer)))))
+ (if (cdr exprs)
+ (cons #'progn exprs)
+ (car exprs))))))
;;;###autoload
(defun bug-hunter-file (file &optional assertion)
"Bisect FILE while testing ASSERTION.
All sexps in FILE are read and passed to `bug-hunter-hunt' as a
-list. See `bug-hunter-hunt' for how to use assertion."
+list. See `bug-hunter-hunt' for how to use ASSERTION."
(interactive
(list
(read-file-name "File to bisect: "
@@ -411,7 +501,7 @@ list. See `bug-hunter-hunt' for how to use assertion."
"Test ASSERTION throughout `user-init-file'.
All sexps inside `user-init-file' are read and passed to
`bug-hunter-hunt' as a list. See `bug-hunter-hunt' for how to use
-assertion."
+ASSERTION."
(interactive (list (bug-hunter--read-from-minibuffer)))
(bug-hunter-file user-init-file assertion))
