From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Alan Mackenzie Newsgroups: gmane.emacs.devel 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 Message-ID: <20190831113132.GB4822@ACM> References: <20190825102322.19558.22771@vcs0.savannah.gnu.org> <20190825102323.5080620CD5@vcs0.savannah.gnu.org> <20190825190637.GE4724@ACM> <838srhghoc.fsf@gnu.org> <20190827193652.GA20676@ACM> Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="135352"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Mutt/1.10.1 (2018-07-13) Cc: Eli Zaretskii , emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sat Aug 31 13:31:55 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1i41bm-000Z7h-GO for ged-emacs-devel@m.gmane.org; Sat, 31 Aug 2019 13:31:54 +0200 Original-Received: from localhost ([::1]:44148 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i41bl-00007D-5y for ged-emacs-devel@m.gmane.org; Sat, 31 Aug 2019 07:31:53 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:44127) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i41ba-00005j-So for emacs-devel@gnu.org; Sat, 31 Aug 2019 07:31:44 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1i41bZ-0001Bk-7b for emacs-devel@gnu.org; Sat, 31 Aug 2019 07:31:42 -0400 Original-Received: from colin.muc.de ([193.149.48.1]:42004 helo=mail.muc.de) by eggs.gnu.org with smtp (Exim 4.71) (envelope-from ) id 1i41bU-00016N-O2 for emacs-devel@gnu.org; Sat, 31 Aug 2019 07:31:39 -0400 Original-Received: (qmail 50069 invoked by uid 3782); 31 Aug 2019 10:38:43 -0000 Original-Received: from acm.muc.de (p2E5D5E4B.dip0.t-ipconnect.de [46.93.94.75]) by colin.muc.de (tmda-ofmipd) with ESMTP; Sat, 31 Aug 2019 12:38:41 +0200 Original-Received: (qmail 5692 invoked by uid 1000); 31 Aug 2019 11:31:33 -0000 Content-Disposition: inline In-Reply-To: X-Delivery-Agent: TMDA/1.1.12 (Macallan) X-Primary-Address: acm@muc.de X-detected-operating-system: by eggs.gnu.org: FreeBSD 9.x [fuzzy] X-Received-From: 193.149.48.1 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:239724 Archived-At: 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).