Display separators on tty menus with display table entries

* src/xdisp.c (display_tty_menu_separator): Lookup separator char in
standard-display-table, make a string, and display that using
display_string.
* src/xdisp.c (display_tty_menu_separator_char): New function.
(display_tty_menu_separator): Use it.
* lisp/disp-table.el (display-table): Increase from 12 to 18.
(box-double-vertical, box-double-horizontal, box-double-down-right)
(box-double-down-left, box-double-up-right, box-double-up-left): New
symbols for extra slots.
(display-table-slot, set-display-table-slot): Change doc string.
(describe-display-table): Describe new slots.
(standard-display-unicode-special-glyphs): Define new slots.
* src/disptab.h (DISP_TABLE_P): Add enumerators.
(DISP_TABLE_EXTRA_SLOTS): Define based on enum box.
* src/dispnew.c (produce_box_glyphs): Add new enumerators to switch to
make it exhaustive.
* src/xdisp.c (display_tty_menu_separator): Use BOX_DOUBLE_HORIZONTAL
for '=' if present.
* doc/lispref/display.texi: Add documentation.
* etc/NEWS: Mention in NEWS.

(cherry picked from commit 4e78a3e117f4ca0b6b9f3b7a2d7919cb5b2e0295)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 01962046af84fa20faf40b734be456a4ad12cfe5..42cc46105726bf05fd273b7098e6f29b125ba0a3 100644 (file)
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -8739,6 +8739,20 @@ scroll bars are supported and in use, a scroll bar separates the two
 windows, and if there are no vertical scroll bars and no dividers
 (@pxref{Window Dividers}), Emacs uses a thin line to indicate the
 border.
+
+@item 6 to 11
+
+The glyphs for a single-line border around child frames on a terminal,
+in the order of vertical, horizontal, down-right edge, down-left edge,
+up-right, and up-left edge glyphs.  The horizontal glyph is also used for
+the single-line tty menu separator.
+
+@item 12 to 17
+
+The glyphs for a double-line border, in the order of vertical,
+horizontal, down-right edge, down-left edge, up-right, and up-left edge
+glyphs. The horizontal glyph is also used for the single-line tty menu
+separator, the other glyphs are not yet used.
 @end table
 
   For example, here is how to construct a display table that mimics
@@ -8761,24 +8775,34 @@ the effect of setting @code{ctl-arrow} to a non-@code{nil} value
 @defun display-table-slot display-table slot
 This function returns the value of the extra slot @var{slot} of
 @var{display-table}.  The argument @var{slot} may be a number from 0 to
-5 inclusive, or a slot name (symbol).  Valid symbols are
-@code{truncation}, @code{wrap}, @code{escape}, @code{control},
-@code{selective-display}, and @code{vertical-border}.
+17 inclusive, or a slot name, a symbol.
 @end defun
 
 @defun set-display-table-slot display-table slot value
 This function stores @var{value} in the extra slot @var{slot} of
 @var{display-table}.  The argument @var{slot} may be a number from 0 to
-5 inclusive, or a slot name (symbol).  Valid symbols are
-@code{truncation}, @code{wrap}, @code{escape}, @code{control},
-@code{selective-display}, and @code{vertical-border}.
+17 inclusive, or a slot name, a symbol.
 @end defun
 
+Valid slot name symbols are @code{truncation}, @code{wrap},
+@code{escape}, @code{control}, @code{selective-display},
+@code{vertical-border}, @code{box-vertical}, @code{box-horizontal},
+@code{box-down-right}, @code{box-down-left}, @code{box-up-right},
+@code{box-up-left}, @code{box-double-vertical},
+@code{box-double-horizontal}, @code{box-double-down-right},
+@code{box-double-down-left}, @code{box-double-down-left},
+@code{box-double-up-left}.
+
 @defun describe-display-table display-table
 This function displays a description of the display table
 @var{display-table} in a help buffer.
 @end defun
 
