unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Alan Mackenzie <acm@muc.de>
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: Eli Zaretskii <eliz@gnu.org>, emacs-devel@gnu.org
Subject: Re: [Emacs-diffs] master 29d1c72: Introduce new value t for compilation-context-lines to eliminate scrolling
Date: Sat, 31 Aug 2019 11:31:33 +0000	[thread overview]
Message-ID: <20190831113132.GB4822@ACM> (raw)
In-Reply-To: <jwva7bumlmq.fsf-monnier+emacs@gnu.org>

Hello, Stefan.

Thanks for all the suggestions and corrections.

On Tue, Aug 27, 2019 at 15:59:27 -0400, Stefan Monnier wrote:
> Hi Alan,

> > +(defvar compilation-dummy-string ">"
> > +  "A string which is only a placeholder for compilation-margin-string.
> > +It's actual value is never used, but must be one character long.")
> > +(put-text-property 0 1 'display
> > +                   `((margin left-margin) ,compilation-margin-string)
> > +                   compilation-dummy-string)

> I'd suggest you use a "compilation--" prefix here since this is supposed
> to be internal, IIUC.

DONE.

> Also, I'd do it as

>     (defvar compilation--dummy-string
>       (propertize ">" 'display
>                   `((margin left-margin) ,compilation-margin-string))
>       "A string which is only a placeholder for `compilation-margin-string'.
>     Its actual value is never used, but must be one character long.")

> so you can M-C-x it without ill-effect [note I also fixed "It's" to
> "Its" and added `...' around the var ref.  ]

Thanks.  I've made it a defconst, too.

> > +(defun compilation-tear-down-arrow-spec-in-margin ()
> > +  "Restore compilation-arrow-overlay to not using the margin, which is removed."
> > +  (overlay-put compilation-arrow-overlay 'before-string nil)
> > +  (delete-overlay compilation-arrow-overlay)
> > +  (setq compilation-arrow-overlay nil)

> I think this `setq` loses the overlay and there's no code to reconstruct
> it later on.

Actually, it got reconstructed in compilation-set-overlay-arrow, which
was suboptimal.  I've moved this bit to
compilation-set-up-arrow-spec-in-margin, which is where it should have
been all along.

> > +  (set-window-margins (selected-window) 0))

> Of course, the main problem with this approach is that "margins don't
> compose": any other package using the margins (e.g. (n)linum) will tend
> to interfere with your own use.

I've amended this to add or subtract 2 to/from the current margin width,
rather than setting an absolute width.

> > +  (with-selected-window w        ; So the later `goto-char' will work.

> An alternative is to use `set-window-point` instead of `goto-char`.

Maybe.  But I'm already using (selected-window) in a couple of places,
so I think I'll just leave this.

>         Stefan

Here's the current version of the patch.  Any objections to me
committing it?



diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 09188dc14b..c30908ea01 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -2602,45 +2602,69 @@ compilation-set-window
 			       (point)))
          (set-window-point w mk))))
 
