# HG changeset patch # User Daniel Pfeiffer # Date 1081896163 0 # Node ID eb5c70ae728c0cb6c2f0677e72553f7e70b1fdd9 # Parent 429f2746c12506f122d2e69cca459a696c9e281d (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 -r 429f2746c125 -r eb5c70ae728c lisp/progmodes/compile.el --- a/lisp/progmodes/compile.el Tue Apr 13 22:24:34 2004 +0000 +++ b/lisp/progmodes/compile.el Tue Apr 13 22:42:43 2004 +0000 @@ -675,10 +675,10 @@ (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 @@ ',(nthcdr 4 item)) ,(if col `(match-string ,col))))) (,file compilation-error-face t)) - + `(,(nth 0 item) ,@(when (integerp file) @@ -982,7 +982,7 @@ (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 @@ (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 @@ "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 @@ (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 @@ ;; 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 @@ '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 @@ (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 @@ (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 @@ (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 @@ ;; 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)