[Patch]: Allow overlay arrows to be inserted before the text at column zero rather than splatting it.

[Alan Mackenzie]

Hello, Emacs.

Currently, when there are no fringes, inserting an overlay arrow
overwrites the first two characters on the pertinent line.  This is fine
for things like edebug, where the text is usually indented many columns
anyway, and only whitespace gets overwritten.

This is less good for things like compilation-mode, where this arrow
would obliterate the first two characters of a file name.

The following amendment fixes this by allowing the arrow to be displayed
at the BOL, displacing the rest of the line two characters to the right.
To do this, a new buffer local boolean variable, overlay-arrow-insert is
introduced.

The motivation for this amendment comes from bug#36832: "Supply option to
suppress scrolling in compilation mode buffers.".  To help people play
with this new facility, a proposed patch for lisp/progmodes/compile.el
is included beneath the main patch to src/xdisp.c.  After building Emacs
with both the patches, customise compilation-context-lines to t, and run
Emacs on a setup without fringes.

Here's the main patch:

Enable insertion of overlay arrow in front of text at column zero

* src/xdisp.c: (get_overlay_arrow_string): New function.
(overlay_arrow_at_row): Change second parameter from struct glyph_row to a
buffer/string position.
(set_cursor_from_row): Check glyph->charpos is initialized to a non-negative
number before using it in an Fget_char_property call (Four times).
(display_line): Before the main character loop, optionally insert the overlay
arrow, depending on overlay-arrow-string and overlay-arrow-insert.  After the
main character loop, amend the clause inserting the overlay arrow, not to
insert it twice.
(overlay-arrow-insert): New (lisp visible) variable.



diff --git a/src/xdisp.c b/src/xdisp.c
index 7338d2b7d4..8cfa78e3bc 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -6188,6 +6188,35 @@ get_overlay_strings (struct it *it, ptrdiff_t charpos)
   return STRINGP (it->string);
 }
 
+/* Set up IT for the insertion of the string OVERLAY_ARROW_STRING at
+   the current position in IT, and return true.  Do nothing and return
+   false if there is an error with the second parameter.  */
+
+static bool
+get_overlay_arrow_string (struct it *it, Lisp_Object overlay_arrow_string)
+{
+  if (STRINGP (overlay_arrow_string)
+      && SCHARS (overlay_arrow_string) > 0)
+    {
+      push_it (it, NULL);
+      IT_STRING_CHARPOS (*it) = IT_STRING_BYTEPOS (*it) = 0;
+      it->string = overlay_arrow_string;
+      it->s = NULL;
+      it->from_overlay = Qnil;
+      it->stop_charpos = 0;
+      it->end_charpos = it->string_nchars = SCHARS (overlay_arrow_string);
+      it->prev_stop = 0;
+      it->base_level_stop = 0;
+      it->multibyte_p = STRING_MULTIBYTE (overlay_arrow_string);
+      it->method = GET_FROM_STRING;
+      it->from_disp_prop_p = 0;
+      it->cmp_it.id = -1;
+      it->avoid_cursor_p = true;
+      it->face_id = it->base_face_id;
+      return true;
+    }
+  return false;
+}
 
 
 /***********************************************************************
@@ -13873,12 +13902,13 @@ update_overlay_arrows (int up_to_date)
 }
 
 
-/* Return overlay arrow string to display at row.
+/* Return overlay arrow string to display at row.  MIN_ROW_POS is the
+   buffer/string position of the beginning of the row.
    Return integer (bitmap number) for arrow bitmap in left fringe.
    Return nil if no overlay arrow.  */
 
 static Lisp_Object
