From: Stefan Monnier Date: Mon, 31 Jan 2011 17:09:42 +0000 (-0500) Subject: * lisp/progmodes/compile.el (compilation--flush-directory-cache): X-Git-Tag: emacs-pretest-24.0.90~104^2~618^2~1322^2~52 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9e11271c559360ab8df313aebdba1df067e4db9f;p=emacs.git * lisp/progmodes/compile.el (compilation--flush-directory-cache): New function, extracted from compilation--remove-properties. (compilation--remove-properties, compilation--parse-region): Use it. (compilation--previous-directory): Handle one more case. (compilation-enable-debug-messages): Remove. (compilation-parse-errors, compilation--flush-parse): Just remove the left over debug messages. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 462d57745c5..584bf71c744 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2011-01-31 Stefan Monnier + + * progmodes/compile.el (compilation--flush-directory-cache): + New function, extracted from compilation--remove-properties. + (compilation--remove-properties, compilation--parse-region): Use it. + (compilation--previous-directory): Handle one more case. + (compilation-enable-debug-messages): Remove. + (compilation-parse-errors, compilation--flush-parse): Just remove the + left over debug messages. + 2011-01-31 Sam Steingold * progmodes/compile.el (compilation-enable-debug-messages): @@ -5,7 +15,6 @@ 2011-01-28T22:12:05Z!monnier@iro.umontreal.ca optional. (compilation-parse-errors, compilation--flush-parse): Use it. - 2011-01-31 Deniz Dogan * net/rcirc.el: Clean log filenames (Bug#7933). @@ -14,8 +23,8 @@ 2011-01-30 Jan Djärv - * mail/emacsbug.el (report-emacs-bug-insert-to-mailer): Check - report-emacs-bug-can-use-osx-open and use that if t. + * mail/emacsbug.el (report-emacs-bug-insert-to-mailer): + Check report-emacs-bug-can-use-osx-open and use that if t. (report-emacs-bug-can-use-osx-open): New function. (report-emacs-bug): Rename can-xdg-email to can-insert-mail. Check report-emacs-bug-can-use-osx-open also for can-insert-mail. @@ -38,8 +47,8 @@ 2011-01-29 Daiki Ueno - * epg.el (epg--status-KEYEXPIRED, epg--status-KEYREVOKED): Don't - presume KEYEXPIRED and KEYREVOKED to be a fatal error status + * epg.el (epg--status-KEYEXPIRED, epg--status-KEYREVOKED): + Don't presume KEYEXPIRED and KEYREVOKED to be a fatal error status (Bug#7931). 2011-01-29 Stefan Monnier @@ -205,8 +214,8 @@ 2011-01-27 Sam Steingold - * midnight.el (clean-buffer-list-kill-never-buffer-names): Remove - "*server*" which is never created by emacs server. + * midnight.el (clean-buffer-list-kill-never-buffer-names): + Remove "*server*" which is never created by emacs server. 2011-01-27 Deniz Dogan diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 8bc0f221beb..f1a5801ea1a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -732,9 +732,6 @@ info, are considered errors." :group 'compilation :version "22.1") -(defvar compilation-enable-debug-messages nil - "Enable debug messages while parsing the compilation buffer.") - (defun compilation-set-skip-threshold (level) "Switch the `compilation-skip-threshold' level." (interactive @@ -837,38 +834,61 @@ from a different message." (:conc-name compilation--message->)) loc type end-loc) -(defvar compilation--previous-directory-cache nil) +(defvar compilation--previous-directory-cache nil + "A pair (POS . RES) caching the result of previous directory search. +Basically, this pair says that calling + (previous-single-property-change POS 'compilation-directory) +returned RES, i.e. there is no change of `compilation-directory' between +POS and RES.") (make-variable-buffer-local 'compilation--previous-directory-cache) + +(defun compilation--flush-directory-cache (start end) + (cond + ((or (not compilation--previous-directory-cache) + (<= (car compilation--previous-directory-cache) start))) + ((or (not (cdr compilation--previous-directory-cache)) + (<= (cdr compilation--previous-directory-cache) start)) + (set-marker (car compilation--previous-directory-cache) start)) + (t (setq compilation--previous-directory-cache nil)))) + (defun compilation--previous-directory (pos) "Like (previous-single-property-change POS 'compilation-directory), but faster." ;; This avoids an N² behavior when there's no/few compilation-directory ;; entries, in which case each call to previous-single-property-change ;; ends up having to walk very far back to find the last change. - (let* ((cache (and compilation--previous-directory-cache - (<= (car compilation--previous-directory-cache) pos) - (car compilation--previous-directory-cache))) - (prev - (previous-single-property-change - pos 'compilation-directory nil cache))) - (cond - ((null cache) - (setq compilation--previous-directory-cache - (cons (copy-marker pos) (copy-marker prev))) - prev) - ((eq prev cache) - (if cache - (set-marker (car compilation--previous-directory-cache) pos) + (if (and compilation--previous-directory-cache + (< pos (car compilation--previous-directory-cache)) + (or (null (cdr compilation--previous-directory-cache) + (< (cdr compilation--previous-directory-cache) pos)))) + ;; No need to call previous-single-property-change. + (cdr compilation--previous-directory-cache) + + (let* ((cache (and compilation--previous-directory-cache + (<= (car compilation--previous-directory-cache) pos) + (car compilation--previous-directory-cache))) + (prev + (previous-single-property-change + pos 'compilation-directory nil cache))) + (cond + ((null cache) (setq compilation--previous-directory-cache - (cons (copy-marker pos) nil))) - (cdr compilation--previous-directory-cache)) - (t - (if cache - (progn + (cons (copy-marker pos) (copy-marker prev))) + prev) + ((eq prev cache) + (if cache (set-marker (car compilation--previous-directory-cache) pos) - (setcdr compilation--previous-directory-cache (copy-marker prev))) - (setq compilation--previous-directory-cache - (cons (copy-marker pos) (copy-marker prev)))) - prev)))) + (setq compilation--previous-directory-cache + (cons (copy-marker pos) nil))) + (cdr compilation--previous-directory-cache)) + (t + (if cache + (progn + (set-marker (car compilation--previous-directory-cache) pos) + (setcdr compilation--previous-directory-cache + (copy-marker prev))) + (setq compilation--previous-directory-cache + (cons (copy-marker pos) (copy-marker prev)))) + prev))))) ;; Internal function for calculating the text properties of a directory ;; change message. The compilation-directory property is important, because it @@ -1099,14 +1119,6 @@ FMTS is a list of format specs for transforming the file name. (defun compilation--remove-properties (&optional start end) (with-silent-modifications - (cond - ((or (not compilation--previous-directory-cache) - (<= (car compilation--previous-directory-cache) start))) - ((or (not (cdr compilation--previous-directory-cache)) - (<= (cdr compilation--previous-directory-cache) start)) - (set-marker (car compilation--previous-directory-cache) start)) - (t (setq compilation--previous-directory-cache nil))) - ;; When compile.el used font-lock directly, we could just remove all ;; our text-properties in one go, but now that we manually place ;; font-lock-face, we have to be careful to only remove the font-lock-face @@ -1118,6 +1130,7 @@ FMTS is a list of format specs for transforming the file name. (let (next) (unless start (setq start (point-min))) (unless end (setq end (point-max))) + (compilation--flush-directory-cache start end) (while (progn (setq next (or (next-single-property-change @@ -1155,6 +1168,7 @@ FMTS is a list of format specs for transforming the file name. (goto-char start) (while (re-search-forward (car compilation-directory-matcher) end t) + (compilation--flush-directory-cache (match-beginning 0) (match-end 0)) (when compilation-debug (font-lock-append-text-property (match-beginning 0) (match-end 0) @@ -1172,8 +1186,6 @@ FMTS is a list of format specs for transforming the file name. "Parse errors between START and END. The errors recognized are the ones specified in RULES which default to `compilation-error-regexp-alist' if RULES is nil." - (when compilation-enable-debug-messages - (message "compilation-parse-errors: %S %S" start end)) (dolist (item (or rules compilation-error-regexp-alist)) (if (symbolp item) (setq item (cdr (assq item @@ -1302,8 +1314,6 @@ to `compilation-error-regexp-alist' if RULES is nil." (defun compilation--flush-parse (start end) "Mark the region between START and END for re-parsing." - (when compilation-enable-debug-messages - (message "compilation--flush-parse: %S %S" start end)) (if (markerp compilation--parsed) (move-marker compilation--parsed (min start compilation--parsed))))