Introduce new value t for compilation-context-lines to eliminate scrolling

In particular, to prevent scrolling in a window lacking a left fringe.
Instead, a visible arrow "=>" is inserted before column zero.  This fixes
bug #36832.

* lisp/progmodes/compile.el (compilation-context-lines): Add the new value t.
(compilation-set-window): Amend to handle compilation-context-lines being t.
(overlay-arrow-overlay): New variable holding an overlay with before-string
property "=>".
(compilation-set-overlay-arrow): New function which manipulates
overlay-arrow-overlay.
(compilation-goto-locus, compilation-find-file): In addition to calling
compilation-set-window, also call compilation-set-overlay-arrow.

* doc/emacs/building.texi (Compilation Mode): Document the new value t which
compilation-context-lines can take.

* etc/NEWS: Add an entry for this change.

1 files changed, 68 insertions, 22 deletions

diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4cc1daf4fa6..09188dc14bc 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -701,9 +701,8 @@ of `my-compilation-root' here."
 ;;;###autoload
 (defcustom compilation-search-path '(nil)
   "List of directories to search for source files named in error messages.
-Elements should be directory names, not file names of
-directories.  The value nil as an element means the error
-message buffer `default-directory'."
+Elements should be directory names, not file names of directories.
+The value nil as an element means to try the default directory."
   :type '(repeat (choice (const :tag "Default" nil)
 			 (string :tag "Directory"))))
 
@@ -2575,28 +2574,73 @@ region and the first line of the next region."
 
 (defcustom compilation-context-lines nil
   "Display this many lines of leading context before the current message.
-If nil and the left fringe is displayed, don't scroll the
+If nil or t, and the left fringe is displayed, don't scroll the
 compilation output window; an arrow in the left fringe points to
-the current message.  If nil and there is no left fringe, the message
-displays at the top of the window; there is no arrow."
-  :type '(choice integer (const :tag "No window scrolling" nil))
+the current message.  With no left fringe, If nil, the message
+scrolls to the top of the window; there is no arrow.  If t, don't
+scroll the compilation output window at all; an arrow before
+column zero points to the current message."
+  :type '(choice integer
+                 (const :tag "Scroll window when no fringe" nil)
+                 (const :tag  "No window scrolling" t))
   :version "22.1")
 
 (defsubst compilation-set-window (w mk)
-  "Align the compilation output window W with marker MK near top."
-  (if (integerp compilation-context-lines)
-      (set-window-start w (save-excursion
-			    (goto-char mk)
-			    (compilation-beginning-of-line
-			     (- 1 compilation-context-lines))
-			    (point)))
+  "Maybe align the compilation output window W with marker MK near top."
+  (cond ((integerp compilation-context-lines)
+         (set-window-start w (save-excursion
+			       (goto-char mk)
+			       (compilation-beginning-of-line
+			        (- 1 compilation-context-lines))
+			       (point))))
+        ((eq compilation-context-lines t))
     ;; If there is no left fringe.
-    (when (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))
+        ((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))))
+
+(defvar-local overlay-arrow-overlay nil
+  "Overlay with the before-string property of `overlay-arrow-string'.
+
+When non-nil, this overlay causes redisplay to display `overlay-arrow-string'
+at the overlay's start position.")
+
+(defun compilation-set-overlay-arrow (w)
+  "Set up, or switch off, the overlay-arrow for window W."
+  (with-current-buffer (window-buffer w)
+    (if (and (eq compilation-context-lines t)
+             (equal (car (window-fringes w)) 0)) ; No left fringe
+        ;; Insert a "=>" before-string overlay at the beginning of the
+        ;; line pointed to by `overlay-arrow-position'.
+        (cond
+         ((overlayp overlay-arrow-overlay)
+          (when (not (eq (overlay-start overlay-arrow-overlay)
+		         overlay-arrow-position))
+	    (if overlay-arrow-position
+                (progn
+	          (move-overlay overlay-arrow-overlay
+			        overlay-arrow-position overlay-arrow-position)
+                  (setq overlay-arrow-string "=>")
+                  (overlay-put overlay-arrow-overlay
+                               'before-string overlay-arrow-string))
+	      (delete-overlay overlay-arrow-overlay)
+	      (setq overlay-arrow-overlay nil))))
+
+         (overlay-arrow-position
+          (setq overlay-arrow-overlay
+	        (make-overlay overlay-arrow-position overlay-arrow-position))
+          (setq overlay-arrow-string "=>")
+          (overlay-put overlay-arrow-overlay 'before-string overlay-arrow-string)))
+
+      ;; `compilation-context-lines' isn't t, or we've got a left
+      ;; fringe, so remove any overlay arrow.
+      (when (overlayp overlay-arrow-overlay)
+        (setq overlay-arrow-string "")
+        (delete-overlay overlay-arrow-overlay)
+        (setq overlay-arrow-overlay nil)))))
 
 (defvar next-error-highlight-timer)
 
@@ -2618,7 +2662,8 @@ and overlay is highlighted between MK and END-MK."
 	 (highlight-regexp (with-current-buffer (marker-buffer msg)
 			     ;; also do this while we change buffer
 			     (goto-char (marker-position msg))
-			     (and w (compilation-set-window w msg))
+			     (and w (progn (compilation-set-window w msg)
+                                           (compilation-set-overlay-arrow w)))
 			     compilation-highlight-regexp)))
     ;; Ideally, the window-size should be passed to `display-buffer'
     ;; so it's only used when creating a new window.
@@ -2739,7 +2784,8 @@ attempts to find a file whose name is produced by (format FMT FILENAME)."
 				   '(nil (allow-no-window . t))))))
           (with-current-buffer (marker-buffer marker)
 	    (goto-char marker)
-	    (and w (compilation-set-window w marker)))
+	    (and w (progn (compilation-set-window w marker)
+                          (compilation-set-overlay-arrow w))))
           (let* ((name (read-file-name
                         (format "Find this %s in (default %s): "
                                 compilation-error filename)