Re: tabulated-list-init-header and glyphless-char-display

[Chong Yidong <cyd@stupidchicken.com>]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Chong Yidong <cyd@stupidchicken.com>
>> Cc: emacs-devel@gnu.org
>> Date: Fri, 08 Apr 2011 14:27:37 -0400
>> 
>> We can probably use "^" and "v" when the unicode glyphs cannot be
>> displayed, but it sure would be nice to the glyphs whereever possible.
>> Any idea how to go about checking this?
>
> I think you will find glyphless-char-display (which is a char-table)
> useful.

Thanks.  This doesn't quite do what I want, because (i) it applies to
the entire buffer, when I only want it to apply to one particular glyph,
and (ii) the char table's "fallback display" slot applies to all glyphs
with no fonts, when I only want to handle two particular glyphs.

I propose introducing a `glyphless-char-display-default' text-property,
which, if non-nil, overrides glyphless-char-display's "fallback display"
slot locally.  See attached patch, which seems to do the right thing.
Thoughts?


*** src/xdisp.c	2011-04-09 16:35:19 +0000
--- src/xdisp.c	2011-04-09 19:18:08 +0000
***************
*** 736,741 ****
--- 736,742 ----
  
  /* Symbol for the purpose of Vglyphless_char_display.  */
  Lisp_Object Qglyphless_char_display;
+ Lisp_Object Qglyphless_char_display_default;
  
  /* Method symbols for Vglyphless_char_display.  */
  static Lisp_Object Qhex_code, Qempty_box, Qthin_space, Qzero_width;
***************
*** 5579,5587 ****
  Lisp_Object
  lookup_glyphless_char_display (int c, struct it *it)
  {
!   Lisp_Object glyphless_method = Qnil;
  
!   if (CHAR_TABLE_P (Vglyphless_char_display)
        && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) >= 1)
      glyphless_method = (c >= 0
  			? CHAR_TABLE_REF (Vglyphless_char_display, c)
--- 5580,5592 ----
  Lisp_Object
  lookup_glyphless_char_display (int c, struct it *it)
  {
!   Lisp_Object glyphless_method
!     = (c < 0)
!     ? get_it_property (it, Qglyphless_char_display_default)
!     : Qnil;
  
!   if (NILP (glyphless_method)
!       && CHAR_TABLE_P (Vglyphless_char_display)
        && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) >= 1)
      glyphless_method = (c >= 0
  			? CHAR_TABLE_REF (Vglyphless_char_display, c)
***************
*** 26974,26979 ****
--- 26979,26986 ----
    Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots");
    Fput (Qglyphless_char_display, Qchar_table_extra_slots, make_number (1));
  
+   DEFSYM (Qglyphless_char_display_default, "glyphless-char-display-default");
+ 
    DEFVAR_LISP ("glyphless-char-display", Vglyphless_char_display,
  	       doc: /* Char-table to control displaying of glyphless characters.
  Each element, if non-nil, is an ASCII acronym string (displayed in a box)
*** lisp/emacs-lisp/tabulated-list.el	2011-04-06 21:55:08 +0000
--- lisp/emacs-lisp/tabulated-list.el	2011-04-09 19:23:20 +0000
***************
*** 143,148 ****
--- 143,154 ----
      map)
    "Local keymap for `tabulated-list-mode' sort buttons.")
  
+ (defvar tabulated-list-up-arrow
+   (propertize "▲" 'glyphless-char-display-default 'thin-space))
+ 
+ (defvar tabulated-list-down-arrow
+   (propertize "▼" 'glyphless-char-display-default 'thin-space))
+ 
  (defun tabulated-list-init-header ()
    "Set up header line for the Tabulated List buffer."
    (let ((x tabulated-list-padding)
***************
*** 167,179 ****
  	  ;; The selected sort column
  	  ((equal (car col) (car tabulated-list-sort-key))
  	   (apply 'propertize
! 		  (concat label
! 			  (cond
! 			   ((> (+ 2 (length label)) width)
! 			    "")
! 			   ((cdr tabulated-list-sort-key)
! 			    " ▲")
! 			   (t " ▼")))
  		  'face 'bold
  		  'tabulated-list-column-name (car col)
  		  button-props))
--- 173,185 ----
  	  ;; The selected sort column
  	  ((equal (car col) (car tabulated-list-sort-key))
  	   (apply 'propertize
! 		  (cond
! 		   ((> (+ 2 (length label)) width)
! 		    label)
! 		   ((cdr tabulated-list-sort-key)
! 		    (concat label " " tabulated-list-up-arrow))
! 		   (t
! 		    (concat label " " tabulated-list-down-arrow)))
  		  'face 'bold
  		  'tabulated-list-column-name (car col)
  		  button-props))