master 7c6335d: Compilation Mode: Fix arrow handling when compilation-context-lines is t

[Alan Mackenzie]

branch: master
commit 7c6335de5e0ac4176911a39bad5344028f39b8ff
Author: Alan Mackenzie <address@hidden>
Commit: Alan Mackenzie <address@hidden>

    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 5a3386f..3fbd6eb 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)