diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 9f33186d8b1..47711a90600 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -979,11 +979,6 @@ compilation-enter-directory-face (defvar compilation-leave-directory-face 'font-lock-builtin-face "Face name to use for leaving directory messages.") -;; Used for compatibility with the old compile.el. -(defvar compilation-parse-errors-function nil) -(make-obsolete-variable 'compilation-parse-errors-function - 'compilation-error-regexp-alist "24.1") - (defcustom compilation-auto-jump-to-first-error nil "If non-nil, automatically jump to the first error during compilation." :type '(choice (const :tag "Never" nil) @@ -1519,34 +1514,28 @@ compilation--parse-region (and proc (memq (process-status proc) '(run open)))) (setq end (line-beginning-position)))) (compilation--remove-properties start end) - (if compilation-parse-errors-function - ;; An old package! Try the compatibility code. - (progn - (goto-char start) - (compilation--compat-parse-errors end)) - - ;; compilation-directory-matcher is the only part that really needs to be - ;; parsed sequentially. So we could split it out, handle directories - ;; like syntax-propertize, and the rest as font-lock-keywords. But since - ;; we want to have it work even when font-lock is off, we'd then need to - ;; use our own compilation-parsed text-property to keep track of the parts - ;; that have already been parsed. - (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) - 'compilation-debug - (vector 'directory compilation-directory-matcher))) - (dolist (elt (cdr compilation-directory-matcher)) - (add-text-properties (match-beginning (car elt)) - (match-end (car elt)) - (compilation-directory-properties - (car elt) (cdr elt))))) - - (compilation-parse-errors start end))) + ;; compilation-directory-matcher is the only part that really needs to be + ;; parsed sequentially. So we could split it out, handle directories + ;; like syntax-propertize, and the rest as font-lock-keywords. But since + ;; we want to have it work even when font-lock is off, we'd then need to + ;; use our own compilation-parsed text-property to keep track of the parts + ;; that have already been parsed. + (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) + 'compilation-debug + (vector 'directory compilation-directory-matcher))) + (dolist (elt (cdr compilation-directory-matcher)) + (add-text-properties (match-beginning (car elt)) + (match-end (car elt)) + (compilation-directory-properties + (car elt) (cdr elt))))) + + (compilation-parse-errors start end)) (defun compilation--note-type (type) "Note that a new message with severity TYPE was seen. @@ -3259,73 +3248,11 @@ compilation--flush-file-structure (if (eq v fs) (remhash k compilation-locs))) compilation-locs))) -;;; Compatibility with the old compile.el. - -(defvaralias 'compilation-last-buffer 'next-error-last-buffer) -(defvar compilation-parsing-end (make-marker)) -(defvar compilation-error-list nil) -(defvar compilation-old-error-list nil) - -(defun compilation--compat-parse-errors (limit) - (when compilation-parse-errors-function - ;; FIXME: We should remove the rest of the compilation keywords - ;; but we can't do that from here because font-lock is using - ;; the value right now. --Stef - (save-excursion - (setq compilation-error-list nil) - ;; Reset compilation-parsing-end each time because font-lock - ;; might force us the re-parse many times (typically because - ;; some code adds some text-property to the output that we - ;; already parsed). You might say "why reparse", well: - ;; because font-lock has just removed the `compilation-message' property - ;; so have to do it all over again. - (if compilation-parsing-end - (set-marker compilation-parsing-end (point)) - (setq compilation-parsing-end (point-marker))) - (condition-case nil - ;; Ignore any error: we're calling this function earlier than - ;; in the old compile.el so things might not all be setup yet. - (funcall compilation-parse-errors-function limit nil) - (error nil)) - (dolist (err (if (listp compilation-error-list) compilation-error-list)) - (let* ((src (car err)) - (dst (cdr err)) - (loc (cond ((markerp dst) - (cons nil - (compilation--make-cdrloc nil nil dst))) - ((consp dst) - (cons (nth 2 dst) - (compilation--make-cdrloc - (nth 1 dst) - (cons (cdar dst) (caar dst)) - nil)))))) - (when loc - (goto-char src) - ;; (put-text-property src (line-end-position) - ;; 'font-lock-face 'font-lock-warning-face) - (put-text-property src (line-end-position) - 'compilation-message - (compilation--make-message loc 2 nil nil))))))) - (goto-char limit) - nil) - -;; Beware! this is not only compatibility code. New code also uses it. --Stef (defun compilation-forget-errors () ;; In case we hit the same file/line specs, we want to recompute a new ;; marker for them, so flush our cache. (clrhash compilation-locs) (setq compilation-gcpro nil) - ;; FIXME: the old code reset the directory-stack, so maybe we should - ;; put a `directory change' marker of some sort, but where? -stef - ;; - ;; FIXME: The old code moved compilation-current-error (which was - ;; virtually represented by a mix of compilation-parsing-end and - ;; compilation-error-list) to point-min, but that was only meaningful for - ;; the internal uses of compilation-forget-errors: all calls from external - ;; packages seem to be followed by a move of compilation-parsing-end to - ;; something equivalent to point-max. So we heuristically move - ;; compilation-current-error to point-max (since the external package - ;; won't know that it should do it). --Stef (setq compilation-current-error nil) (let* ((proc (get-buffer-process (current-buffer))) (mark (if proc (process-mark proc))) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 9598209f5e5..ec113d220d7 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -1628,8 +1628,6 @@ prolog-consult-compile-file (defvar prolog-consult-compile-real-file nil "The file name of the buffer to compile/consult.") -(defvar compilation-parse-errors-function) - (defun prolog-consult-compile (compilep file &optional first-line) "Consult/compile FILE. If COMPILEP is non-nil, perform compilation, otherwise perform CONSULTING. @@ -1655,14 +1653,14 @@ prolog-consult-compile ;; Setting up font-locking for this buffer (setq-local font-lock-defaults '(prolog-font-lock-keywords nil nil ((?_ . "w")))) - (if (eq prolog-system 'sicstus) - ;; FIXME: This looks really problematic: not only is this using - ;; the old compilation-parse-errors-function, but - ;; prolog-parse-sicstus-compilation-errors only accepts one argument - ;; whereas compile.el calls it with 2 (and did so at least since - ;; Emacs-20). - (setq-local compilation-parse-errors-function - 'prolog-parse-sicstus-compilation-errors)) + ;; (if (eq prolog-system 'sicstus) + ;; ;; FIXME: This looks really problematic: not only is this using + ;; ;; the old compilation-parse-errors-function, but + ;; ;; prolog-parse-sicstus-compilation-errors only accepts one + ;; ;; argument whereas compile.el calls it with 2 (and did so at + ;; ;; least since Emacs-20). + ;; (setq-local compilation-parse-errors-function + ;; #'prolog-parse-sicstus-compilation-errors)) (setq buffer-read-only nil) (insert command-string "\n")) (display-buffer buffer) @@ -1693,40 +1691,41 @@ prolog-consult-compile (defvar compilation-error-list) -(defun prolog-parse-sicstus-compilation-errors (limit) - "Parse the prolog compilation buffer for errors. -Argument LIMIT is a buffer position limiting searching. -For use with the `compilation-parse-errors-function' variable." - (setq compilation-error-list nil) - (message "Parsing SICStus error messages...") - (let (filepath dir file errorline) - (while - (re-search-backward - "{\\([a-zA-Z ]* ERROR\\|Warning\\):.* in line[s ]*\\([0-9]+\\)" - limit t) - (setq errorline (string-to-number (match-string 2))) - (save-excursion - (re-search-backward - "{\\(consulting\\|compiling\\|processing\\) \\(.*\\)\\.\\.\\.}" - limit t) - (setq filepath (match-string 2))) - - ;; ###### Does this work with SICStus under Windows - ;; (i.e. backslashes and stuff?) - (if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath) - (progn - (setq dir (match-string 1 filepath)) - (setq file (match-string 2 filepath)))) - - (setq compilation-error-list - (cons - (cons (save-excursion - (beginning-of-line) - (point-marker)) - (list (list file dir) errorline)) - compilation-error-list) - )) - )) +;; FIXME: This has been obsolete since Emacs-20! +;; (defun prolog-parse-sicstus-compilation-errors (limit) +;; "Parse the prolog compilation buffer for errors. +;; Argument LIMIT is a buffer position limiting searching. +;; For use with the `compilation-parse-errors-function' variable." +;; (setq compilation-error-list nil) +;; (message "Parsing SICStus error messages...") +;; (let (filepath dir file errorline) +;; (while +;; (re-search-backward +;; "{\\([a-zA-Z ]* ERROR\\|Warning\\):.* in line[s ]*\\([0-9]+\\)" +;; limit t) +;; (setq errorline (string-to-number (match-string 2))) +;; (save-excursion +;; (re-search-backward +;; "{\\(consulting\\|compiling\\|processing\\) \\(.*\\)\\.\\.\\.}" +;; limit t) +;; (setq filepath (match-string 2))) + +;; ;; ###### Does this work with SICStus under Windows +;; ;; (i.e. backslashes and stuff?) +;; (if (string-match "\\(.*/\\)\\([^/]*\\)$" filepath) +;; (progn +;; (setq dir (match-string 1 filepath)) +;; (setq file (match-string 2 filepath)))) + +;; (setq compilation-error-list +;; (cons +;; (cons (save-excursion +;; (beginning-of-line) +;; (point-marker)) +;; (list (list file dir) errorline)) +;; compilation-error-list) +;; )) +;; )) (defun prolog-consult-compile-filter (process output) "Filter function for Prolog compilation PROCESS.