From efc5a26fe2dca6ea221dbd2aebe0937f6ff397ba Mon Sep 17 00:00:00 2001 From: =?utf8?q?Gerd=20M=C3=B6llmann?= 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. * doc/lispref/display.texi: Add documentation. * etc/NEWS: Mention in NEWS. (cherry picked from commit 4e78a3e117f4ca0b6b9f3b7a2d7919cb5b2e0295) --- doc/lispref/display.texi | 36 ++++++++++++++++++++---- lisp/disp-table.el | 61 ++++++++++++++++++++++++++++++++++------ src/dispnew.c | 7 +++++ src/disptab.h | 10 +++++-- src/xdisp.c | 39 +++++++++++++++---------- 5 files changed, 121 insertions(+), 32 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 01962046af8..42cc4610572 100644 --- 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 38d45a0c336..738887d0d00 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 @@ (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 25a1e9701f2..f50f44c58ad 100644 --- 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 8db9a06d2f4..5ab73715e6c 100644 --- a/src/disptab.h +++ b/src/disptab.h @@ -28,7 +28,6 @@ along with GNU Emacs. If not, see . */ && 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 48fc1b58ffa..c6774452d66 100644 --- 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 -- 2.39.5