* lisp/jit-lock.el (jit-lock-debug-mode): New minor mode.

(jit-lock--debug-fontifying): New var.
(jit-lock--debug-fontify): New function.
* lisp/subr.el (condition-case-unless-debug): Don't prevent catching the
error, just let the debbugger run.
* lisp/emacs-lisp/timer.el (timer-event-handler): Don't prevent debugging
timer code and don't drop errors silently.

5 files changed, 67 insertions, 12 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 52429a3e21d..758d9c096be 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -66,6 +66,8 @@ bound to <f11> and M-<f10>, respectively.
 
 * Changes in Specialized Modes and Packages in Emacs 24.4
 
+** jit-lock-debug-mode lets you use the debuggers on code run via jit-lock.
+
 ** completing-read-multiple's separator can now be a regexp.
 The default separator is changed to allow surrounding spaces around the comma.
 
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7723528c886..73e096adc5e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2013-01-13  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * jit-lock.el (jit-lock-debug-mode): New minor mode.
+        (jit-lock--debug-fontifying): New var.
+        (jit-lock--debug-fontify): New function.
+        * subr.el (condition-case-unless-debug): Don't prevent catching the
+        error, just let the debbugger run.
+        * emacs-lisp/timer.el (timer-event-handler): Don't prevent debugging
+        timer code and don't drop errors silently.
+
 2013-01-12  Michael Albinus  <michael.albinus@gmx.de>
 
         * autorevert.el (auto-revert-notify-watch-descriptor): Give it
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 3eaacd24ec8..8b019d0a785 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -307,13 +307,13 @@ This function is called, by name, directly by the C code."
           ;; Run handler.
           ;; We do this after rescheduling so that the handler function
           ;; can cancel its own timer successfully with cancel-timer.
-          (condition-case nil
+          (condition-case-unless-debug err
               ;; Timer functions should not change the current buffer.
               ;; If they do, all kinds of nasty surprises can happen,
               ;; and it can be hellish to track down their source.
               (save-current-buffer
                 (apply (timer--function timer) (timer--args timer)))
-            (error nil))
+            (error (message "Error in timer: %S" err)))
           (if retrigger
               (setf (timer--triggered timer) nil)))
       (error "Bogus timer event"))))
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 7be5df72c84..668f1ec963a 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -257,6 +257,47 @@ the variable `jit-lock-stealth-nice'."
          (remove-hook 'after-change-functions 'jit-lock-after-change t)
          (remove-hook 'fontification-functions 'jit-lock-function))))
 
+(define-minor-mode jit-lock-debug-mode
+  "Minor mode to help debug code run from jit-lock.
+When this minor mode is enabled, jit-lock runs as little code as possible
+during redisplay and moves the rest to a timer, where things
+like `debug-on-error' and Edebug can be used."
+  :global t
+  (when jit-lock-defer-timer
+    (cancel-timer jit-lock-defer-timer)
+    (setq jit-lock-defer-timer nil))
+  (when jit-lock-debug-mode
+    (setq jit-lock-defer-timer
+          (run-with-idle-timer 0 t #'jit-lock--debug-fontify))))
+
+(defvar jit-lock--debug-fontifying nil)
+
+(defun jit-lock--debug-fontify ()
+  "Fontify what was deferred for debugging."
+  (when (and (not jit-lock--debug-fontifying)
+             jit-lock-defer-buffers (not memory-full))
+    (let ((jit-lock--debug-fontifying t)
+          (inhibit-debugger nil))       ;FIXME: Not sufficient!
+      ;; Mark the deferred regions back to `fontified = nil'
+      (dolist (buffer jit-lock-defer-buffers)
+        (when (buffer-live-p buffer)
+          (with-current-buffer buffer
+            ;; (message "Jit-Debug %s" (buffer-name))
+            (with-buffer-prepared-for-jit-lock
+                (let ((pos (point-min)))
+                  (while
+                      (progn
+                        (when (eq (get-text-property pos 'fontified) 'defer)
+                          (let ((beg pos)
+                                (end (setq pos (next-single-property-change
+                                                pos 'fontified
+                                                nil (point-max)))))
+                            (put-text-property beg end 'fontified nil)
+                            (jit-lock-fontify-now beg end)))
+                        (setq pos (next-single-property-change
+                                   pos 'fontified)))))))))
+      (setq jit-lock-defer-buffers nil))))
+
 (defun jit-lock-register (fun &optional contextual)
   "Register FUN as a fontification function to be called in this buffer.
 FUN will be called with two arguments START and END indicating the region
@@ -504,7 +545,8 @@ non-nil in a repeated invocation of this function."
                       pos (setq pos (next-single-property-change
                                      pos 'fontified nil (point-max)))
                       'fontified nil))
-                   (setq pos (next-single-property-change pos 'fontified)))))))))
+                   (setq pos (next-single-property-change
+                              pos 'fontified)))))))))
     (setq jit-lock-defer-buffers nil)
     ;; Force fontification of the visible parts.
     (let ((jit-lock-defer-timer nil))
diff --git a/lisp/subr.el b/lisp/subr.el
index 11e882d9158..e1ab5298409 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3367,16 +3367,17 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced."
                (progn ,@body)))))))
 
 (defmacro condition-case-unless-debug (var bodyform &rest handlers)
-  "Like `condition-case' except that it does not catch anything when debugging.
-More specifically if `debug-on-error' is set, then it does not catch any signal."
+  "Like `condition-case' except that it does not prevent debugging.
+More specifically if `debug-on-error' is set then the debugger will be invoked
+even if this catches the signal."
   (declare (debug condition-case) (indent 2))
-  (let ((bodysym (make-symbol "body")))
-    `(let ((,bodysym (lambda () ,bodyform)))
-       (if debug-on-error
-           (funcall ,bodysym)
-         (condition-case ,var
-             (funcall ,bodysym)
-           ,@handlers)))))
+  `(condition-case ,var
+       ,bodyform
+     ,@(mapcar (lambda (handler)
+                 `((debug ,@(if (listp (car handler)) (car handler)
+                              (list (car handler))))
+                   ,@(cdr handler)))
+               handlers)))
 
 (define-obsolete-function-alias 'condition-case-no-debug
   'condition-case-unless-debug "24.1")