From b16cd3f1e57239887d393129969bdb702feb10d4 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 19 Oct 2020 12:39:51 +0200 Subject: [PATCH] Hoist some loop-invariant variable bindings in compile.el * lisp/progmodes/compile.el (compilation-parse-errors): Hoist the binding of case-fold-search and a memq call out of the loop, eliminating a minor but unnecessary quadratic term. --- lisp/progmodes/compile.el | 197 +++++++++++++++++++------------------- 1 file changed, 99 insertions(+), 98 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index bc0fe6d63a0..6c819db50da 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1473,105 +1473,106 @@ This updates the appropriate variable used by the mode-line." "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." - (dolist (item (or rules compilation-error-regexp-alist)) - (if (symbolp item) - (setq item (cdr (assq item - compilation-error-regexp-alist-alist)))) - (let ((case-fold-search compilation-error-case-fold-search) - (file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item)) - (type (nth 4 item)) - (pat (car item)) - end-line end-col fmt - props) - - ;; omake reports some error indented, so skip the indentation. - ;; another solution is to modify (some?) regexps in - ;; `compilation-error-regexp-alist'. - ;; note that omake usage is not limited to ocaml and C (for stubs). - ;; FIXME-omake: Doing it here seems wrong, at least it should depend on - ;; whether or not omake's own error messages are recognized. - (cond - ((not (memq 'omake compilation-error-regexp-alist)) nil) - ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) - nil) ;; Not anchored or anchored but already allows empty spaces. - (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) - - (if (and (consp file) (not (functionp file))) - (setq fmt (cdr file) - file (car file))) - (if (and (consp line) (not (functionp line))) - (setq end-line (cdr line) - line (car line))) - (if (and (consp col) (not (functionp col))) - (setq end-col (cdr col) - col (car col))) - - (unless (or (null (nth 5 item)) (integerp (nth 5 item))) - (error "HYPERLINK should be an integer: %s" (nth 5 item))) - - (goto-char start) - (while (re-search-forward pat end t) - (when (setq props (compilation-error-properties - file line end-line col end-col (or type 2) fmt)) - - (when (integerp file) - (let ((this-type (if (consp type) - (compilation-type type) - (or type 2)))) - (compilation--note-type this-type) - - (compilation--put-prop - file 'font-lock-face - (symbol-value (aref [compilation-info-face - compilation-warning-face - compilation-error-face] - this-type))))) - - (compilation--put-prop - line 'font-lock-face compilation-line-face) - (compilation--put-prop - end-line 'font-lock-face compilation-line-face) - - (compilation--put-prop - col 'font-lock-face compilation-column-face) - (compilation--put-prop - end-col 'font-lock-face compilation-column-face) - - ;; Obey HIGHLIGHT. - (dolist (extra-item (nthcdr 6 item)) - (let ((mn (pop extra-item))) - (when (match-beginning mn) - (let ((face (eval (car extra-item)))) - (cond - ((null face)) - ((or (symbolp face) (stringp face)) - (put-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face face)) - ((and (listp face) - (eq (car face) 'face) - (or (symbolp (cadr face)) - (stringp (cadr face)))) - (compilation--put-prop mn 'font-lock-face (cadr face)) - (add-text-properties - (match-beginning mn) (match-end mn) - (nthcdr 2 face))) - (t - (error "Don't know how to handle face %S" - face))))))) - (let ((mn (or (nth 5 item) 0))) - (when compilation-debug + (let ((case-fold-search compilation-error-case-fold-search) + (omake-included (memq 'omake compilation-error-regexp-alist))) + (dolist (item (or rules compilation-error-regexp-alist)) + (if (symbolp item) + (setq item (cdr (assq item + compilation-error-regexp-alist-alist)))) + (let ((file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item)) + (type (nth 4 item)) + (pat (car item)) + end-line end-col fmt + props) + + ;; omake reports some error indented, so skip the indentation. + ;; another solution is to modify (some?) regexps in + ;; `compilation-error-regexp-alist'. + ;; note that omake usage is not limited to ocaml and C (for stubs). + ;; FIXME-omake: Doing it here seems wrong, at least it should depend on + ;; whether or not omake's own error messages are recognized. + (cond + ((not omake-included) nil) + ((string-match "\\`\\([^^]\\|\\^\\( \\*\\|\\[\\)\\)" pat) + nil) ;; Not anchored or anchored but already allows empty spaces. + (t (setq pat (concat "^\\(?: \\)?" (substring pat 1))))) + + (if (and (consp file) (not (functionp file))) + (setq fmt (cdr file) + file (car file))) + (if (and (consp line) (not (functionp line))) + (setq end-line (cdr line) + line (car line))) + (if (and (consp col) (not (functionp col))) + (setq end-col (cdr col) + col (car col))) + + (unless (or (null (nth 5 item)) (integerp (nth 5 item))) + (error "HYPERLINK should be an integer: %s" (nth 5 item))) + + (goto-char start) + (while (re-search-forward pat end t) + (when (setq props (compilation-error-properties + file line end-line col end-col (or type 2) fmt)) + + (when (integerp file) + (let ((this-type (if (consp type) + (compilation-type type) + (or type 2)))) + (compilation--note-type this-type) + + (compilation--put-prop + file 'font-lock-face + (symbol-value (aref [compilation-info-face + compilation-warning-face + compilation-error-face] + this-type))))) + + (compilation--put-prop + line 'font-lock-face compilation-line-face) + (compilation--put-prop + end-line 'font-lock-face compilation-line-face) + + (compilation--put-prop + col 'font-lock-face compilation-column-face) + (compilation--put-prop + end-col 'font-lock-face compilation-column-face) + + ;; Obey HIGHLIGHT. + (dolist (extra-item (nthcdr 6 item)) + (let ((mn (pop extra-item))) + (when (match-beginning mn) + (let ((face (eval (car extra-item)))) + (cond + ((null face)) + ((or (symbolp face) (stringp face)) + (put-text-property + (match-beginning mn) (match-end mn) + 'font-lock-face face)) + ((and (listp face) + (eq (car face) 'face) + (or (symbolp (cadr face)) + (stringp (cadr face)))) + (compilation--put-prop mn 'font-lock-face (cadr face)) + (add-text-properties + (match-beginning mn) (match-end mn) + (nthcdr 2 face))) + (t + (error "Don't know how to handle face %S" + face))))))) + (let ((mn (or (nth 5 item) 0))) + (when compilation-debug + (font-lock-append-text-property + (match-beginning 0) (match-end 0) + 'compilation-debug (vector 'std item props))) + (add-text-properties + (match-beginning mn) (match-end mn) + (cddr props)) (font-lock-append-text-property - (match-beginning 0) (match-end 0) - 'compilation-debug (vector 'std item props))) - (add-text-properties - (match-beginning mn) (match-end mn) - (cddr props)) - (font-lock-append-text-property - (match-beginning mn) (match-end mn) - 'font-lock-face (cadr props)))))))) + (match-beginning mn) (match-end mn) + 'font-lock-face (cadr props))))))))) (defvar compilation--parsed -1) (make-variable-buffer-local 'compilation--parsed) -- 2.39.2