From: Stefan Monnier Date: Sun, 13 Jan 2013 01:23:48 +0000 (-0500) Subject: * lisp/jit-lock.el (jit-lock-debug-mode): New minor mode. X-Git-Tag: emacs-24.3.90~173^2~7^2~319 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e5b5a34dd1b9cd428e988d1bbc2af658c3e25daa;p=emacs.git * 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. --- diff --git a/etc/NEWS b/etc/NEWS index 52429a3e21d..758d9c096be 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -66,6 +66,8 @@ bound to and M-, 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 + + * 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 * 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")