-(defvar-local overlay-arrow-overlay nil
+(defvar-local compilation-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.")
 
+(defvar compilation-margin-string "=>"
+  "The string which will appear in the margin in compilation mode.
+This must be two characters long; there should be no need to
+change the default.")
+(put-text-property 0 2 'face 'default compilation-margin-string)
+
+(defconst compilation--dummy-string
+  (propertize ">" 'display
+              `((margin left-margin) ,compilation-margin-string))
+  "A string which is only a placeholder for compilation-margin-string.
+Actual value is never used, only the text property.")
+
+(defun compilation-set-up-arrow-spec-in-margin ()
+  "Set up compilation-arrow-overlay to display as an arrow in a margin."
+  (setq overlay-arrow-string "")
+  (setq compilation-arrow-overlay
+	(make-overlay overlay-arrow-position overlay-arrow-position))
+  (overlay-put compilation-arrow-overlay
+               'before-string compilation--dummy-string)
+  (set-window-margins (selected-window) (+ (or (car (window-margins)) 0) 2)))
+
+(defun compilation-tear-down-arrow-spec-in-margin ()
+  "Restore compilation-arrow-overlay to not using the margin, which is removed."
+  (overlay-put compilation-arrow-overlay 'before-string nil)
+  (delete-overlay compilation-arrow-overlay)
+  (setq compilation-arrow-overlay nil)
+  (set-window-margins (selected-window) (- (car (window-margins)) 2)))
+
 (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)))))
+  (with-selected-window w        ; So the later `goto-char' will work.
+    (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', such that it will
+          ;; display in a 2-character margin.
+          (progn
+            (cond
+             ((overlayp compilation-arrow-overlay)
+              (when (not (eq (overlay-start compilation-arrow-overlay)
+		             overlay-arrow-position))
+	        (if overlay-arrow-position
+	            (move-overlay compilation-arrow-overlay
+			          overlay-arrow-position overlay-arrow-position)
+                  (compilation-tear-down-arrow-spec-in-margin))))
+
+             (overlay-arrow-position
+              (compilation-set-up-arrow-spec-in-margin)))
+            ;; Ensure that the "=>" remains in the window by causing
+            ;; the window to be scrolled, if needed.
+            (goto-char (overlay-start compilation-arrow-overlay)))
+
+        ;; `compilation-context-lines' isn't t, or we've got a left
+        ;; fringe, so remove any overlay arrow.
+        (when (overlayp compilation-arrow-overlay)
+          (compilation-tear-down-arrow-spec-in-margin))))))
 
 (defvar next-error-highlight-timer)
 

-- 
Alan Mackenzie (Nuremberg, Germany).



  reply	other threads:[~2019-08-31 11:31 UTC|newest]

Thread overview: 23+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
     [not found] <20190825102322.19558.22771@vcs0.savannah.gnu.org>
     [not found] ` <20190825102323.5080620CD5@vcs0.savannah.gnu.org>
2019-08-25 18:39   ` [Emacs-diffs] master 29d1c72: Introduce new value t for compilation-context-lines to eliminate scrolling Stefan Monnier
2019-08-25 19:06     ` Alan Mackenzie
2019-08-25 19:37       ` Eli Zaretskii
2019-08-26 16:26         ` Alan Mackenzie
2019-08-26 16:29           ` Eli Zaretskii
2019-08-27 20:05             ` Alan Mackenzie
2019-08-29 18:22               ` Eli Zaretskii
2019-08-31 10:53                 ` Alan Mackenzie
2019-08-31 11:06                   ` Eli Zaretskii
2019-09-02 19:34                     ` Alan Mackenzie
2019-09-03  2:25                       ` Eli Zaretskii
2019-09-08  9:41                     ` Margins example in the Elisp manual. [Was: [Emacs-diffs] master 29d1c72: Introduce new value t for compilation-context-lines to eliminate scrolling] Alan Mackenzie
2019-09-08 17:06                       ` Eli Zaretskii
2019-08-27 19:36         ` [Emacs-diffs] master 29d1c72: Introduce new value t for compilation-context-lines to eliminate scrolling Alan Mackenzie
2019-08-27 19:49           ` Eli Zaretskii
2019-08-27 20:07             ` Stefan Monnier
2019-08-27 19:59           ` Stefan Monnier
2019-08-31 11:31             ` Alan Mackenzie [this message]
2019-08-31 12:07               ` martin rudalics
2019-08-31 12:45                 ` Alan Mackenzie
2019-08-25 20:54       ` Stefan Monnier
2019-08-27 19:46         ` Alan Mackenzie
2019-08-27 20:05           ` Stefan Monnier

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20190831113132.GB4822@ACM \
    --to=acm@muc.de \
    --cc=eliz@gnu.org \
    --cc=emacs-devel@gnu.org \
    --cc=monnier@iro.umontreal.ca \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).