[PATCH+RFD] Display tables -- fun for the whole family

As dilligent readers of xemacs-patches have noted, I've taken a look at the display-table related diatribe near the beginning of create_text_block(), and concluded that XEmacs' data structures are sufficient to represent what's being described there (it probably wasn't the case at the time of writing.) So I took some time and wrote a patch that implements a framework for what is being described there. With the patch, legal values for display tables become vectors (for backward compatibility), char-tables, and range-tables, or a list of those. The mappings can also be lists, which allows us to specify special values, such as `(format "%x")', or whatever. I've tested these things as implemented by the appended patch, and they work fine. I have some questions regarding the next step: 1) What do we do with the existing `make-display-table' interface? As is typical for broken old FSF design, the interface is totally non-abstract -- one is supposed to create display-tables using `make-display-table', but there is no function for getting or setting their elements -- the code simply uses `aref', `aset', `vectorp' and stuff. :-( To make the concept useful, we might change `make-display-table' to create a generic char-table, and modify `aset' and `aref' to handle char-tables, but it would probably still break programs that use `vectorp' and stuff to test for disptables. I think we should give up on `make-display-table' thing (i.e. leave it returning a vector), and simply document what the display tables can be, and stick to it. Or think of an all-new all-singing interface, given that our specifier-based implementation is incompatible anyway. 2) How do I implement the proposed `format' entry? Calling sprintf() for each character in turn seems very slow and unsafe. OTOH, rolling my own implementation looks non-trivial. 3) I would really like the multiple specifications of display tables to be merged. For example, if someone writes: (let ((dt (make-range-table))) (put-range-table 256 1000000 "[MULE JUNK]" dt) (set-specifier current-display-table dt (selected-window))) I would really like the characters unspecified by DT to be looked up in the other display tables specified by the specifier. On a similar note, I would like a statement like the above to *not* lose the special provisions we're making for nbsp character that just happen to be implemented using a display-table. Etc. I tried to look at the specifier interface in search of this, and found that there are absolutely no provisions for anything of the kind, and that the implementation of Fspecifier_instance() is highly non-trivial. Am asking for too much from specifiers? 4) Like the specifiers, I would really really like the display tables of faces in overlapping extents to be merged properly[1]. This means that if the extents with faces `foo' and `bar' overlap, that all the display tables of faces `foo', `bar', and the specifier-based display tables are searched for the character specification, until one matches. In the current implementation, only one display-table is used (OK, two, one for all the faces, and one for the window.) I'm not sure how to implement this, but I can envision two approaches: one approach would mandate each face cachel to contain a Dynarr of display tables, which would be kept current. Then display_table_entry would simply get the cachel table list. The other approach is to keep a range-table in the cachel, and merge all the display tables into the range-table. This might be computationally expensive, but saving some space. It might make display_table_entry() faster for a larger number of display tables. Currently I'm leaning to the former approach, but I'm open for suggestions. [1] I would also like to implement a `display-table' property of extent, but that would be trivial if we get the other things done. As you will note, the patch that adds this basic functionality is not very complex. 1998-11-29 Hrvoje Niksic <hniksic(a)srce.hr&gt; * specifier.c (display_table_validate): Update. * redisplay.c (create_text_block): Use them. * glyphs.c (display_table_entry): New function. (get_display_tables): Ditto. --- src/glyphs.c.orig Sun Nov 29 01:36:06 1998 +++ src/glyphs.c Mon Nov 30 00:41:50 1998 ＠＠ -38,6 +38,8 ＠＠ #include "objects.h" #include "redisplay.h" #include "window.h" +#include "chartab.h" +#include "rangetab.h" #ifdef HAVE_XPM #include <X11/xpm.h> ＠＠ -3205,31 +3207,83 ＠＠ * display tables * *****************************************************************************/ -/* Get the display table for use currently on window W with face FACE. - Precedence: +/* Get the display tables for use currently on window W with face + FACE. #### This will have to be redone. */ - -- FACE's display table - -- W's display table (comes from specifier `current-display-table') - - Ignore the specified tables if they are not valid; - if no valid table is specified, return 0. */ - -struct Lisp_Vector * -get_display_table (struct window *w, face_index findex) +void +get_display_tables (struct window *w, face_index findex, + Lisp_Object *face_table, Lisp_Object *window_table) { Lisp_Object tem; - tem = WINDOW_FACE_CACHEL_DISPLAY_TABLE (w, findex); - if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE) - return XVECTOR (tem); - + if (UNBOUNDP (tem)) + tem = Qnil; + if (!LISTP (tem)) + tem = noseeum_cons (tem, Qnil); + *face_table = tem; tem = w->display_table; - if (VECTORP (tem) && XVECTOR_LENGTH (tem) == DISP_TABLE_SIZE) - return XVECTOR (tem); - - return 0; + if (UNBOUNDP (tem)) + tem = Qnil; + if (!LISTP (tem)) + tem = noseeum_cons (tem, Qnil); + *window_table = tem; } +Lisp_Object +display_table_entry (Emchar ch, Lisp_Object face_table, + Lisp_Object window_table) +{ + Lisp_Object tail; + + /* Loop over FACE_TABLE, and then over WINDOW_TABLE. */ + for (tail = face_table; 1; tail = XCDR (tail)) + { + Lisp_Object table; + if (NILP (tail)) + { + if (!NILP (window_table)) + { + tail = window_table; + window_table = Qnil; + } + else + return Qnil; + } + table = XCAR (tail); + + if (VECTORP (table)) + { + if (ch < XVECTOR_LENGTH (table) && !NILP (XVECTOR_DATA (table)[ch])) + return XVECTOR_DATA (table)[ch]; + else + continue; + } + else if (CHAR_TABLEP (table) + && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_CHAR) + { + return get_char_table (ch, XCHAR_TABLE (table)); + } + else if (CHAR_TABLEP (table) + && XCHAR_TABLE_TYPE (table) == CHAR_TABLE_TYPE_GENERIC) + { + Lisp_Object gotit = get_char_table (ch, XCHAR_TABLE (table)); + if (!NILP (gotit)) + return gotit; + else + continue; + } + else if (RANGE_TABLEP (table)) + { + Lisp_Object gotit = Fget_range_table (make_char (ch), table, Qnil); + if (!NILP (gotit)) + return gotit; + else + continue; + } + else + abort (); + } +}  /***************************************************************************** * initialization * --- src/glyphs.h.orig Sun Nov 29 01:05:42 1998 +++ src/glyphs.h Mon Nov 30 00:32:51 1998 ＠＠ -567,9 +567,8 ＠＠ /* Display Tables */ /************************************************************************/ -#define DISP_TABLE_SIZE 256 -#define DISP_CHAR_ENTRY(dp, c) ((c < (dp)->size) ? (dp)->contents[c] : Qnil) - -struct Lisp_Vector *get_display_table (struct window *, face_index); +Lisp_Object display_table_entry (Emchar, Lisp_Object, Lisp_Object); +void get_display_tables (struct window *, face_index, + Lisp_Object *, Lisp_Object *); #endif /* _XEMACS_GLYPHS_H_ */ --- src/specifier.c.orig Sun Nov 29 02:08:16 1998 +++ src/specifier.c Mon Nov 30 00:52:59 1998 ＠＠ -37,7 +37,8 ＠＠ #include "opaque.h" #include "specifier.h" #include "window.h" -#include "glyphs.h" /* for DISP_TABLE_SIZE definition */ +#include "chartab.h" +#include "rangetab.h" Lisp_Object Qspecifierp; Lisp_Object Qprepend, Qappend, Qremove_tag_set_prepend, Qremove_tag_set_append; ＠＠ -2994,14 +2995,38 ＠＠ DEFINE_SPECIFIER_TYPE (display_table); +#define VALID_SINGLE_DISPTABLE_INSTANTIATOR_P(x) \ + (VECTORP (instantiator) \ + || (CHAR_TABLEP (instantiator) \ + && (XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_CHAR \ + || XCHAR_TABLE_TYPE (instantiator) == CHAR_TABLE_TYPE_GENERIC)) \ + || RANGE_TABLEP (instantiator)) + static void display_table_validate (Lisp_Object instantiator) { - if (!NILP(instantiator) && - (!VECTORP (instantiator) || - XVECTOR_LENGTH (instantiator) != DISP_TABLE_SIZE)) - dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol, - instantiator); + if (NILP (instantiator)) + /* OK */ + ; + else if (CONSP (instantiator)) + { + Lisp_Object tail; + EXTERNAL_LIST_LOOP (tail, instantiator) + { + Lisp_Object car = XCAR (tail); + if (!VALID_SINGLE_DISPTABLE_INSTANTIATOR_P (car)) + goto lose; + } + } + else + { + if (!VALID_SINGLE_DISPTABLE_INSTANTIATOR_P (instantiator)) + { + lose: + dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol, + instantiator); + } + } } DEFUN ("display-table-specifier-p", Fdisplay_table_specifier_p, 1, 1, 0, /* --- src/redisplay.c.orig Sun Nov 29 00:56:46 1998 +++ src/redisplay.c Mon Nov 30 12:29:38 1998 ＠＠ -255,7 +255,8 ＠＠ struct glyph_cachel *cachel); static Bytind create_text_block (struct window *w, struct display_line *dl, Bytind bi_start_pos, int start_col, - prop_block_dynarr **prop, int type); + prop_block_dynarr **prop, + int type); static int create_overlay_glyph_block (struct window *w, struct display_line *dl); static void create_left_glyph_block (struct window *w, ＠＠ -680,7 +681,8 ＠＠ static Bufpos generate_display_line (struct window *w, struct display_line *dl, int bounds, Bufpos start_pos, int start_col, - prop_block_dynarr **prop, int type) + prop_block_dynarr **prop, + int type) { Bufpos ret_bufpos; int overlay_width; ＠＠ -1232,66 +1234,12 ＠＠ } } -/* Given a display table entry, call the appropriate functions to - display each element of the entry. */ - static prop_block_dynarr * -add_disp_table_entry_runes (pos_data *data, Lisp_Object entry) +add_disp_table_entry_runes_1 (pos_data *data, Lisp_Object entry) { prop_block_dynarr *prop = NULL; - if (VECTORP (entry)) - { - struct Lisp_Vector *de = XVECTOR (entry); - long len = vector_length (de); - int elt; - - for (elt = 0; elt < len; elt++) - { - if (NILP (de->contents[elt])) - continue; - else if (STRINGP (de->contents[elt])) - { - prop = - add_bufbyte_string_runes - (data, - XSTRING_DATA (de->contents[elt]), - XSTRING_LENGTH (de->contents[elt]), - 0); - } - else if (GLYPHP (de->contents[elt])) - { - if (data->start_col) - data->start_col--; - - if (!data->start_col && data->bi_start_col_enabled) - { - prop = add_hscroll_rune (data); - } - else - { - struct glyph_block gb; - - gb.glyph = de->contents[elt]; - gb.extent = Qnil; - prop = add_glyph_rune (data, &gb, BEGIN_GLYPHS, 0, 0); - } - } - else if (CHAR_OR_CHAR_INTP (de->contents[elt])) - { - data->ch = XCHAR_OR_CHAR_INT (de->contents[elt]); - prop = add_emchar_rune (data); - } - /* Else blow it off because someone added a bad entry and we - don't have any safe way of signaling an error. */ - - /* #### Still need to add any remaining elements to the - propagation information. */ - if (prop) - return prop; - } - } - else if (STRINGP (entry)) + if (STRINGP (entry)) { prop = add_bufbyte_string_runes (data, XSTRING_DATA (entry), ＠＠ -1321,10 +1269,79 ＠＠ data->ch = XCHAR_OR_CHAR_INT (entry); prop = add_emchar_rune (data); } + else if (CONSP (entry)) + { + if (EQ (XCAR (entry), Qformat) + && CONSP (XCDR (entry)) + && STRINGP (XCAR (XCDR (entry)))) + { + Lisp_Object format = XCAR (XCDR (entry)); + Bytind len = XSTRING_LENGTH (format); + Bufbyte *src = XSTRING_DATA (format), *end = src + len; + Bufbyte *result = alloca_array (Bufbyte, len); + Bufbyte *dst = result; + + while (src < end) + { + Emchar c = charptr_emchar (src); + INC_CHARPTR (src); + if (c != '%' || src == end) + dst += set_charptr_emchar (dst, c); + else + { + c = charptr_emchar (src); + INC_CHARPTR (src); + switch (c) + { + /*case 'x': + dst += long_to_string_base ((char *)dst, data->ch, 16); + break;*/ + case '%': + dst += set_charptr_emchar (dst, '%'); + break; + } + } + } + prop = add_bufbyte_string_runes (data, result, dst - result, 0); + } + } /* Else blow it off because someone added a bad entry and we don't - have any safe way of signaling an error. Hey, this comment - sounds familiar. */ + have any safe way of signaling an error. */ + return prop; +} + +/* Given a display table entry, call the appropriate functions to + display each element of the entry. */ + +static prop_block_dynarr * +add_disp_table_entry_runes (pos_data *data, Lisp_Object entry) +{ + prop_block_dynarr *prop = NULL; + if (VECTORP (entry)) + { + struct Lisp_Vector *de = XVECTOR (entry); + EMACS_INT len = vector_length (de); + int elt; + + for (elt = 0; elt < len; elt++) + { + if (NILP (vector_data (de)[elt])) + continue; + else + prop = add_disp_table_entry_runes_1 (data, vector_data (de)[elt]); + /* Else blow it off because someone added a bad entry and we + don't have any safe way of signaling an error. Hey, this + comment sounds familiar. */ + + /* #### Still need to add any remaining elements to the + propagation information. */ + if (prop) + return prop; + } + } + else + prop = add_disp_table_entry_runes_1 (data, entry); return prop; } ＠＠ -1743,14 +1760,14 ＠＠ static Bytind create_text_block (struct window *w, struct display_line *dl, Bytind bi_start_pos, int start_col, - prop_block_dynarr **prop, int type) + prop_block_dynarr **prop, + int type) { struct frame *f = XFRAME (w->frame); struct buffer *b = XBUFFER (w->buffer); struct device *d = XDEVICE (f->device); pos_data data; - struct Lisp_Vector *dt = 0; /* Don't display anything in the minibuffer if this window is not on a selected frame. We consider all other windows to be active ＠＠ -1783,45 +1800,41 ＠＠ into a more general conversion mechanism. Ideally you could specify a Lisp function that converts characters, but this violates the Second Golden Rule and besides would - make things way way way way slow. An idea I like is to - be able to specify multiple display tables instead of just - one. Each display table can specify conversions for some - characters and leave others unchanged. The way the - character gets displayed is determined by the first display - table with a binding for that character. This way, you - could call a function `enable-hex-display' that adds a - pre-defined hex display-table (or maybe computes one if - you give weird parameters to the function) and adds it - to the list of display tables for the current buffer. - - Unfortunately there are still problems dealing with Mule - characters. For example, maybe I want to specify that - all extended characters (i.e. >= 256) are displayed in hex. - It's not reasonable to create a mapping for all possible - such characters, because there are about 2^19 of them. - One way of dealing with this is to extend the concept - of what a display table is. Currently it's only allowed - to be a 256-entry vector. Instead, it should be something - like: - - a) A 256-entry vector, for backward compatibility - b) char-table, mapping characters to values - c) range-table, mapping ranges of characters to values. - - Also, extend the concept of "mapping" to include a - printf-like spec. Then, you could make all extended - characters show up as hex with a display table like + make things way way way way slow. - #s(range-table data ((256 524288) (format "%x"))) + So instead, we extend the display-table concept, which was + historically limited to 256-byte vectors, to one of the + following: + + a) A 256-entry vector, for backward compatibility; + b) char-table, mapping characters to values; + c) range-table, mapping ranges of characters to values; + d) a list of the above. + + The (d) option allows you to specify multiple display tables + instead of just one. Each display table can specify conversions + for some characters and leave others unchanged. The way the + character gets displayed is determined by the first display table + with a binding for that character. This way, you could call a + function `enable-hex-display' that adds a hex display-table to + the list of display tables for the current buffer. + + #### ...not yet implemented... Also, we extend the concept of + "mapping" to include a printf-like spec. Thus you can make all + extended characters show up as hex with a display table like + this: + + #s(range-table data ((256 524288) (format "%x"))) Since more than one display table is possible, you have - great flexibility in mapping ranges of characters. - */ + great flexibility in mapping ranges of characters. */ Emchar printable_min = (CHAR_OR_CHAR_INTP (b->ctl_arrow) ? XCHAR_OR_CHAR_INT (b->ctl_arrow) : ((EQ (b->ctl_arrow, Qt) || EQ (b->ctl_arrow, Qnil)) ? 255 : 160)); + Lisp_Object face_dt, window_dt; + /* The text display block for this display line. */ struct display_block *db = get_display_block_from_line (dl, TEXT); ＠＠ -1960,10 +1973,10 ＠＠ /* Remember that the extent-fragment routines deal in Bytind's. */ extent_fragment_update (w, data.ef, data.bi_bufpos); + get_display_tables (w, data.findex, &face_dt, &window_dt); + if (data.bi_bufpos == data.ef->end) no_more_frags = 1; - - dt = get_display_table (w, data.findex); } initial = 0; ＠＠ -2075,16 +2088,17 ＠＠ else { + Lisp_Object entry = Qnil; /* Get the character at the current buffer position. */ data.ch = BI_BUF_FETCH_CHAR (b, data.bi_bufpos); + if (!NILP (face_dt) || !NILP (window_dt)) + entry = display_table_entry (data.ch, face_dt, window_dt); /* If there is a display table entry for it, hand it off to add_disp_table_entry_runes and let it worry about it. */ - if (dt && !NILP (DISP_CHAR_ENTRY (dt, data.ch))) + if (!NILP (entry) && !EQ (entry, make_char (data.ch))) { - *prop = - add_disp_table_entry_runes (&data, - DISP_CHAR_ENTRY (dt, data.ch)); + *prop = add_disp_table_entry_runes (&data, entry); if (*prop) goto done; ＠＠ -4308,7 +4322,7 ＠＠ } if (prop) - Dynarr_free (prop); + Dynarr_free (prop); /* #### More not quite right, but close enough. */ /* #### Ben sez: apparently window_end_pos[] is measured ＠＠ -4623,11 +4637,9 ＠＠ /* If the changes are below the visible area then if point hasn't moved return success otherwise fail in order to be safe. */ if (line > dla_end) - { - return regenerate_window_extents_only_changed (w, startp, pointm, - extent_beg_unchanged, - extent_end_unchanged); - } + return regenerate_window_extents_only_changed (w, startp, pointm, + extent_beg_unchanged, + extent_end_unchanged); else /* At this point we know what line the changes first affect. We now redraw that line. If the changes are contained within it ＠＠ -4751,12 +4763,9 ＠＠ && extent_end_unchanged != -1 && ((extent_beg_unchanged < ddl->bufpos) || (extent_end_unchanged > ddl->end_bufpos))) - { - return - regenerate_window_extents_only_changed (w, startp, pointm, - extent_beg_unchanged, - extent_end_unchanged); - } + return regenerate_window_extents_only_changed (w, startp, pointm, + extent_beg_unchanged, + extent_end_unchanged); else return 1; }