Commit 29d1c72d authored by Alan Mackenzie's avatar Alan Mackenzie

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.
parent 50980ba7
Pipeline #2980 passed with stage
in 56 minutes and 40 seconds
......@@ -266,11 +266,12 @@ fringe (@pxref{Fringes}), the locus-visiting commands put an arrow in
the fringe, pointing to the current error message. If the window has
no left fringe, such as on a text terminal, these commands scroll the
window so that the current message is at the top of the window. If
you change the variable @code{compilation-context-lines} to an integer
value @var{n}, these commands scroll the window so that the current
error message is @var{n} lines from the top, whether or not there is a
fringe; the default value, @code{nil}, gives the behavior described
above.
you change the variable @code{compilation-context-lines} to @code{t},
a visible arrow is inserted before column zero instead. If you change
the variable to an integer value @var{n}, these commands scroll the
window so that the current error message is @var{n} lines from the
top, whether or not there is a fringe; the default value, @code{nil},
gives the behavior described above.
@vindex compilation-error-regexp-alist
@vindex grep-regexp-alist
......
......@@ -558,6 +558,11 @@ that it doesn't bring any measurable benefit.
---
*** In 'compilation-error-regexp-alist', 'line' (and 'end-line') can
be functions.
+++
*** 'compilation-context-lines' can now take the value t; this is like
nil, but instead of scrolling the current line to the top of the
screen when there is no left fringe, it inserts a visible arrow before
column zero.
** cl-lib.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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment