From 29d1c72d7c98ea23d5af434c5af6b39a5bd264d9 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sun, 25 Aug 2019 10:21:37 +0000 Subject: [PATCH] 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. --- doc/emacs/building.texi | 11 ++--- etc/NEWS | 5 +++ lisp/progmodes/compile.el | 90 +++++++++++++++++++++++++++++---------- 3 files changed, 79 insertions(+), 27 deletions(-) diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 990b82d10ed..f7809d4aa99 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -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 diff --git a/etc/NEWS b/etc/NEWS index 1d98ccab390..a03e2027a94 100644 --- a/etc/NEWS +++ b/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 +++ 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) -- 2.39.2