Re: compilation-forget-errors still used by tex-mode.el

[Stefan Monnier]

>> Simply running tex returns an error:
>> address@hidden:~/.tmp$ emacs -batch a.tex -f tex-file
>> (No files need saving)
>> Symbol's function definition is void: compilation-forget-errors

> Thanks.  Indeed the tex-mode support for compile.el needs to be rewritten.
> I'll look into it.

In the mean time, the following patch seems to get it working again.


        Stefan


--- compile.el.~1.286.~ 2004-03-11 17:46:58.000000000 -0500
+++ compile.el  2004-03-18 14:25:16.000000000 -0500
@@ -33,7 +33,6 @@
 ;;; Code:
 
 ;; This is the parsing engine for compile:
-(require 'font-lock) ; needed to get font-lock-value-in-major-mode
 
 ;;; This mode uses some complex data-structures:
 
@@ -138,6 +137,9 @@
     (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
                                 minor-mode-alist)))
 
+(defvar compilation-parsing-end nil
+  "Marker position of the last error parsed.")
+
 (defvar compilation-error "error"
   "Stem of message to print when no matches are found.")
 
@@ -643,9 +645,51 @@
                            "mouse-2: visit this file"))
             mouse-face highlight))))
 
+;; Compatibility with the old compile.el.
+(defvar compilation-parse-errors-function nil)
+(defvar compilation-error-list nil)
+(defvar compilation-old-error-list nil)
+(defun compilation-compat-parse-errors (limit &optional find-at-least)
+  (when compilation-parse-errors-function
+    (save-excursion
+      (setq compilation-error-list nil)
+      ;; Some parsing functions don't use point and limit as they're
+      ;; supposed to but use compilation-parsing-end instead: let's
+      ;; fool them.
+      (let ((compilation-parsing-end (point-marker)))
+       ;; We're running this code as the text gets inserted rather than
+       ;; when the user hits C-x `, so some functions sometimes fail
+       ;; because their context is not ready yet.
+       (condition-case nil
+           (funcall compilation-parse-errors-function limit nil)
+         (error nil))
+       (set-marker compilation-parsing-end nil))
+      ;; Turn the old style error-list into new style text-properties.
+      (dolist (err (if (listp compilation-error-list) compilation-error-list))
+       (let* ((src (car err))
+              (dst (cdr err))
+              (loc (cond ((markerp dst) (list nil nil nil dst))
+                         ((consp dst)
+                          (list (nth 2 dst) (nth 1 dst)
+                                (cons (cdar dst) (caar dst)))))))
+         (when loc
+           (goto-char src)
+           ;; (put-text-property src (line-end-position)
+           ;;                 'face 'font-lock-warning-face)
+           (put-text-property src (line-end-position)
+                              'message (list loc 2)))))))
+  ;; Advance to limit and return nil to tell font-lock that we've parsed it
+  ;; all and it doesn't have anything left to do.
+  (goto-char limit)
+  nil)
+
 (defun compilation-mode-font-lock-keywords ()
   "Return expressions to highlight in Compilation mode."
-  (nconc
+  (if compilation-parse-errors-function
+      ;; Pretend we're the old compile.el.
+      '((compilation-compat-parse-errors))
+    (append
+     ;; '((compilation-compat-parse-errors))
    ;; make directory tracking
    (if compilation-directory-matcher
        `((,(car compilation-directory-matcher)
@@ -657,7 +701,8 @@
                    (cdr compilation-directory-matcher)))))
 
    ;; Compiler warning/error lines.
-   (mapcar (lambda (item)
+     (mapcar
+      (lambda (item)
             (if (symbolp item)
                 (setq item (cdr (assq item
                                       compilation-error-regexp-alist-alist))))
@@ -698,7 +743,7 @@
                  append))))            ; for compilation-message-face
           compilation-error-regexp-alist)
 
-   compilation-mode-font-lock-keywords))
+     compilation-mode-font-lock-keywords)))
 
 
 ;;;###autoload
