[elpa] master ac8f004: packages/bug-hunter: Interactive hunt

[Artur Malabarba]

branch: master
commit ac8f004b1f82110ed5d09880ae05fcfc8bde08c9
Author: Artur Malabarba <address@hidden>
Commit: Artur Malabarba <address@hidden>

    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 <address@hidden>
 ;; 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))