[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 29d1c72: Introduce new value t for compilation-cont
From: |
Alan Mackenzie |
Subject: |
[Emacs-diffs] master 29d1c72: Introduce new value t for compilation-context-lines to eliminate scrolling |
Date: |
Sun, 25 Aug 2019 06:23:22 -0400 (EDT) |
branch: master
commit 29d1c72d7c98ea23d5af434c5af6b39a5bd264d9
Author: Alan Mackenzie <address@hidden>
Commit: Alan Mackenzie <address@hidden>
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 990b82d..f7809d4 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 1d98cca..a03e202 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 4cc1daf..09188dc 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)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 29d1c72: Introduce new value t for compilation-context-lines to eliminate scrolling,
Alan Mackenzie <=