mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-19 18:13:55 +00:00
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.
This commit is contained in:
parent
50980ba74e
commit
29d1c72d7c
@ -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
|
||||
|
5
etc/NEWS
5
etc/NEWS
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user