(compilation-setup): Localize overlay-arrow-position.

(compilation-sentinel): Restructure code equivalently.
(compilation-next-error): Find message on same line after point if
not found before point.
(compile-mouse-goto-error): Restore function so that compilation
buffer need not be current and use compile-goto-error.
(compile-goto-error): Restore function.
(next-error): Set overlay-arrow-position.
(compilation-forget-errors): Don't localize already local
compilation-locs and remove FIXME about refontifying.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 0fbdc018379dfbc7fd7fcd03c443fe5b78b5144d..0ddd1eb78fb97656ffd91f4127df07b0037c6d5c 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2004-04-14  Daniel Pfeiffer  <occitan@esperanto.org>
+
+       * progmodes/compile.el (compilation-setup): Localize
+       overlay-arrow-position.
+       (compilation-sentinel): Restructure code equivalently.
+       (compilation-next-error): Find message on same line after point if
+       not found before point.
+       (compile-mouse-goto-error): Restore function so that compilation
+       buffer need not be current and use compile-goto-error.
+       (compile-goto-error): Restore function.
+       (next-error): Set overlay-arrow-position.
+       (compilation-forget-errors): Don't localize already local
+       compilation-locs and remove FIXME about refontifying.
+
 2004-04-14  Kim F. Storm  <storm@cua.dk>
 
        * startup.el (emacs-quick-startup): New defvar (set by -Q).

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index b1e4caa5513a4eb0117b767968b5d7df796d0d83..d99cddadc3a8338cd1fb40bbb5a860ce81643ec0 100644 (file)
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -675,10 +675,10 @@ Faces `compilation-error-face', `compilation-warning-face',
              (col (nth 3 item))
              (type (nth 4 item))
              end-line end-col fmt)
-         (if (consp file) (setq fmt (cdr file)   file (car file)))
-         (if (consp line) (setq end-line (cdr line) line (car line)))
+         (if (consp file)      (setq fmt (cdr file)      file (car file)))
+         (if (consp line)      (setq end-line (cdr line) line (car line)))
          (if (consp col)       (setq end-col (cdr col)   col (car col)))
