From 7c6335de5e0ac4176911a39bad5344028f39b8ff Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 17 Nov 2019 14:59:42 +0000 Subject: [PATCH] Compilation Mode: Fix arrow handling when compilation-context-lines is t In particular, fix some exception occurrences, fix handling of a Compilation Mode buffer being displayed in several windows, and fix the margin when temporarily displaying a different buffer in a window, then returning to the compilation mode buffer. The fix is relevant for frames without fringes, e.g. tty frames. * lisp/progmodes/compile.el: (compilation-set-window): Always set point to (parameter) MK. (compilation--set-up-margin, compilation--tear-down-margin): New functions. (compilation--set-up-arrow-spec-in-margins) (compilation--tear-down-arrow-spec-in-margins): Renamed by introducing -- and pluralising margin to margins. Handle the margins in _all_ windows displaying the pertinent buffer by using get-buffer-window-list. In ...--set-up-... add compilation--set-up-margin to window-buffer-change-functions. In ...--tear-down-... remove the hook functions added in ...--set-up-.... --- lisp/progmodes/compile.el | 45 +++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 16 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 5a3386f2279..3fbd6eb2c75 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -2646,15 +2646,14 @@ column zero points to the current message." (compilation-beginning-of-line (- 1 compilation-context-lines)) (point)))) - ((eq compilation-context-lines t)) - ;; If there is no left fringe. - ((equal (car (window-fringes w)) 0) + ((and (null compilation-context-lines) + ;; If there is no left fringe. + (equal (car (window-fringes w)) 0)) (set-window-start w (save-excursion (goto-char mk) (beginning-of-line 1) - (point))) - (set-window-point w mk)) - (t (set-window-point w mk)))) + (point))))) + (set-window-point w mk)) (defvar-local compilation-arrow-overlay nil "Overlay with the before-string property of `overlay-arrow-string'. @@ -2671,25 +2670,39 @@ at the overlay's start position.") "A string which is only a placeholder for `compilation--margin-string'. Actual value is never used, only the text property.") -(defun compilation-set-up-arrow-spec-in-margin () - "Set up compilation-arrow-overlay to display as an arrow in a margin." +(defun compilation--set-up-margin (w) + "Setup the margin for \"=>\" in window W if it isn't already set up." + (set-window-margins w (+ (or (car (window-margins w)) 0) 2))) + +(defun compilation--tear-down-margin (w) + "Remove the margin for \"=>\" if it is setup in window W." + (when (window-margins w) + (set-window-margins w (- (car (window-margins w)) 2)))) + +(defun compilation--set-up-arrow-spec-in-margins () + "Set up compilation-arrow-overlay to display as an arrow in margins." (setq overlay-arrow-string "") (setq compilation-arrow-overlay (make-overlay overlay-arrow-position overlay-arrow-position)) (overlay-put compilation-arrow-overlay 'before-string compilation--dummy-string) - (set-window-margins (selected-window) (+ (or (car (window-margins)) 0) 2)) + (mapc #'compilation--set-up-margin (get-buffer-window-list nil nil t)) + (add-hook 'window-buffer-change-functions #'compilation--set-up-margin nil t) ;; Take precautions against `compilation-mode' getting reinitialized. (add-hook 'change-major-mode-hook - 'compilation-tear-down-arrow-spec-in-margin nil t)) + #'compilation--tear-down-arrow-spec-in-margins nil t)) -(defun compilation-tear-down-arrow-spec-in-margin () - "Restore compilation-arrow-overlay to not using the margin, which is removed." +(defun compilation--tear-down-arrow-spec-in-margins () + "Restore compilation-arrow-overlay to not using the margins, which are removed." (when (overlayp compilation-arrow-overlay) (overlay-put compilation-arrow-overlay 'before-string nil) (delete-overlay compilation-arrow-overlay) (setq compilation-arrow-overlay nil) - (set-window-margins (selected-window) (- (car (window-margins)) 2)))) + (mapc #'compilation--tear-down-margin (get-buffer-window-list nil nil t)) + (remove-hook 'change-major-mode-hook + #'compilation--tear-down-arrow-spec-in-margins t) + (remove-hook 'window-buffer-change-functions + #'compilation--set-up-margin t))) (defun compilation-set-overlay-arrow (w) "Set up, or switch off, the overlay-arrow for window W." @@ -2707,10 +2720,10 @@ Actual value is never used, only the text property.") (if overlay-arrow-position (move-overlay compilation-arrow-overlay overlay-arrow-position overlay-arrow-position) - (compilation-tear-down-arrow-spec-in-margin)))) + (compilation--tear-down-arrow-spec-in-margins)))) (overlay-arrow-position - (compilation-set-up-arrow-spec-in-margin))) + (compilation--set-up-arrow-spec-in-margins))) ;; Ensure that the "=>" remains in the window by causing ;; the window to be scrolled, if needed. (goto-char (overlay-start compilation-arrow-overlay))) @@ -2718,7 +2731,7 @@ Actual value is never used, only the text property.") ;; `compilation-context-lines' isn't t, or we've got a left ;; fringe, so remove any overlay arrow. (when (overlayp compilation-arrow-overlay) - (compilation-tear-down-arrow-spec-in-margin))))) + (compilation--tear-down-arrow-spec-in-margins))))) (defvar next-error-highlight-timer) -- 2.39.5