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-....
This commit is contained in:
Alan Mackenzie 2019-11-17 14:59:42 +00:00
parent 58ceb8bac0
commit 7c6335de5e

View file

@ -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)