-         
+
          (if (functionp line)
              ;; The old compile.el had here an undocumented hook that
              ;; allowed `line' to be a function that computed the actual
@@ -690,7 +690,7 @@ Faces `compilation-error-face', `compilation-warning-face',
                                           ',(nthcdr 4 item))
                             ,(if col `(match-string ,col)))))
                (,file compilation-error-face t))
-                   
+
            `(,(nth 0 item)
 
              ,@(when (integerp file)
@@ -982,7 +982,7 @@ exited abnormally with code %d\n"
 
 (defvar compilation-minor-mode-map
   (let ((map (make-sparse-keymap)))
-    (define-key map [mouse-2] 'compile-goto-error)
+    (define-key map [mouse-2] 'compile-mouse-goto-error)
     (define-key map "\C-c\C-c" 'compile-goto-error)
     (define-key map "\C-m" 'compile-goto-error)
     (define-key map "\C-c\C-k" 'kill-compilation)
@@ -998,7 +998,7 @@ exited abnormally with code %d\n"
 
 (defvar compilation-shell-minor-mode-map
   (let ((map (make-sparse-keymap)))
-    (define-key map [mouse-2] 'compile-goto-error)
+    (define-key map [mouse-2] 'compile-mouse-goto-error)
     (define-key map "\M-\C-m" 'compile-goto-error)
     (define-key map "\M-\C-n" 'compilation-next-error)
     (define-key map "\M-\C-p" 'compilation-previous-error)
@@ -1131,6 +1131,7 @@ The global commands next/previous/first-error/goto-error use this.")
   "Prepare the buffer for the compilation parsing commands to work."
   (make-local-variable 'compilation-current-error)
   (make-local-variable 'compilation-error-screen-columns)
+  (make-local-variable 'overlay-arrow-position)
   (setq compilation-last-buffer (current-buffer))
   (set (make-local-variable 'font-lock-extra-managed-props)
        '(directory message help-echo mouse-face debug))
@@ -1192,8 +1193,7 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
                  (cons msg exit-status)))
        (omax (point-max))
        (opoint (point)))
-    ;; Record where we put the message, so we can ignore it
-    ;; later on.
+    ;; Record where we put the message, so we can ignore it later on.
     (goto-char omax)
     (insert ?\n mode-name " " (car status))
     (if (and (numberp compilation-window-height)
@@ -1221,24 +1221,22 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
 ;; Called when compilation process changes state.
 (defun compilation-sentinel (proc msg)
   "Sentinel for compilation buffers."
-  (let ((buffer (process-buffer proc)))
-    (if (memq (process-status proc) '(signal exit))
-       (progn
-         (if (null (buffer-name buffer))
-             ;; buffer killed
-             (set-process-buffer proc nil)
-           (with-current-buffer buffer
-             ;; Write something in the compilation buffer
-             ;; and hack its mode line.
-             (compilation-handle-exit (process-status proc)
-                                      (process-exit-status proc)
-                                      msg)
-             ;; Since the buffer and mode line will show that the
-             ;; process is dead, we can delete it now.  Otherwise it
-             ;; will stay around until M-x list-processes.
-             (delete-process proc)))
-         (setq compilation-in-progress (delq proc compilation-in-progress))
-         ))))
+  (if (memq (process-status proc) '(exit signal))
+      (let ((buffer (process-buffer proc)))
+       (if (null (buffer-name buffer))
+           ;; buffer killed
+           (set-process-buffer proc nil)
+         (with-current-buffer buffer
+           ;; Write something in the compilation buffer
+           ;; and hack its mode line.
+           (compilation-handle-exit (process-status proc)
+                                    (process-exit-status proc)
+                                    msg)
+           ;; Since the buffer and mode line will show that the
+           ;; process is dead, we can delete it now.  Otherwise it
+           ;; will stay around until M-x list-processes.
+           (delete-process proc)))
+       (setq compilation-in-progress (delq proc compilation-in-progress)))))
 
 (defun compilation-filter (proc string)
   "Process filter for compilation buffers.
@@ -1293,13 +1291,11 @@ Does NOT find the source line like \\[next-error]."
                                                 'message)))
          (setq pt (previous-single-property-change pt 'message nil
                                                    (line-beginning-position)))
-         (if pt         ; FIXME: `pt' can never be nil here anyway.  --stef
-             (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
+         (unless (setq msg (get-text-property (max (1- pt) (point-min)) 'message))
            (setq pt (next-single-property-change pt 'message nil
                                                  (line-end-position)))
-           (if pt       ; FIXME: `pt' can never be nil here anyway.  --stef
-               (setq msg (get-text-property pt 'message))
-             (setq pt (point)))))
+           (or (setq msg (get-text-property pt 'message))
+               (setq pt (point)))))
       (setq last (nth 2 (car msg)))
       (if (>= n 0)
          (compilation-loop > next-single-property-change 1-
@@ -1362,22 +1358,23 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)."
        (interrupt-process (get-buffer-process buffer))
       (error "The compilation process is not running"))))
 
-(defalias 'compile-mouse-goto-error 'compile-goto-error)
+(defun compile-mouse-goto-error (event)
+  "Visit the source for the error message the mouse is pointing at."
+  (interactive "e")
+  (mouse-set-point event)
+  (compile-goto-error))
 
-(defun compile-goto-error (&optional event)
-  "Visit the source for the error message at point.
+(defun compile-goto-error ()
+  "Visit the source for the error message point is on.
 Use this command in a compilation log buffer.  Sets the mark at point there."
-  (interactive (list last-input-event))
+  (interactive)
   (or (compilation-buffer-p (current-buffer))
       (error "Not in a compilation buffer"))
-  (let* ((loc (event-end event))
-        (pos (posn-point loc)))
-    (with-selected-window (posn-window loc)
-      (if (get-text-property pos 'directory)
-         (dired-other-window (car (get-text-property pos 'directory)))
-       (push-mark)
-       (setq compilation-current-error pos)
-       (next-error 0)))))
+  (if (get-text-property (point) 'directory)
+      (dired-other-window (car (get-text-property (point) 'directory)))
+    (push-mark)
+    (setq compilation-current-error (point))
+    (next-error 0)))
 
 ;; Return a compilation buffer.
 ;; If the current buffer is a compilation buffer, return it.
@@ -1437,6 +1434,12 @@ See variable `compilation-error-regexp-alist' for customization ideas."
         (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)))
          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
@@ -1734,11 +1737,10 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
 (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.
-  (set (make-local-variable 'compilation-locs)
-       (make-hash-table :test 'equal :weakness 'value))
+  (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
   ;; 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
@@ -1747,10 +1749,7 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
   ;; 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))
-  ;; FIXME the old code removed the mouse-face and help-echo properties.
-  ;; Should we font-lock-fontify-buffer?  --stef
-  )
+  (setq compilation-current-error (point-max)))
 
 (provide 'compile)