+@defun standard-display-unicode-special-glyphs
+This function sets the extra slots of @var{standard-display-table} with
+suitable Unicode characters.
+@end defun
+
 @deffn Command describe-current-display-table
 This command displays a description of the current display table in a
 help buffer.

diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 38d45a0c336ec12640220ee3303c11bd4f7825a3..738887d0d00d1de81d7910c2e9b1befcffd48d58 100644 (file)
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -28,7 +28,7 @@
 
 ;;; Code:
 
-(put 'display-table 'char-table-extra-slots 12)
+(put 'display-table 'char-table-extra-slots 18)
 
 ;;;###autoload
 (defun make-display-table ()
@@ -46,6 +46,7 @@
 (put 'control 'display-table-slot 3)
 (put 'selective-display 'display-table-slot 4)
 (put 'vertical-border 'display-table-slot 5)
+
 (put 'box-vertical 'display-table-slot 6)
 (put 'box-horizontal 'display-table-slot 7)
 (put 'box-down-right 'display-table-slot 8)
@@ -53,14 +54,23 @@
 (put 'box-up-right 'display-table-slot 10)
 (put 'box-up-left 'display-table-slot 11)
 
+(put 'box-double-vertical 'display-table-slot 12)
+(put 'box-double-horizontal 'display-table-slot 13)
+(put 'box-double-down-right 'display-table-slot 14)
+(put 'box-double-down-left 'display-table-slot 15)
+(put 'box-double-up-right 'display-table-slot 16)
+(put 'box-double-up-left 'display-table-slot 17)
+
 ;;;###autoload
 (defun display-table-slot (display-table slot)
   "Return the value of the extra slot in DISPLAY-TABLE named SLOT.
-SLOT may be a number from 0 to 11 inclusive, or a slot name (symbol).
+SLOT may be a number from 0 to 17 inclusive, or a slot name (symbol).
 Valid symbols are `truncation', `wrap', `escape', `control',
 `selective-display', `vertical-border', `box-vertical',
 `box-horizontal', `box-down-right', `box-down-left', `box-up-right',
-and `box-up-left'."
+`box-up-left',`box-double-vertical', `box-double-horizontal',
+`box-double-down-right', `box-double-down-left',
+`box-double-up-left', `box-double-up-left',"
   (let ((slot-number
         (if (numberp slot) slot
           (or (get slot 'display-table-slot)
@@ -70,11 +80,13 @@ and `box-up-left'."
 ;;;###autoload
 (defun set-display-table-slot (display-table slot value)
   "Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE.
-SLOT may be a number from 0 to 11 inclusive, or a name (symbol).
+SLOT may be a number from 0 to 17 inclusive, or a name (symbol).
 Valid symbols are `truncation', `wrap', `escape', `control',
-`selective-display',  `vertical-border', `box-vertical',
+`selective-display', `vertical-border', `box-vertical',
 `box-horizontal', `box-down-right', `box-down-left', `box-up-right',
-and `box-up-left'."
+`box-up-left',`box-double-vertical', `box-double-horizontal',
+`box-double-down-right', `box-double-down-left',
+`box-double-up-left', `box-double-up-left',"
   (let ((slot-number
         (if (numberp slot) slot
           (or (get slot 'display-table-slot)
@@ -97,6 +109,7 @@ and `box-up-left'."
     (prin1 (display-table-slot dt 'selective-display))
     (princ "\nVertical window border glyph: ")
     (prin1 (display-table-slot dt 'vertical-border))
+
     (princ "\nBox vertical line glyph: ")
     (prin1 (display-table-slot dt 'box-vertical))
     (princ "\nBox horizonal line glyph: ")
@@ -109,6 +122,20 @@ and `box-up-left'."
     (prin1 (display-table-slot dt 'box-up-right))
     (princ "\nBox lower right corner glyph: ")
     (prin1 (display-table-slot dt 'box-up-left))
+
+    (princ "\nBox double vertical line glyph: ")
+    (prin1 (display-table-slot dt 'box-double-vertical))
+    (princ "\nBox double horizonal line glyph: ")
+    (prin1 (display-table-slot dt 'box-double-horizontal))
+    (princ "\nBox double upper left corner glyph: ")
+    (prin1 (display-table-slot dt 'box-double-down-right))
+    (princ "\nBox double upper right corner glyph: ")
+    (prin1 (display-table-slot dt 'box-double-down-left))
+    (princ "\nBox double lower left corner glyph: ")
+    (prin1 (display-table-slot dt 'box-double-up-right))
+    (princ "\nBox double lower right corner glyph: ")
+    (prin1 (display-table-slot dt 'box-double-up-left))
+
     (princ "\nCharacter display glyph sequences:\n")
     (with-current-buffer standard-output
       (let ((vector (make-vector 256 nil))
@@ -152,11 +179,14 @@ and `box-up-left'."
 (defun standard-display-unicode-special-glyphs ()
   "Display some glyps using Unicode characters.
 The glyphs being changed by this function are `vertical-border',
-`box-vertical', `box-horizontal', `box-down-right', `box-down-left',
-`box-up-right', and `box-up-left'."
+`box-vertical',`box-horizontal', `box-down-right', `box-down-left',
+`box-up-right', `box-up-left',`box-double-vertical',
+`box-double-horizontal', `box-double-down-right',
+`box-double-down-left', `box-double-up-right', `box-double-up-left',"
   (interactive)
   (set-display-table-slot standard-display-table
                          'vertical-border (make-glyph-code #x2502))
+
   (set-display-table-slot standard-display-table
                          'box-vertical (make-glyph-code #x2502))
   (set-display-table-slot standard-display-table
@@ -168,7 +198,20 @@ The glyphs being changed by this function are `vertical-border',
   (set-display-table-slot standard-display-table
                          'box-up-right (make-glyph-code #x2514))
   (set-display-table-slot standard-display-table
-                         'box-up-left (make-glyph-code #x2518)))
+                         'box-up-left (make-glyph-code #x2518))
+
+  (set-display-table-slot standard-display-table
+                         'box-double-vertical (make-glyph-code #x2551))
+  (set-display-table-slot standard-display-table
+                         'box-double-horizontal (make-glyph-code #x2550))
+  (set-display-table-slot standard-display-table
+                         'box-double-down-right (make-glyph-code #x2554))
+  (set-display-table-slot standard-display-table
+                         'box-double-down-left (make-glyph-code #x2557))
+  (set-display-table-slot standard-display-table
+                         'box-double-up-right (make-glyph-code #x255a))
+  (set-display-table-slot standard-display-table
+                         'box-double-up-left (make-glyph-code #x255d)))
 
 ;;;###autoload
 (defun standard-display-8bit (l h)

diff --git a/src/dispnew.c b/src/dispnew.c
index 25a1e9701f218c915795cae7b9229f92b8cabd0b..f50f44c58ad253671c8b86103fecd3e62bd619a3 100644 (file)
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -3611,6 +3611,13 @@ produce_box_glyphs (enum box box, struct glyph_row *row, int x, int n,
     case BOX_UP_LEFT:
       dflt = '+';
       break;
+    case BOX_DOUBLE_VERTICAL:
+    case BOX_DOUBLE_HORIZONTAL:
+    case BOX_DOUBLE_DOWN_RIGHT:
+    case BOX_DOUBLE_DOWN_LEFT:
+    case BOX_DOUBLE_UP_RIGHT:
+    case BOX_DOUBLE_UP_LEFT:
+      emacs_abort ();
     }
 
   /* FIXME/tty: some face for the border.  */

diff --git a/src/disptab.h b/src/disptab.h
index 8db9a06d2f45e2885d9b8d4378fb3f65338ce903..5ab73715e6cf6a67a58ecef7e863a13f57fce663 100644 (file)
--- a/src/disptab.h
+++ b/src/disptab.h
@@ -28,7 +28,6 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    && EQ (XCHAR_TABLE (obj)->purpose, Qdisplay_table)                      \
    && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (obj)) == DISP_TABLE_EXTRA_SLOTS)
 
-#define DISP_TABLE_EXTRA_SLOTS 12
 #define DISP_TRUNC_GLYPH(dp) ((dp)->extras[0])
 #define DISP_CONTINUE_GLYPH(dp) ((dp)->extras[1])
 #define DISP_ESCAPE_GLYPH(dp) ((dp)->extras[2])
@@ -43,7 +42,14 @@ enum box
   BOX_DOWN_RIGHT,
   BOX_DOWN_LEFT,
   BOX_UP_RIGHT,
-  BOX_UP_LEFT
+  BOX_UP_LEFT,
+  BOX_DOUBLE_VERTICAL,
+  BOX_DOUBLE_HORIZONTAL,
+  BOX_DOUBLE_DOWN_RIGHT,
+  BOX_DOUBLE_DOWN_LEFT,
+  BOX_DOUBLE_UP_RIGHT,
+  BOX_DOUBLE_UP_LEFT
+#define DISP_TABLE_EXTRA_SLOTS (BOX_DOUBLE_UP_LEFT + 1)
 };
 
 extern Lisp_Object disp_char_vector (struct Lisp_Char_Table *, int);

diff --git a/src/xdisp.c b/src/xdisp.c
index 48fc1b58ffa0e41de85a3a1ab02a5e502b0440f7..c6774452d664abc8399fb1df3d8a8c8b965c8480 100644 (file)
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -27272,33 +27272,42 @@ deep_copy_glyph_row (struct frame *f, struct glyph_row *to, struct glyph_row *fr
     fill_up_frame_row_with_spaces (f, to, to_used);
 }
 
+/* Return the character to be used for displaying a tty menu separator.
+   C is the character to be used by default.  BOX is the display table
+   entry for the character to be used instead.  It is looked up in
+   standard-display-table.  Value is the character to use.  */
+
+static int
+display_tty_menu_separator_char (int c, enum box box)
+{
+  if (DISP_TABLE_P (Vstandard_display_table))
+    {
+      struct Lisp_Char_Table *dp = XCHAR_TABLE (Vstandard_display_table);
+      Lisp_Object gc = dp->extras[box];
+      if (GLYPH_CODE_P (gc))
+       c = GLYPH_CODE_CHAR (gc);
+    }
+  return c;
+}
+
 /* Produce glyphs for a menu separator on a tty.
 
    FIXME: This is only a "good enough for now" implementation of menu
    separators as described in the Elisp info manual.  We should probably
-   ignore menu separators when computing the width of a menu.  Secondly,
-   optionally using Unicode characters via display table entries would
-   be nice.  Patches very welcome.  */
+   ignore menu separators when computing the width of a menu.  */
 
 static void
 display_tty_menu_separator (struct it *it, const char *label, int width)
 {
-  USE_SAFE_ALLOCA;
-  char c;
+  int c;
   if (strcmp (label, "--space") == 0)
     c = ' ';
   else if (strcmp (label, "--double-line") == 0)
-    c = '=';
+    c = display_tty_menu_separator_char ('=', BOX_DOUBLE_HORIZONTAL);
   else
-    c = '-';
-  char *sep = SAFE_ALLOCA (width);
-  memset (sep, c, width - 1);
-  sep[width -  1] = 0;
-  display_string (sep, Qnil, Qnil, 0, 0, it, width - 1, width - 1,
-                 FRAME_COLS (it->f) - 1, -1);
-  display_string (" ", Qnil, Qnil, 0, 0, it, 1, 0,
-                 FRAME_COLS (it->f) - 1, -1);
-  SAFE_FREE ();
+    c = display_tty_menu_separator_char ('-', BOX_HORIZONTAL);
+  Lisp_Object sep = Fmake_string (make_fixnum (width - 1), make_fixnum (c), Qt);
+  display_string ((char *) SDATA (sep), Qnil, Qnil, 0, 0, it, width, -1, -1, 1);
 }
 
 /* Display one menu item on a TTY, by overwriting the glyphs in the