[Emacs-diffs] /srv/bzr/emacs/trunk r111503: * lisp/jit-lock.el (jit-lock-debug-mode): New minor mode.

[Stefan Monnier]

------------------------------------------------------------
revno: 111503
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sat 2013-01-12 20:23:48 -0500
message:
  * 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.
modified:
  etc/NEWS
  lisp/ChangeLog
  lisp/emacs-lisp/timer.el
  lisp/jit-lock.el
  lisp/subr.el

=== modified file 'etc/NEWS'
--- a/etc/NEWS  2013-01-10 02:45:31 +0000
+++ b/etc/NEWS  2013-01-13 01:23:48 +0000
@@ -66,6 +66,8 @@
 
 * 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.
 

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-01-12 19:24:27 +0000
+++ b/lisp/ChangeLog    2013-01-13 01:23:48 +0000
@@ -1,3 +1,13 @@
+2013-01-13  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * autorevert.el (auto-revert-notify-watch-descriptor): Give it

=== modified file 'lisp/emacs-lisp/timer.el'
--- a/lisp/emacs-lisp/timer.el  2013-01-01 09:11:05 +0000
+++ b/lisp/emacs-lisp/timer.el  2013-01-13 01:23:48 +0000
@@ -307,13 +307,13 @@
          ;; 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"))))

=== modified file 'lisp/jit-lock.el'
--- a/lisp/jit-lock.el  2013-01-01 09:11:05 +0000
+++ b/lisp/jit-lock.el  2013-01-13 01:23:48 +0000
@@ -257,6 +257,47 @@
         (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 @@
                      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))

=== modified file 'lisp/subr.el'
--- a/lisp/subr.el      2013-01-04 03:42:11 +0000
+++ b/lisp/subr.el      2013-01-13 01:23:48 +0000
@@ -3367,16 +3367,17 @@
               (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")