Subject: bug#75858: [PATCH] Display separators on tty menus with display table entries

From: Gerd Möllmann <[email-masked]>
Date: Sun, 26 Jan 2025 13:12:03 +0100

Tags: patch

This completes a point I left open last time I changed tty menu
separators: displaying separators with nicer Unicode chars.
Which can be activated with standard-display-unicode-special-glyphs.

In GNU Emacs 31.0.50 (build 22, aarch64-apple-darwin24.2.0) of
 2025-01-26 built on pro2
Repository revision: cdd32a73f8029102252ebb33fa42dbdec399969a
Repository branch: cl-packages
System Description:  macOS 15.2

Configured using:
 'configure --without-ns --cache-file
 /var/folders/1d/k_6t25f94sl83szqbf8gpkrh0000gn/T//config.cache.cl-packages
 --with-native-compilation --with-mps=yes CC=clang
 'CFLAGS=-Wgnu-imaginary-constant -Wunused-result -g -F
 /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX.sdk/System/Library/Frameworks
 -Wno-ignored-attributes -Wno-flag-enum -Wno-missing-method-return-type
 -Wno-variadic-macros -Wno-strict-prototypes -Wno-availability
 -Wno-nullability-completeness' --prefix=/Users/gerd/.local'

>From cdd32a73f8029102252ebb33fa42dbdec399969a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= <[email-masked]>
Date: Sun, 26 Jan 2025 11:31:32 +0100
Subject: [PATCH] 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.
---
 lisp/disp-table.el | 57 ++++++++++++++++++++++++++++++++++++++--------
 src/dispnew.c      |  7 ++++++
 src/disptab.h      | 10 ++++++--
 src/xdisp.c        | 39 +++++++++++++++++++------------
 4 files changed, 87 insertions(+), 26 deletions(-)

diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 38d45a0c336..6994d3706c5 100644
--- 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 @@ make-display-table
 (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,22 @@ make-display-table
 (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-horizontal', `box-down-right', `box-down-right', `box-up-left',
+`box-double-vertical',`box-double-horizontal', `box-double-down-right',
+`box-double-down-right', `box-double-up-left',"
   (let ((slot-number
 	 (if (numberp slot) slot
 	   (or (get slot 'display-table-slot)
@@ -70,11 +79,12 @@ display-table-slot
 ;;;###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',
-`box-horizontal', `box-down-right', `box-down-left', `box-up-right',
-and `box-up-left'."
+`selective-display', `vertical-border', `box-vertical',
+`box-horizontal', `box-down-right', `box-down-right', `box-up-left',
+`box-double-vertical',`box-double-horizontal', `box-double-down-right',
+`box-double-down-right', `box-double-up-left',"
   (let ((slot-number
 	 (if (numberp slot) slot
 	   (or (get slot 'display-table-slot)
@@ -97,6 +107,7 @@ describe-display-table
     (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 +120,20 @@ describe-display-table
     (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))
@@ -157,6 +182,7 @@ standard-display-unicode-special-glyphs
   (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 +194,20 @@ standard-display-unicode-special-glyphs
   (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 f8bc16af98a..1b4c5eb37cf 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -3641,6 +3641,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 8db9a06d2f4..5ab73715e6c 100644
--- a/src/disptab.h
+++ b/src/disptab.h
@@ -28,7 +28,6 @@ #define DISP_TABLE_P(obj)						    \
    && 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 @@ #define DISP_BORDER_GLYPH(dp) ((dp)->extras[5])
   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 d495fe584b3..d8363eb15ed 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -27278,33 +27278,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
-- 
2.48.1