]> code.delx.au - gnu-emacs/blobdiff - lisp/progmodes/compile.el
(compilation-start): Rely on `cd' to get dir right and also allow argumentless cd.
[gnu-emacs] / lisp / progmodes / compile.el
index 2c8ead870000c7541b4ca3167f1db4472baf8fc4..0dc73e966644a444b2209a887a1328fc1ba32fd8 100644 (file)
@@ -171,8 +171,15 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
      "^\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)\
 \\(?:[(. pos]+\\([0-9]+\\))?\\)?[:.,; (-]\\( warning:\\|[-0-9 ]*(W)\\)?" 1 2 3 (4))
 
+    (edg-1
+     "^\\([^ \n]+\\)(\\([0-9]+\\)): \\(?:error\\|warnin\\(g\\)\\|remar\\(k\\)\\)"
+     1 2 nil (3 . 4))
+    (edg-2
+     "at line \\([0-9]+\\) of \"\\([^ \n]+\\)\"$"
+     2 1 nil 0)
+
     (epc
-     "^Error [0-9]+ at (\\([0-9]*\\):\\([^)\n]+\\))" 2 1)
+     "^Error [0-9]+ at (\\([0-9]+\\):\\([^)\n]+\\))" 2 1)
 
     (iar
      "^\"\\(.*\\)\",\\([0-9]+\\)\\s-+\\(?:Error\\|Warnin\\(g\\)\\)\\[[0-9]+\\]:"
@@ -203,7 +210,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
 
     (gnu
      "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
-\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\): ?\
+\\([/.]*[a-zA-Z]:?[^ \t\n:]*\\|{standard input}\\): ?\
 \\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\
 \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?:\
 \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
@@ -235,7 +242,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
 : \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3))
 
     (oracle
-     "^Semantic error at line \\([0-9]+\\), column \\([0-9]+\\), file \\(.*\\):$"
+     "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
+\\(?:\\(?:,\\| at\\)? column \\([0-9]+\\)\\)?\
+\\(?:,\\| in\\| of\\)? file \\(.*?\\):?$"
      3 1 2)
 
     (perl
@@ -265,10 +274,6 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column = \\([0-9]+\\)\\)?"
     (sun-ada
      "^\\([^, \n\t]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
 
-    ;; Redundant with `mips'
-;;    (ultrix
-;;      "^\\(?:cfe\\|fort\\): \\(Warning\\)?[^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3 nil (1))
-
     (4bsd
      "\\(?:^\\|::  \\|\\S ( \\)\\(/[^ \n\t()]+\\)(\\([0-9]+\\))\
 \\(?:: \\(warning:\\)?\\|$\\| ),\\)" 1 2 nil (3)))
@@ -326,7 +331,7 @@ be added."
                          (list 'const (car elt)))
                        compilation-error-regexp-alist-alist))
   :link `(file-link :tag "example file"
-                   ,(concat doc-directory "compilation.txt"))
+                   ,(expand-file-name "compilation.txt" data-directory))
   :group 'compilation)
 
 (defvar compilation-directory nil
@@ -445,17 +450,19 @@ starting the compilation process.")
 (defvar compile-history nil)
 
 (defface compilation-warning-face
-  '((((type tty) (class color)) (:foreground "cyan" :weight bold))
-    (((class color)) (:foreground "Orange" :weight bold))
+  '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold))
+    (((class color)) (:foreground "cyan" :weight bold))
     (t (:weight bold)))
   "Face used to highlight compiler warnings."
   :group 'font-lock-highlighting-faces
   :version "21.4")
 
 (defface compilation-info-face
-  '((((type tty) (class color)) (:foreground "green" :weight bold))
-    (((class color) (background light)) (:foreground "Green3" :weight bold))
-    (((class color) (background dark)) (:foreground "Green" :weight bold))
+  '((((class color) (min-colors 16) (background light))
+     (:foreground "Green3" :weight bold))
+    (((class color) (min-colors 16) (background dark))
+     (:foreground "Green" :weight bold))
+    (((class color)) (:foreground "green" :weight bold))
     (t (:weight bold)))
   "Face used to highlight compiler warnings."
   :group 'font-lock-highlighting-faces
@@ -492,6 +499,7 @@ Faces `compilation-error-face', `compilation-warning-face',
 
 
 ;; Used for compatibility with the old compile.el.
+(defvaralias 'compilation-last-buffer 'next-error-last-buffer)
 (defvar compilation-parsing-end (make-marker))
 (defvar compilation-parse-errors-function nil)
 (defvar compilation-error-list nil)
@@ -571,12 +579,17 @@ Faces `compilation-error-face', `compilation-warning-face',
     (and end-line
         (setq end-line (match-string-no-properties end-line))
         (setq end-line (string-to-number end-line)))
-    (and col
-        (setq col (match-string-no-properties col))
-        (setq col (- (string-to-number col) compilation-first-column)))
-    (if (and end-col (setq end-col (match-string-no-properties end-col)))
-       (setq end-col (- (string-to-number end-col) compilation-first-column))
-      (if end-line (setq end-col -1)))
+    (if col
+        (if (functionp col)
+            (setq col (funcall col))
+          (and
+           (setq col (match-string-no-properties col))
+           (setq col (- (string-to-number col) compilation-first-column)))))
+    (if (and end-col (functionp end-col))
+        (setq end-col (funcall end-col))
+      (if (and end-col (setq end-col (match-string-no-properties end-col)))
+          (setq end-col (- (string-to-number end-col) compilation-first-column -1))
+        (if end-line (setq end-col -1))))
     (if (consp type)                   ; not a static type, check what it is.
        (setq type (or (and (car type) (match-end (car type)) 1)
                       (and (cdr type) (match-end (cdr type)) 0)
@@ -718,9 +731,9 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
              ,@(when end-line
                  `((,end-line compilation-line-face nil t)))
 
-             ,@(when col
+             ,@(when (integerp col)
                  `((,col compilation-column-face nil t)))
-             ,@(when end-col
+             ,@(when (integerp end-col)
                  `((,end-col compilation-column-face nil t)))
 
              ,@(nthcdr 6 item)
@@ -748,6 +761,8 @@ and move to the source code that caused it.
 
 Interactively, prompts for the command if `compilation-read-command' is
 non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
+Additionally, with universal prefix arg, compilation buffer will be in
+comint mode, i.e. interactive.
 
 To run more than one compilation at once, start one and rename
 the \`*compilation*' buffer to some other name with
@@ -759,11 +774,13 @@ The name used for the buffer is actually whatever is returned by
 the function in `compilation-buffer-name-function', so you can set that
 to a function that generates a unique name."
   (interactive
-   (if (or compilation-read-command current-prefix-arg)
-       (list (read-from-minibuffer "Compile command: "
-                                (eval compile-command) nil nil
-                                '(compile-history . 1)))
-     (list (eval compile-command))))
+   (list
+    (if (or compilation-read-command current-prefix-arg)
+        (read-from-minibuffer "Compile command: "
+                             (eval compile-command) nil nil
+                             '(compile-history . 1))
+      (eval compile-command))
+    (consp current-prefix-arg)))
   (unless (equal command (eval compile-command))
     (setq compile-command command))
   (save-some-buffers (not compilation-ask-about-save) nil)
@@ -777,7 +794,10 @@ If this is run in a Compilation mode buffer, re-use the arguments from the
 original use.  Otherwise, recompile using `compile-command'."
   (interactive)
   (save-some-buffers (not compilation-ask-about-save) nil)
-  (let ((default-directory (or compilation-directory default-directory)))
+  (let ((default-directory
+          (or (and (not (eq major-mode (nth 1 compilation-arguments)))
+                   compilation-directory)
+              default-directory)))
     (apply 'compilation-start (or compilation-arguments
                                  `(,(eval compile-command))))))
 
@@ -804,8 +824,7 @@ Otherwise, construct a buffer name from MODE-NAME."
         (funcall name-function mode-name))
        (compilation-buffer-name-function
         (funcall compilation-buffer-name-function mode-name))
-       ((and (eq major-mode 'compilation-mode)
-             (equal mode-name (nth 2 compilation-arguments)))
+       ((eq major-mode (nth 1 compilation-arguments))
         (buffer-name))
        (t
         (concat "*" (downcase mode-name) "*"))))
@@ -830,6 +849,7 @@ Otherwise, construct a buffer name from MODE-NAME."
 
 (defun compilation-start (command &optional mode name-function highlight-regexp)
   "Run compilation command COMMAND (low level interface).
+If COMMAND starts with a cd command, that becomes the `default-directory'.
 The rest of the arguments are optional; for them, nil means use the default.
 
 MODE is the major mode to set in the compilation buffer.  Mode
@@ -842,26 +862,12 @@ global value of `compilation-highlight-regexp'.
 
 Returns the compilation buffer created."
   (or mode (setq mode 'compilation-mode))
-  (let ((name-of-mode
-        (if (eq mode t)
-            (prog1 "compilation" (require 'comint))
-          (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
-       (process-environment
-        (append
-         compilation-environment
-         (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
-                 system-uses-terminfo)
-             (list "TERM=dumb" "TERMCAP="
-                   (format "COLUMNS=%d" (window-width)))
-           (list "TERM=emacs"
-                 (format "TERMCAP=emacs:co#%d:tc=unknown:"
-                         (window-width))))
-         ;; Set the EMACS variable, but
-         ;; don't override users' setting of $EMACS.
-         (unless (getenv "EMACS") '("EMACS=t"))
-         process-environment))
-       (thisdir default-directory)
-       outwin outbuf)
+  (let* ((name-of-mode
+         (if (eq mode t)
+             (prog1 "compilation" (require 'comint))
+           (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
+        (thisdir default-directory)
+        outwin outbuf)
     (with-current-buffer
        (setq outbuf
              (get-buffer-create
@@ -880,17 +886,26 @@ Returns the compilation buffer created."
                  (error nil))
              (error "Cannot have two processes in `%s' at once"
                     (buffer-name)))))
-      ;; Clear out the compilation buffer and make it writable.
-      ;; Change its default-directory to the directory where the compilation
-      ;; will happen, and insert a `cd' command to indicate this.
-      (setq buffer-read-only nil)
       (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (buffer-enable-undo (current-buffer))
+      ;; first transfer directory from where M-x compile was called
       (setq default-directory thisdir)
-      ;; output a mode setter, for saving and later reloading this buffer
-      (insert "cd " thisdir "  # -*-" name-of-mode
-             "-*-\nEntering directory `" thisdir "'\n" command "\n")
+      ;; Make compilation buffer read-only.  The filter can still write it.
+      ;; Clear out the compilation buffer.
+      (let ((inhibit-read-only t)
+           (default-directory thisdir))
+       ;; Then evaluate a cd command if any, but don't perform it yet, else start-command
+       ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make"
+       (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
+               (if (match-end 1)
+                   (match-string 1 command)
+                 "~")
+             default-directory))
+       (erase-buffer)
+       ;; output a mode setter, for saving and later reloading this buffer
+       (insert "-*- mode: " name-of-mode
+               "; default-directory: " (prin1-to-string default-directory)
+               " -*-\n" command "\n")
+       (setq thisdir default-directory))
       (set-buffer-modified-p nil))
     ;; If we're already in the compilation buffer, go to the end
     ;; of the buffer, so point will track the compilation output.
@@ -899,65 +914,85 @@ Returns the compilation buffer created."
     ;; Pop up the compilation buffer.
     (setq outwin (display-buffer outbuf nil t))
     (with-current-buffer outbuf
-      (if (not (eq mode t))
-         (funcall mode)
-       (with-no-warnings (comint-mode))
-       (compilation-shell-minor-mode))
-      ;; In what way is it non-ergonomic ?  -stef
-      ;; (toggle-read-only 1) ;;; Non-ergonomic.
-      (if highlight-regexp
-         (set (make-local-variable 'compilation-highlight-regexp)
-              highlight-regexp))
-      (set (make-local-variable 'compilation-arguments)
-          (list command mode name-function highlight-regexp))
-      (set (make-local-variable 'revert-buffer-function)
-          'compilation-revert-buffer)
-      (set-window-start outwin (point-min))
-      (or (eq outwin (selected-window))
-         (set-window-point outwin (if compilation-scroll-output
-                                      (point)
-                                    (point-min))))
-      ;; The setup function is called before compilation-set-window-height
-      ;; so it can set the compilation-window-height buffer locally.
-      (if compilation-process-setup-function
-         (funcall compilation-process-setup-function))
-      (compilation-set-window-height outwin)
-      ;; Start the compilation.
-      (if (fboundp 'start-process)
-         (let ((proc (if (eq mode t)
-                         (get-buffer-process
-                          (with-no-warnings
-                           (comint-exec outbuf (downcase mode-name)
-                                        shell-file-name nil `("-c" ,command))))
-                       (start-process-shell-command (downcase mode-name)
-                                                    outbuf command))))
-           ;; Make the buffer's mode line show process state.
-           (setq mode-line-process '(":%s"))
-           (set-process-sentinel proc 'compilation-sentinel)
-           (set-process-filter proc 'compilation-filter)
-           (set-marker (process-mark proc) (point) outbuf)
-           (setq compilation-in-progress
-                 (cons proc compilation-in-progress)))
-       ;; No asynchronous processes available.
-       (message "Executing `%s'..." command)
-       ;; Fake modeline display as if `start-process' were run.
-       (setq mode-line-process ":run")
-       (force-mode-line-update)
-       (let ((status (call-process shell-file-name nil outbuf nil "-c"
-                                   command)))
-         (cond ((numberp status)
-                (compilation-handle-exit 'exit status
-                                         (if (zerop status)
-                                             "finished\n"
-                                           (format "\
+      (let ((process-environment
+            (append
+             compilation-environment
+             (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
+                     system-uses-terminfo)
+                 (list "TERM=dumb" "TERMCAP="
+                       (format "COLUMNS=%d" (window-width)))
+               (list "TERM=emacs"
+                     (format "TERMCAP=emacs:co#%d:tc=unknown:"
+                             (window-width))))
+             ;; Set the EMACS variable, but
+             ;; don't override users' setting of $EMACS.
+             (unless (getenv "EMACS") '("EMACS=t"))
+             (copy-sequence process-environment))))
+       (if (not (eq mode t))
+           (funcall mode)
+         (setq buffer-read-only nil)
+         (with-no-warnings (comint-mode))
+         (compilation-shell-minor-mode))
+       (if highlight-regexp
+           (set (make-local-variable 'compilation-highlight-regexp)
+                highlight-regexp))
+       (set (make-local-variable 'compilation-arguments)
+            (list command mode name-function highlight-regexp))
+       (set (make-local-variable 'revert-buffer-function)
+            'compilation-revert-buffer)
+       (set-window-start outwin (point-min))
+       (or (eq outwin (selected-window))
+           (set-window-point outwin (if compilation-scroll-output
+                                        (point)
+                                      (point-min))))
+       ;; The setup function is called before compilation-set-window-height
+       ;; so it can set the compilation-window-height buffer locally.
+       (if compilation-process-setup-function
+           (funcall compilation-process-setup-function))
+       (compilation-set-window-height outwin)
+       ;; Start the compilation.
+       (if (fboundp 'start-process)
+           (let ((proc (if (eq mode t)
+                           (get-buffer-process
+                            (with-no-warnings
+                             (comint-exec outbuf (downcase mode-name)
+                                          shell-file-name nil `("-c" ,command))))
+                         (start-process-shell-command (downcase mode-name)
+                                                      outbuf command))))
+             ;; Make the buffer's mode line show process state.
+             (setq mode-line-process '(":%s"))
+             (set-process-sentinel proc 'compilation-sentinel)
+             (set-process-filter proc 'compilation-filter)
+             (set-marker (process-mark proc) (point) outbuf)
+             (setq compilation-in-progress
+                   (cons proc compilation-in-progress)))
+         ;; No asynchronous processes available.
+         (message "Executing `%s'..." command)
+         ;; Fake modeline display as if `start-process' were run.
+         (setq mode-line-process ":run")
+         (force-mode-line-update)
+         (sit-for 0)                   ; Force redisplay
+         (let ((status (call-process shell-file-name nil outbuf nil "-c"
+                                     command)))
+           (cond ((numberp status)
+                  (compilation-handle-exit 'exit status
+                                           (if (zerop status)
+                                               "finished\n"
+                                             (format "\
 exited abnormally with code %d\n"
-                                                   status))))
-               ((stringp status)
-                (compilation-handle-exit 'signal status
-                                         (concat status "\n")))
-               (t
-                (compilation-handle-exit 'bizarre status status))))
-       (message "Executing `%s'...done" command)))
+                                                     status))))
+                 ((stringp status)
+                  (compilation-handle-exit 'signal status
+                                           (concat status "\n")))
+                 (t
+                  (compilation-handle-exit 'bizarre status status))))
+         ;; Without async subprocesses, the buffer is not yet
+         ;; fontified, so fontify it now.
+         (let ((font-lock-verbose nil)) ; shut up font-lock messages
+           (font-lock-fontify-buffer))
+         (message "Executing `%s'...done" command)))
+      ;; Now finally cd to where the shell started make/grep/...
+      (setq default-directory thisdir))
     (if (buffer-local-value 'compilation-scroll-output outbuf)
        (save-selected-window
          (select-window outwin)
@@ -973,9 +1008,8 @@ exited abnormally with code %d\n"
         ;; If window is alone in its frame, aside from a minibuffer,
         ;; don't change its height.
         (not (eq window (frame-root-window (window-frame window))))
-        ;; This save-current-buffer prevents us from changing the current
-        ;; buffer, which might not be the same as the selected window's buffer.
-        (save-current-buffer
+        ;; Stef said that doing the saves in this order is safer:
+        (save-excursion
           (save-selected-window
             (select-window window)
             (enlarge-window (- height (window-height))))))))
@@ -1036,6 +1070,7 @@ exited abnormally with code %d\n"
     (set-keymap-parent map compilation-minor-mode-map)
     (define-key map " " 'scroll-up)
     (define-key map "\^?" 'scroll-down)
+    (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
 
     ;; Set up the menu-bar
     (define-key map [menu-bar compilation]
@@ -1079,25 +1114,23 @@ from a different message."
   :version "21.4")
 
 ;;;###autoload
-(defun compilation-mode ()
+(defun compilation-mode (&optional name-of-mode)
   "Major mode for compilation log buffers.
 \\<compilation-mode-map>To visit the source for a line-numbered error,
 move point to the error message line and type \\[compile-goto-error].
 To kill the compilation, type \\[kill-compilation].
 
-Runs `compilation-mode-hook' with `run-hooks' (which see)."
+Runs `compilation-mode-hook' with `run-hooks' (which see).
+
+\\{compilation-mode-map}"
   (interactive)
   (kill-all-local-variables)
   (use-local-map compilation-mode-map)
   (setq major-mode 'compilation-mode
-       mode-name "Compilation")
+       mode-name (or name-of-mode "Compilation"))
   (set (make-local-variable 'page-delimiter)
        compilation-page-delimiter)
   (compilation-setup)
-  ;; note that compilation-next-error-function is for interfacing
-  ;; with the next-error function in simple.el, and it's only
-  ;; coincidentally named similarly to compilation-next-error
-  (setq next-error-function 'compilation-next-error-function)
   (run-mode-hooks 'compilation-mode-hook))
 
 (defmacro define-compilation-mode (mode name doc &rest body)
@@ -1149,6 +1182,10 @@ variable exists."
   "Marker to the location from where the next error will be found.
 The global commands next/previous/first-error/goto-error use this.")
 
+(defvar compilation-messages-start nil
+  "Buffer position of the beginning of the compilation messages.
+If nil, use the beginning of buffer.")
+
 ;; A function name can't be a hook, must be something with a value.
 (defconst compilation-turn-on-font-lock 'turn-on-font-lock)
 
@@ -1156,9 +1193,16 @@ The global commands next/previous/first-error/goto-error use this.")
   "Prepare the buffer for the compilation parsing commands to work.
 Optional argument MINOR indicates this is called from
 `compilation-minor-mode'."
+  (unless minor
+    (setq buffer-read-only t))
   (make-local-variable 'compilation-current-error)
+  (make-local-variable 'compilation-messages-start)
   (make-local-variable 'compilation-error-screen-columns)
   (make-local-variable 'overlay-arrow-position)
+  ;; Note that compilation-next-error-function is for interfacing
+  ;; with the next-error function in simple.el, and it's only
+  ;; coincidentally named similarly to compilation-next-error.
+  (setq next-error-function 'compilation-next-error-function)
   (set (make-local-variable 'font-lock-extra-managed-props)
        '(directory message help-echo mouse-face debug))
   (set (make-local-variable 'compilation-locs)
@@ -1212,7 +1256,7 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
 
 (defun compilation-handle-exit (process-status exit-status msg)
   "Write MSG in the current buffer and hack its mode-line-process."
-  (let ((buffer-read-only nil)
+  (let ((inhibit-read-only t)
        (status (if compilation-exit-message-function
                    (funcall compilation-exit-message-function
                             process-status exit-status msg)
@@ -1403,16 +1447,16 @@ Use this command in a compilation log buffer.  Sets the mark at point there."
   (let* ((columns compilation-error-screen-columns) ; buffer's local value
         (last 1)
         (loc (compilation-next-error (or n 1) nil
-                                     (or compilation-current-error (point-min))))
+                                     (or compilation-current-error
+                                         compilation-messages-start
+                                         (point-min))))
         (end-loc (nth 2 loc))
         (marker (point-marker)))
     (setq compilation-current-error (point-marker)
          overlay-arrow-position
            (if (bolp)
                compilation-current-error
-             (save-excursion
-               (beginning-of-line)
-               (point-marker)))
+             (copy-marker (line-beginning-position)))
          loc (car loc))
     ;; If loc contains no marker, no error in that file has been visited.  If
     ;; the marker is invalid the buffer has been killed.  So, recalculate all
@@ -1446,6 +1490,10 @@ Use this command in a compilation log buffer.  Sets the mark at point there."
     (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
     (setcdr (nthcdr 3 loc) t)))                ; Set this one as visited.
 
+(defvar compilation-gcpro nil
+  "Internal variable used to keep some values from being GC'd.")
+(make-variable-buffer-local 'compilation-gcpro)
+
 (defun compilation-fake-loc (marker file &optional line col)
   "Preassociate MARKER with FILE.
 FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
@@ -1465,6 +1513,11 @@ call this several times, once each for the last line of one
 region and the first line of the next region."
   (or (consp file) (setq file (list file)))
   (setq file (compilation-get-file-structure file))
+  ;; Between the current call to compilation-fake-loc and the first occurrence
+  ;; of an error message referring to `file', the data is only kept is the
+  ;; weak hash-table compilation-locs, so we need to prevent this entry
+  ;; in compilation-locs from being GC'd away.  --Stef
+  (push file compilation-gcpro)
   (let ((loc (compilation-assq (or line 1) (cdr file))))
     (setq loc (compilation-assq col loc))
     (if (cdr loc)
@@ -1472,23 +1525,26 @@ region and the first line of the next region."
       (setcdr loc (list line file marker)))
     loc))
 
-(defcustom compilation-context-lines next-screen-context-lines
-  "*Display this many lines of leading context before message."
-  :type 'integer
+(defcustom compilation-context-lines 0
+  "*Display this many lines of leading context before message.
+If nil, don't scroll the compilation output window."
+  :type '(choice integer (const :tag "No window scrolling" nil))
   :group 'compilation
   :version "21.4")
 
 (defsubst compilation-set-window (w mk)
   "Align the compilation output window W with marker MK near top."
-  (set-window-start w (save-excursion
-                       (goto-char mk)
-                       (beginning-of-line (- 1 compilation-context-lines))
-                       (point)))
+  (if (integerp compilation-context-lines)
+      (set-window-start w (save-excursion
+                            (goto-char mk)
+                            (beginning-of-line (- 1 compilation-context-lines))
+                            (point))))
   (set-window-point w mk))
 
 (defun compilation-goto-locus (msg mk end-mk)
   "Jump to an error corresponding to MSG at MK.
-All arguments are markers.  If END-MK is non nil, mark is set there."
+All arguments are markers.  If END-MK is non-nil, mark is set there
+and overlay is highlighted between MK and END-MK."
   (if (eq (window-buffer (selected-window))
          (marker-buffer msg))
       ;; If the compilation buffer window is selected,
@@ -1504,7 +1560,7 @@ All arguments are markers.  If END-MK is non nil, mark is set there."
     (widen)
     (goto-char mk))
   (if end-mk
-      (push-mark end-mk nil t)
+      (push-mark end-mk t)
     (if mark-active (setq mark-active)))
   ;; If hideshow got in the way of
   ;; seeing the right place, open permanently.
@@ -1525,26 +1581,32 @@ All arguments are markers.  If END-MK is non nil, mark is set there."
                             compilation-highlight-regexp)))
     (compilation-set-window-height w)
 
-    (when (and highlight-regexp
-              (not (and end-mk transient-mark-mode)))
+    (when highlight-regexp
       (unless compilation-highlight-overlay
        (setq compilation-highlight-overlay
              (make-overlay (point-min) (point-min)))
-       (overlay-put compilation-highlight-overlay 'face 'region))
+       (overlay-put compilation-highlight-overlay 'face 'next-error))
       (with-current-buffer (marker-buffer mk)
        (save-excursion
-         (end-of-line)
+         (if end-mk (goto-char end-mk) (end-of-line))
          (let ((end (point)))
-           (beginning-of-line)
+           (if mk (goto-char mk) (beginning-of-line))
            (if (and (stringp highlight-regexp)
                     (re-search-forward highlight-regexp end t))
                (progn
                  (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.5)
-           (delete-overlay compilation-highlight-overlay)))))))
-
+                 (move-overlay compilation-highlight-overlay
+                               (match-beginning 0) (match-end 0)
+                               (current-buffer)))
+             (move-overlay compilation-highlight-overlay
+                           (point) end (current-buffer)))
+           (if (numberp next-error-highlight)
+               (sit-for next-error-highlight))
+           (if (not (eq next-error-highlight t))
+               (delete-overlay compilation-highlight-overlay))))))
+    (when (and (eq next-error-highlight 'fringe-arrow))
+      (set (make-local-variable 'overlay-arrow-position)
+          (copy-marker (line-beginning-position))))))
 \f
 (defun compilation-find-file (marker filename dir &rest formats)
   "Find a buffer for file FILENAME.
@@ -1712,10 +1774,12 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
   (goto-char limit)
   nil)
 
+;; Beware: this is not only compatiblity code.  New code stil 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.
   (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
+  (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
   ;;
@@ -1727,9 +1791,19 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
   ;; something equivalent to point-max.  So we speculatively move
   ;; compilation-current-error to point-max (since the external package
   ;; won't know that it should do it).  --stef
-  (setq compilation-current-error (point-max)))
+  (setq compilation-current-error nil)
+  (let* ((proc (get-buffer-process (current-buffer)))
+        (mark (if proc (process-mark proc)))
+        (pos (or mark (point-max))))
+    (setq compilation-messages-start
+         ;; In the future, ignore the text already present in the buffer.
+         ;; Since many process filter functions insert before markers,
+         ;; we need to put ours just before the insertion point rather
+         ;; than at the insertion point.  If that's not possible, then
+         ;; don't use a marker.  --Stef
+         (if (> pos (point-min)) (copy-marker (1- pos)) pos))))
 
 (provide 'compile)
 
-;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
+;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
 ;;; compile.el ends here