-overlay_arrow_at_row (struct it *it, struct glyph_row *row)
+overlay_arrow_at_row (struct it *it, ptrdiff_t min_row_pos)
 {
   Lisp_Object vlist;
 
@@ -13896,7 +13926,7 @@ overlay_arrow_at_row (struct it *it, struct glyph_row 
*row)
 
       if (MARKERP (val)
          && current_buffer == XMARKER (val)->buffer
-         && (MATRIX_ROW_START_CHARPOS (row) == marker_position (val)))
+         && (min_row_pos == marker_position (val)))
        {
          if (FRAME_WINDOW_P (it->f)
              /* FIXME: if ROW->reversed_p is set, this should test
@@ -15237,11 +15267,12 @@ set_cursor_from_row (struct window *w, struct 
glyph_row *row,
          }
        else if (STRINGP (glyph->object))
          {
-           Lisp_Object chprop;
+           Lisp_Object chprop = Qnil;
            ptrdiff_t glyph_pos = glyph->charpos;
 
-           chprop = Fget_char_property (make_fixnum (glyph_pos), Qcursor,
-                                        glyph->object);
+           if (glyph_pos >= 0)
+              chprop = Fget_char_property (make_fixnum (glyph_pos), Qcursor,
+                                           glyph->object);
            if (!NILP (chprop))
              {
                /* If the string came from a `display' text property,
@@ -15321,11 +15352,12 @@ set_cursor_from_row (struct window *w, struct 
glyph_row *row,
          }
        else if (STRINGP (glyph->object))
          {
-           Lisp_Object chprop;
+           Lisp_Object chprop = Qnil;
            ptrdiff_t glyph_pos = glyph->charpos;
 
-           chprop = Fget_char_property (make_fixnum (glyph_pos), Qcursor,
-                                        glyph->object);
+           if (glyph_pos >= 0)
+              chprop = Fget_char_property (make_fixnum (glyph_pos), Qcursor,
+                                           glyph->object);
            if (!NILP (chprop))
              {
                ptrdiff_t prop_pos =
@@ -15508,12 +15540,13 @@ set_cursor_from_row (struct window *w, struct 
glyph_row *row,
                                 && EQ (glyph->object, str);
                               glyph += incr)
                            {
-                             Lisp_Object cprop;
+                             Lisp_Object cprop = Qnil;
                              ptrdiff_t gpos = glyph->charpos;
 
-                             cprop = Fget_char_property (make_fixnum (gpos),
-                                                         Qcursor,
-                                                         glyph->object);
+                             if (gpos >= 0)
+                                cprop = Fget_char_property (make_fixnum (gpos),
+                                                            Qcursor,
+                                                            glyph->object);
                              if (!NILP (cprop))
                                {
                                  cursor = glyph;
@@ -15642,8 +15675,9 @@ set_cursor_from_row (struct window *w, struct glyph_row 
*row,
              /* Previous candidate is a glyph from a string that has
                 a non-nil `cursor' property.  */
              || (STRINGP (g1->object)
-                 && (!NILP (Fget_char_property (make_fixnum (g1->charpos),
-                                               Qcursor, g1->object))
+                 && (((g1->charpos >= 0)
+                       && !NILP (Fget_char_property (make_fixnum (g1->charpos),
+                                                     Qcursor, g1->object)))
                      /* Previous candidate is from the same display
                         string as this one, and the display string
                         came from a text property.  */
@@ -21779,6 +21813,15 @@ display_line (struct it *it, int cursor_vpos)
       /* We only do this when not calling move_it_in_display_line_to
         above, because that function calls itself handle_line_prefix.  */
       handle_line_prefix (it);
+
+      /* Do we want to insert the overlay arrow (as opposed to overwriting
+         the first few glyphs (which is done later in this function)?  */
+      if (!NILP (Qoverlay_arrow_insert)
+          && (MATRIX_ROW_DISPLAYS_TEXT_P (row) || !overlay_arrow_seen)
+          && (overlay_arrow_string =
+              overlay_arrow_at_row (it, row->start.pos.charpos),
+              STRINGP (overlay_arrow_string)))
+        get_overlay_arrow_string (it, overlay_arrow_string);
     }
   else
     {
@@ -22472,8 +22515,13 @@ #define RECORD_MAX_MIN_POS(IT)                         
        \
      This is clearly a mess with variable size fonts.  It would be
      better to let it be displayed like cursors under X.  */
   if ((MATRIX_ROW_DISPLAYS_TEXT_P (row) || !overlay_arrow_seen)
-      && (overlay_arrow_string = overlay_arrow_at_row (it, row),
-         !NILP (overlay_arrow_string)))
+      && (overlay_arrow_string =
+          overlay_arrow_at_row (it, row->minpos.charpos),
+         !NILP (overlay_arrow_string))
+      /* Insert the found overlay arrow unless this was done before
+         the main character generating loop.  */
+      && (NILP (Qoverlay_arrow_insert)
+          || !STRINGP (overlay_arrow_string)))
     {
       /* Overlay arrow in window redisplay is a fringe bitmap.  */
       if (STRINGP (overlay_arrow_string))
@@ -33075,6 +33123,13 @@ syms_of_xdisp (void)
   Voverlay_arrow_variable_list
     = list1 (intern_c_string ("overlay-arrow-position"));
 
+  DEFVAR_BOOL ("overlay-arrow-insert", overlay_arrow_insert,
+    doc: /* Don't overwrite the contents of column zero with arrow when 
non-nil.
+Instead, insert the overlay arrow in front of the text there.  */);
+  overlay_arrow_insert = 0;
+  DEFSYM (Qoverlay_arrow_insert, "overlay-arrow-insert");
+  Fmake_variable_buffer_local (Qoverlay_arrow_insert);
+
   DEFVAR_INT ("scroll-step", emacs_scroll_step,
     doc: /* The number of lines to try scrolling a window by when point moves 
out.
 If that fails to bring point back on frame, point is centered instead.





And here is the patch to compile.el:


diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4cc1daf4fa..c41c184ec0 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -701,9 +701,8 @@ compilation-save-buffers-predicate
 ;;;###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"))))
 
@@ -2129,7 +2128,11 @@ compilation-setup
   (setq-local compilation-num-errors-found 0)
   (setq-local compilation-num-warnings-found 0)
   (setq-local compilation-num-infos-found 0)
-  (set (make-local-variable 'overlay-arrow-string) "")
+  (if (eq compilation-context-lines t)
+      (progn
+        (setq-local overlay-arrow-string "=>")
+        (setq-local overlay-arrow-insert t))
+    (setq-local overlay-arrow-string ""))
   (setq next-error-overlay-arrow-position nil)
   (add-hook 'kill-buffer-hook
            (lambda () (setq next-error-overlay-arrow-position nil)) nil t)
@@ -2575,28 +2578,33 @@ compilation-fake-loc
 
 (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, 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.  If nil and there is no left fringe, 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 next-error-highlight-timer)
 

-- 
Alan Mackenzie (Nuremberg, Germany).