@@ -1083,21 +1128,18 @@
   "Prepare the buffer for the compilation parsing commands to work."
   (make-local-variable 'compilation-error-screen-columns)
   (setq compilation-last-buffer (current-buffer))
-  (if minor
-      (if font-lock-defaults
+  (set (make-local-variable 'compilation-parsing-end) (point-min-marker))
+  (if (and minor font-lock-defaults)
          (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
        (set (make-local-variable 'font-lock-defaults)
             '(compilation-mode-font-lock-keywords t)))
-    (set (make-local-variable 'font-lock-defaults)
-        '(compilation-mode-font-lock-keywords t)))
   (set (make-local-variable 'font-lock-extra-managed-props)
        '(directory message help-echo mouse-face debug))
   (set (make-local-variable 'compilation-locs)
        (make-hash-table :test 'equal :weakness 'value))
   ;; lazy-lock would never find the message unless it's scrolled to
-  ;; jit-lock might fontify some things too late
-  (if (font-lock-value-in-major-mode font-lock-support-mode)
-      (set (make-local-variable 'font-lock-support-mode) nil))
+  ;; jit-lock might fontify some things too late.
+  (set (make-local-variable 'font-lock-support-mode) nil)
   (set (make-local-variable 'font-lock-maximum-size) nil)
   (if minor
       (if font-lock-mode
@@ -1202,12 +1244,13 @@
   "Process filter for compilation buffers.
 Just inserts the text, but uses `insert-before-markers'."
   (if (buffer-name (process-buffer proc))
-      (save-excursion
-       (set-buffer (process-buffer proc))
-       (let ((buffer-read-only nil))
+      (with-current-buffer (process-buffer proc)
+       (let ((inhibit-read-only t)
+             (end (marker-position compilation-parsing-end)))
          (save-excursion
            (goto-char (process-mark proc))
            (insert-before-markers string)
+           (set-marker compilation-parsing-end end) ;Don't move it!
            (run-hooks 'compilation-filter-hook))))))
 
 (defsubst compilation-buffer-p (buffer)
@@ -1270,7 +1313,7 @@
                          "Moved past last %s"))
       (compilation-loop < previous-single-property-change 1+
                        "Moved back before first %s"))
-    (goto-char pt)
+    (set-marker compilation-parsing-end (goto-char pt))
     (or msg
        (error "No %s here" compilation-error))))
 
@@ -1388,6 +1431,7 @@
 See variable `compilation-error-regexp-alist' for customization ideas."
   (interactive "p")
   (set-buffer (setq compilation-last-buffer (compilation-find-buffer)))
+  (goto-char compilation-parsing-end)
   (let* ((columns compilation-error-screen-columns) ; buffer's local value
         (last 1)
         (loc (compilation-next-error n))
@@ -1526,12 +1570,13 @@
     (when (and highlight-regexp
               (not (and end-mk transient-mark-mode)))
       (unless compilation-highlight-overlay
-       (setq compilation-highlight-overlay (make-overlay 1 1))
+       (setq compilation-highlight-overlay
+             (make-overlay (point-min) (point-min)))
        (overlay-put compilation-highlight-overlay 'face 'region))
       (with-current-buffer (marker-buffer mk)
        (save-excursion
          (end-of-line)
-         (let ((end (point)) olay)
+         (let ((end (point)))
            (beginning-of-line)
            (if (and (stringp highlight-regexp)
                     (re-search-forward highlight-regexp end t))
@@ -1539,7 +1584,7 @@
                  (goto-char (match-beginning 0))
                  (move-overlay compilation-highlight-overlay (match-beginning 
0) (match-end 0)))
              (move-overlay compilation-highlight-overlay (point) end))
-           (sit-for 0 500)
+           (sit-for 0.5)
            (delete-overlay compilation-highlight-overlay)))))))
 
 
@@ -1592,6 +1637,15 @@
              (overlays-in (point-min) (point-max)))
       buffer)))
 
+;; Set compilation-error-list to nil, and unchain the markers that point to the
+;; error messages and their text, so that they no longer slow down gap motion.
+;; This would happen anyway at the next garbage collection, but it is better to
+;; do it right away.
+(defun compilation-forget-errors ()
+  ;; FIXME: should we do something more like throw away markers
+  ;; and/or force a font-lock refresh?  --stef
+  (set-marker compilation-parsing-end (point-min)))
+
 (defun compilation-normalize-filename (filename)
   "Convert a filename string found in an error message to make it usable."