diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 107 | ||||
| -rw-r--r-- | src/alloc.c | 3 | ||||
| -rw-r--r-- | src/buffer.c | 12 | ||||
| -rw-r--r-- | src/buffer.h | 4 | ||||
| -rw-r--r-- | src/callint.c | 2 | ||||
| -rw-r--r-- | src/character.h | 39 | ||||
| -rw-r--r-- | src/chartab.c | 579 | ||||
| -rw-r--r-- | src/composite.c | 6 | ||||
| -rw-r--r-- | src/dispextern.h | 6 | ||||
| -rw-r--r-- | src/font.c | 5 | ||||
| -rw-r--r-- | src/keymap.c | 10 | ||||
| -rw-r--r-- | src/keymap.h | 4 | ||||
| -rw-r--r-- | src/m/iris4d.h | 26 | ||||
| -rw-r--r-- | src/nsfns.m | 9 | ||||
| -rw-r--r-- | src/nsgui.h | 5 | ||||
| -rw-r--r-- | src/nsmenu.m | 1 | ||||
| -rw-r--r-- | src/nsselect.m | 2 | ||||
| -rw-r--r-- | src/nsterm.h | 8 | ||||
| -rw-r--r-- | src/nsterm.m | 46 | ||||
| -rw-r--r-- | src/s/irix6-5.h | 7 | ||||
| -rw-r--r-- | src/term.c | 3 | ||||
| -rw-r--r-- | src/xdisp.c | 5 |
22 files changed, 756 insertions, 133 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 41dd4c0e9c..ccafc9c596 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,4 +1,4 @@ -2011-07-06 Paul Eggert <eggert@cs.ucla.edu> +2011-07-08 Paul Eggert <eggert@cs.ucla.edu> Use pthread_sigmask, not sigprocmask (Bug#9010). * callproc.c (Fcall_process): @@ -7,6 +7,111 @@ sigprocmask is portable only for single-threaded applications, and Emacs can be multi-threaded when it uses GTK. +2011-07-08 Jan Djärv <jan.h.d@swipnet.se> + + * nsgui.h: Fix compiler warning about gnulib redefining verify. + + * nsselect.m (ns_get_local_selection): Change to extern (Bug#8842). + + * nsmenu.m (ns_update_menubar): Remove useless setDelegate call + on svcsMenu (Bug#8842). + + * nsfns.m (Fx_open_connection): Remove NSStringPboardType from + ns_return_types. + (Fns_list_services): Just return Qnil on 10.6, code not working there. + + * nsterm.m (QUTF8_STRING): Declare. + (initFrameFromEmacs): Call registerServicesMenuSendTypes. + (validRequestorForSendType): Return type is (id). + Change indexOfObjectIdenticalTo to indexOfObject. + Check if we have local selection before returning self (Bug#8842). + (writeSelectionToPasteboard): Put local selection into paste board + if we have a local selection (Bug#8842). + (syms_of_nsterm): DEFSYM QUTF8_STRING. + + * nsterm.h (MAC_OS_X_VERSION_10_6): Define here instead of nsterm.m. + (ns_get_local_selection): Declare. + +2011-07-07 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * keymap.c (describe_map_tree): Don't insert a double newline at + the end of the buffer (bug#1169) and return whether we inserted + something. + + * callint.c (Fcall_interactively): Change "reading args" to + "providing args" to try to clarify what it does (bug#1010). + +2011-07-07 Kenichi Handa <handa@m17n.org> + + * composite.c (composition_compute_stop_pos): Ignore a static + composition starting before CHARPOS (Bug#8915). + + * xdisp.c (handle_composition_prop): Likewise. + +2011-07-07 Eli Zaretskii <eliz@gnu.org> + + * term.c (produce_glyphs) <xassert>: Allow IT_GLYPHLESS in it->what. + (Bug#9015) + +2011-07-07 Kenichi Handa <handa@m17n.org> + + * character.h (unicode_category_t): New enum type. + + * chartab.c (uniprop_decoder_t, uniprop_encoder_t): New types. + (Qchar_code_property_table): New variable. + (UNIPROP_TABLE_P, UNIPROP_GET_DECODER) + (UNIPROP_COMPRESSED_FORM_P): New macros. + (char_table_ascii): Uncompress the compressed values. + (sub_char_table_ref): New arg is_uniprop. Callers changed. + Uncompress the compressed values. + (sub_char_table_ref_and_range): Likewise. + (char_table_ref_and_range): Uncompress the compressed values. + (sub_char_table_set): New arg is_uniprop. Callers changed. + Uncompress the compressed values. + (sub_char_table_set_range): Args changed. Callers changed. + (char_table_set_range): Adjuted for the above change. + (map_sub_char_table): Delete args default_val and parent. Add arg + top. Give decoded values to a Lisp function. + (map_char_table): Adjusted for the above change. Give decoded + values to a Lisp function. Gcpro more variables. + (uniprop_table_uncompress) + (uniprop_decode_value_run_length): New functions. + (uniprop_decoder, uniprop_decoder_count): New variables. + (uniprop_get_decoder, uniprop_encode_value_character) + (uniprop_encode_value_run_length, uniprop_encode_value_numeric): + New functions. + (uniprop_encoder, uniprop_encoder_count): New variables. + (uniprop_get_encoder, uniprop_table) + (Funicode_property_table_internal, Fget_unicode_property_internal) + (Fput_unicode_property_internal): New functions. + (syms_of_chartab): DEFSYM Qchar_code_property_table, defsubr + Sunicode_property_table_internal, Sget_unicode_property_internal, + and Sput_unicode_property_internal. Defvar_lisp + char-code-property-alist. + + * composite.c (CHAR_COMPOSABLE_P): Adjusted for the change of + Vunicode_category_table. + + * font.c (font_range): Adjusted for the change of + Vunicode_category_table. + +2011-07-07 Dan Nicolaescu <dann@ics.uci.edu> + + * m/iris4d.h: Remove file, move contents ... + * s/irix6-5.h: ... here. + +2011-07-06 Paul Eggert <eggert@cs.ucla.edu> + + Remove unportable assumption about struct layout (Bug#8884). + * alloc.c (mark_buffer): + * buffer.c (reset_buffer_local_variables, Fbuffer_local_variables) + (clone_per_buffer_values): Don't assume that + sizeof (struct buffer) is a multiple of sizeof (Lisp_Object). + This isn't true in general, and it's particularly not true + if Emacs is configured with --with-wide-int. + * buffer.h (FIRST_FIELD_PER_BUFFER, LAST_FIELD_PER_BUFFER): + New macros, used in the buffer.c change. + 2011-07-05 Jan Djärv <jan.h.d@swipnet.se> * xsettings.c: Use both GConf and GSettings if both are available. diff --git a/src/alloc.c b/src/alloc.c index 43befd722b..f679787e95 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5619,7 +5619,8 @@ mark_buffer (Lisp_Object buf) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name); - (char *)ptr < (char *)buffer + sizeof (struct buffer); + ptr <= &PER_BUFFER_VALUE (buffer, + PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER)); ptr++) mark_object (*ptr); diff --git a/src/buffer.c b/src/buffer.c index 2339416eb3..e2f34d629e 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -471,8 +471,8 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof *to; + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); offset += sizeof (Lisp_Object)) { Lisp_Object obj; @@ -830,8 +830,8 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof *b; + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); offset += sizeof (Lisp_Object)) { int idx = PER_BUFFER_IDX (offset); @@ -1055,8 +1055,8 @@ No argument or nil as argument means use current buffer as BUFFER. */) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (offset = PER_BUFFER_VAR_OFFSET (undo_list); - offset < sizeof (struct buffer); + for (offset = PER_BUFFER_VAR_OFFSET (FIRST_FIELD_PER_BUFFER); + offset <= PER_BUFFER_VAR_OFFSET (LAST_FIELD_PER_BUFFER); /* sizeof EMACS_INT == sizeof Lisp_Object */ offset += (sizeof (EMACS_INT))) { diff --git a/src/buffer.h b/src/buffer.h index 4643e0d9d0..06864dd578 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -612,6 +612,7 @@ struct buffer /* Everything from here down must be a Lisp_Object. */ /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ + #define FIRST_FIELD_PER_BUFFER undo_list /* Changes in the buffer are recorded here for undo. t means don't record anything. @@ -846,6 +847,9 @@ struct buffer t means to use hollow box cursor. See `cursor-type' for other values. */ Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows); + + /* This must be the last field in the above list. */ + #define LAST_FIELD_PER_BUFFER cursor_in_non_selected_windows }; diff --git a/src/callint.c b/src/callint.c index 1371b403e4..26b161a25b 100644 --- a/src/callint.c +++ b/src/callint.c @@ -234,7 +234,7 @@ fix_command (Lisp_Object input, Lisp_Object values) } DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0, - doc: /* Call FUNCTION, reading args according to its interactive calling specs. + doc: /* Call FUNCTION, providing args according to its interactive calling specs. Return the value FUNCTION returns. The function contains a specification of how to do the argument reading. In the case of user-defined functions, this is specified by placing a call diff --git a/src/character.h b/src/character.h index 3bc21ac0f2..063b5147dc 100644 --- a/src/character.h +++ b/src/character.h @@ -597,6 +597,45 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ : (c) <= 0xDFFF ? 2 \ : 0) +/* Data type for Unicode general category. + + The order of members must be in sync with the 8th element of the + member of unidata-prop-alist (in admin/unidata/unidata-getn.el) for + Unicode character property `general-category'. */ + +typedef enum { + UNICODE_CATEGORY_UNKNOWN = 0, + UNICODE_CATEGORY_Lu, + UNICODE_CATEGORY_Ll, + UNICODE_CATEGORY_Lt, + UNICODE_CATEGORY_Lm, + UNICODE_CATEGORY_Lo, + UNICODE_CATEGORY_Mn, + UNICODE_CATEGORY_Mc, + UNICODE_CATEGORY_Me, + UNICODE_CATEGORY_Nd, + UNICODE_CATEGORY_Nl, + UNICODE_CATEGORY_No, + UNICODE_CATEGORY_Pc, + UNICODE_CATEGORY_Pd, + UNICODE_CATEGORY_Ps, + UNICODE_CATEGORY_Pe, + UNICODE_CATEGORY_Pi, + UNICODE_CATEGORY_Pf, + UNICODE_CATEGORY_Po, + UNICODE_CATEGORY_Sm, + UNICODE_CATEGORY_Sc, + UNICODE_CATEGORY_Sk, + UNICODE_CATEGORY_So, + UNICODE_CATEGORY_Zs, + UNICODE_CATEGORY_Zl, + UNICODE_CATEGORY_Zp, + UNICODE_CATEGORY_Cc, + UNICODE_CATEGORY_Cf, + UNICODE_CATEGORY_Cs, + UNICODE_CATEGORY_Co, + UNICODE_CATEGORY_Cn +} unicode_category_t; extern int char_resolve_modifier_mask (int); extern int char_string (unsigned, unsigned char *); diff --git a/src/chartab.c b/src/chartab.c index ed5b238646..e900a3ae71 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -53,7 +53,38 @@ static const int chartab_bits[4] = #define CHARTAB_IDX(c, depth, min_char) \ (((c) - (min_char)) >> chartab_bits[(depth)]) + +/* Preamble for uniprop (Unicode character property) tables. See the + comment of "Unicode character property tables". */ + +/* Purpose of uniprop tables. */ +static Lisp_Object Qchar_code_property_table; + +/* Types of decoder and encoder functions for uniprop values. */ +typedef Lisp_Object (*uniprop_decoder_t) (Lisp_Object, Lisp_Object); +typedef Lisp_Object (*uniprop_encoder_t) (Lisp_Object, Lisp_Object); + +static Lisp_Object uniprop_table_uncompress (Lisp_Object, int); +static uniprop_decoder_t uniprop_get_decoder (Lisp_Object); + +/* 1 iff TABLE is a uniprop table. */ +#define UNIPROP_TABLE_P(TABLE) \ + (EQ (XCHAR_TABLE (TABLE)->purpose, Qchar_code_property_table) \ + && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (TABLE)) == 5) + +/* Return a decoder for values in the uniprop table TABLE. */ +#define UNIPROP_GET_DECODER(TABLE) \ + (UNIPROP_TABLE_P (TABLE) ? uniprop_get_decoder (TABLE) : NULL) +/* Nonzero iff OBJ is a string representing uniprop values of 128 + succeeding characters (the bottom level of a char-table) by a + compressed format. We are sure that no property value has a string + starting with '\001' nor '\002'. */ +#define UNIPROP_COMPRESSED_FORM_P(OBJ) \ + (STRINGP (OBJ) && SCHARS (OBJ) > 0 \ + && ((SREF (OBJ, 0) == 1 || (SREF (OBJ, 0) == 2)))) + + DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, doc: /* Return a newly created char-table, with purpose PURPOSE. Each element is initialized to INIT, which defaults to nil. @@ -107,7 +138,7 @@ make_sub_char_table (int depth, int min_char, Lisp_Object defalt) static Lisp_Object char_table_ascii (Lisp_Object table) { - Lisp_Object sub; + Lisp_Object sub, val; sub = XCHAR_TABLE (table)->contents[0]; if (! SUB_CHAR_TABLE_P (sub)) @@ -115,7 +146,10 @@ char_table_ascii (Lisp_Object table) sub = XSUB_CHAR_TABLE (sub)->contents[0]; if (! SUB_CHAR_TABLE_P (sub)) return sub; - return XSUB_CHAR_TABLE (sub)->contents[0]; + val = XSUB_CHAR_TABLE (sub)->contents[0]; + if (UNIPROP_TABLE_P (table) && UNIPROP_COMPRESSED_FORM_P (val)) + val = uniprop_table_uncompress (sub, 0); + return val; } static Lisp_Object @@ -169,16 +203,19 @@ copy_char_table (Lisp_Object table) } static Lisp_Object -sub_char_table_ref (Lisp_Object table, int c) +sub_char_table_ref (Lisp_Object table, int c, int is_uniprop) { struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); int depth = XINT (tbl->depth); int min_char = XINT (tbl->min_char); Lisp_Object val; + int idx = CHARTAB_IDX (c, depth, min_char); - val = tbl->contents[CHARTAB_IDX (c, depth, min_char)]; + val = tbl->contents[idx]; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val)) + val = uniprop_table_uncompress (table, idx); if (SUB_CHAR_TABLE_P (val)) - val = sub_char_table_ref (val, c); + val = sub_char_table_ref (val, c, is_uniprop); return val; } @@ -198,7 +235,7 @@ char_table_ref (Lisp_Object table, int c) { val = tbl->contents[CHARTAB_IDX (c, 0, 0)]; if (SUB_CHAR_TABLE_P (val)) - val = sub_char_table_ref (val, c); + val = sub_char_table_ref (val, c, UNIPROP_TABLE_P (table)); } if (NILP (val)) { @@ -210,7 +247,8 @@ char_table_ref (Lisp_Object table, int c) } static Lisp_Object -sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp_Object defalt) +sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, + Lisp_Object defalt, int is_uniprop) { struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); int depth = XINT (tbl->depth); @@ -219,8 +257,10 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp Lisp_Object val; val = tbl->contents[chartab_idx]; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val)) + val = uniprop_table_uncompress (table, chartab_idx); if (SUB_CHAR_TABLE_P (val)) - val = sub_char_table_ref_and_range (val, c, from, to, defalt); + val = sub_char_table_ref_and_range (val, c, from, to, defalt, is_uniprop); else if (NILP (val)) val = defalt; @@ -232,8 +272,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp c = min_char + idx * chartab_chars[depth] - 1; idx--; this_val = tbl->contents[idx]; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val)) + this_val = uniprop_table_uncompress (table, idx); if (SUB_CHAR_TABLE_P (this_val)) - this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt); + this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt, + is_uniprop); else if (NILP (this_val)) this_val = defalt; @@ -251,8 +294,11 @@ sub_char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to, Lisp chartab_idx++; this_val = tbl->contents[chartab_idx]; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val)) + this_val = uniprop_table_uncompress (table, chartab_idx); if (SUB_CHAR_TABLE_P (this_val)) - this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt); + this_val = sub_char_table_ref_and_range (this_val, c, from, to, defalt, + is_uniprop); else if (NILP (this_val)) this_val = defalt; if (! EQ (this_val, val)) @@ -277,17 +323,20 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to) struct Lisp_Char_Table *tbl = XCHAR_TABLE (table); int chartab_idx = CHARTAB_IDX (c, 0, 0), idx; Lisp_Object val; + int is_uniprop = UNIPROP_TABLE_P (table); val = tbl->contents[chartab_idx]; if (*from < 0) *from = 0; if (*to < 0) *to = MAX_CHAR; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (val)) + val = uniprop_table_uncompress (table, chartab_idx); if (SUB_CHAR_TABLE_P (val)) - val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt); + val = sub_char_table_ref_and_range (val, c, from, to, tbl->defalt, + is_uniprop); else if (NILP (val)) val = tbl->defalt; - idx = chartab_idx; while (*from < idx * chartab_chars[0]) { @@ -296,9 +345,11 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to) c = idx * chartab_chars[0] - 1; idx--; this_val = tbl->contents[idx]; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val)) + this_val = uniprop_table_uncompress (table, idx); if (SUB_CHAR_TABLE_P (this_val)) this_val = sub_char_table_ref_and_range (this_val, c, from, to, - tbl->defalt); + tbl->defalt, is_uniprop); else if (NILP (this_val)) this_val = tbl->defalt; @@ -315,9 +366,11 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to) chartab_idx++; c = chartab_idx * chartab_chars[0]; this_val = tbl->contents[chartab_idx]; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this_val)) + this_val = uniprop_table_uncompress (table, chartab_idx); if (SUB_CHAR_TABLE_P (this_val)) this_val = sub_char_table_ref_and_range (this_val, c, from, to, - tbl->defalt); + tbl->defalt, is_uniprop); else if (NILP (this_val)) this_val = tbl->defalt; if (! EQ (this_val, val)) @@ -332,7 +385,7 @@ char_table_ref_and_range (Lisp_Object table, int c, int *from, int *to) static void -sub_char_table_set (Lisp_Object table, int c, Lisp_Object val) +sub_char_table_set (Lisp_Object table, int c, Lisp_Object val, int is_uniprop) { struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); int depth = XINT ((tbl)->depth); @@ -347,11 +400,17 @@ sub_char_table_set (Lisp_Object table, int c, Lisp_Object val) sub = tbl->contents[i]; if (! SUB_CHAR_TABLE_P (sub)) { - sub = make_sub_char_table (depth + 1, - min_char + i * chartab_chars[depth], sub); - tbl->contents[i] = sub; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (sub)) + sub = uniprop_table_uncompress (table, i); + else + { + sub = make_sub_char_table (depth + 1, + min_char + i * chartab_chars[depth], + sub); + tbl->contents[i] = sub; + } } - sub_char_table_set (sub, c, val); + sub_char_table_set (sub, c, val, is_uniprop); } } @@ -376,7 +435,7 @@ char_table_set (Lisp_Object table, int c, Lisp_Object val) sub = make_sub_char_table (1, i * chartab_chars[0], sub); tbl->contents[i] = sub; } - sub_char_table_set (sub, c, val); + sub_char_table_set (sub, c, val, UNIPROP_TABLE_P (table)); if (ASCII_CHAR_P (c)) tbl->ascii = char_table_ascii (table); } @@ -384,30 +443,40 @@ char_table_set (Lisp_Object table, int c, Lisp_Object val) } static void -sub_char_table_set_range (Lisp_Object *table, int depth, int min_char, int from, int to, Lisp_Object val) +sub_char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val, + int is_uniprop) { - int max_char = min_char + chartab_chars[depth] - 1; - - if (depth == 3 || (from <= min_char && to >= max_char)) - *table = val; - else + struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table); + int depth = XINT ((tbl)->depth); + int min_char = XINT ((tbl)->min_char); + int chars_in_block = chartab_chars[depth]; + int i, c, lim = chartab_size[depth]; + + if (from < min_char) + from = min_char; + i = CHARTAB_IDX (from, depth, min_char); + c = min_char + chars_in_block * i; + for (; i < lim; i++, c += chars_in_block) { - int i; - unsigned j; - - depth++; - if (! SUB_CHAR_TABLE_P (*table)) - *table = make_sub_char_table (depth, min_char, *table); - if (from < min_char) - from = min_char; - if (to > max_char) - to = max_char; - i = CHARTAB_IDX (from, depth, min_char); - j = CHARTAB_IDX (to, depth, min_char); - min_char += chartab_chars[depth] * i; - for (j++; i < j; i++, min_char += chartab_chars[depth]) - sub_char_table_set_range (XSUB_CHAR_TABLE (*table)->contents + i, - depth, min_char, from, to, val); + if (c > to) + break; + if (from <= c && c + chars_in_block - 1 <= to) + tbl->contents[i] = val; + else + { + Lisp_Object sub = tbl->contents[i]; + if (! SUB_CHAR_TABLE_P (sub)) + { + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (sub)) + sub = uniprop_table_uncompress (table, i); + else + { + sub = make_sub_char_table (depth + 1, c, sub); + tbl->contents[i] = sub; + } + } + sub_char_table_set_range (sub, from, to, val, is_uniprop); + } } } @@ -417,16 +486,33 @@ char_table_set_range (Lisp_Object table, int from, int to, Lisp_Object val) { struct Lisp_Char_Table *tbl = XCHAR_TABLE (table); Lisp_Object *contents = tbl->contents; - int i; if (from == to) char_table_set (table, from, val); else { - unsigned lim = to / chartab_chars[0] + 1; - for (i = CHARTAB_IDX (from, 0, 0); i < lim; i++) - sub_char_table_set_range (contents + i, 0, i * chartab_chars[0], - from, to, val); + int is_uniprop = UNIPROP_TABLE_P (table); + int lim = CHARTAB_IDX (to, 0, 0); + int i, c; + + for (i = CHARTAB_IDX (from, 0, 0), c = 0; i <= lim; + i++, c += chartab_chars[0]) + { + if (c > to) + break; + if (from <= c && c + chartab_chars[0] - 1 <= to) + tbl->contents[i] = val; + else + { + Lisp_Object sub = tbl->contents[i]; + if (! SUB_CHAR_TABLE_P (sub)) + { + sub = make_sub_char_table (1, i * chartab_chars[0], sub); + tbl->contents[i] = sub; + } + sub_char_table_set_range (sub, from, to, val, is_uniprop); + } + } if (ASCII_CHAR_P (from)) tbl->ascii = char_table_ascii (table); } @@ -504,6 +590,8 @@ DEFUN ("set-char-table-extra-slot", Fset_char_table_extra_slot, (Lisp_Object char_table, Lisp_Object n, Lisp_Object value) { CHECK_CHAR_TABLE (char_table); + if (EQ (XCHAR_TABLE (char_table)->purpose, Qchar_code_property_table)) + error ("Can't change extra-slot of char-code-property-table"); CHECK_NUMBER (n); if (XINT (n) < 0 || XINT (n) >= CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (char_table))) @@ -532,8 +620,9 @@ a cons of character codes (for characters in the range), or a character code. * CHECK_CHARACTER_CAR (range); CHECK_CHARACTER_CDR (range); - val = char_table_ref_and_range (char_table, XFASTINT (XCAR (range)), - &from, &to); + from = XFASTINT (XCAR (range)); + to = XFASTINT (XCDR (range)); + val = char_table_ref_and_range (char_table, from, &from, &to); /* Not yet implemented. */ } else @@ -655,8 +744,7 @@ equivalent and can be merged. It defaults to `equal'. */) /* Map C_FUNCTION or FUNCTION over TABLE (top or sub char-table), calling it for each character or group of characters that share a value. RANGE is a cons (FROM . TO) specifying the range of target - characters, VAL is a value of FROM in TABLE, DEFAULT_VAL is the - default value of the char-table, PARENT is the parent of the + characters, VAL is a value of FROM in TABLE, TOP is the top char-table. ARG is passed to C_FUNCTION when that is called. @@ -669,7 +757,7 @@ equivalent and can be merged. It defaults to `equal'. */) static Lisp_Object map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object function, Lisp_Object table, Lisp_Object arg, Lisp_Object val, - Lisp_Object range, Lisp_Object default_val, Lisp_Object parent) + Lisp_Object range, Lisp_Object top) { /* Pointer to the elements of TABLE. */ Lisp_Object *contents; @@ -681,6 +769,8 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), int chars_in_block; int from = XINT (XCAR (range)), to = XINT (XCDR (range)); int i, c; + int is_uniprop = UNIPROP_TABLE_P (top); + uniprop_decoder_t decoder = UNIPROP_GET_DECODER (top); if (SUB_CHAR_TABLE_P (table)) { @@ -710,28 +800,33 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), for (c = min_char + chars_in_block * i; c <= max_char; i++, c += chars_in_block) { - Lisp_Object this = contents[i]; + Lisp_Object this = (SUB_CHAR_TABLE_P (table) + ? XSUB_CHAR_TABLE (table)->contents[i] + : XCHAR_TABLE (table)->contents[i]); int nextc = c + chars_in_block; + if (is_uniprop && UNIPROP_COMPRESSED_FORM_P (this)) + this = uniprop_table_uncompress (table, i); if (SUB_CHAR_TABLE_P (this)) { if (to >= nextc) XSETCDR (range, make_number (nextc - 1)); val = map_sub_char_table (c_function, function, this, arg, - val, range, default_val, parent); + val, range, top); } else { if (NILP (this)) - this = default_val; + this = XCHAR_TABLE (top)->defalt; if (!EQ (val, this)) { int different_value = 1; if (NILP (val)) { - if (! NILP (parent)) + if (! NILP (XCHAR_TABLE (top)->parent)) { + Lisp_Object parent = XCHAR_TABLE (top)->parent; Lisp_Object temp = XCHAR_TABLE (parent)->parent; /* This is to get a value of FROM in PARENT @@ -742,8 +837,7 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), XSETCDR (range, make_number (c - 1)); val = map_sub_char_table (c_function, function, parent, arg, val, range, - XCHAR_TABLE (parent)->defalt, - XCHAR_TABLE (parent)->parent); + parent); if (EQ (val, this)) different_value = 0; } @@ -756,14 +850,22 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), if (c_function) (*c_function) (arg, XCAR (range), val); else - call2 (function, XCAR (range), val); + { + if (decoder) + val = decoder (top, val); + call2 (function, XCAR (range), val); + } } else { if (c_function) (*c_function) (arg, range, val); else - call2 (function, range, val); + { + if (decoder) + val = decoder (top, val); + call2 (function, range, val); + } } } val = this; @@ -783,35 +885,39 @@ map_sub_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), ARG is passed to C_FUNCTION when that is called. */ void -map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp_Object function, Lisp_Object table, Lisp_Object arg) +map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), + Lisp_Object function, Lisp_Object table, Lisp_Object arg) { - Lisp_Object range, val; - struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object range, val, parent; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + uniprop_decoder_t decoder = UNIPROP_GET_DECODER (table); range = Fcons (make_number (0), make_number (MAX_CHAR)); - GCPRO3 (table, arg, range); + parent = XCHAR_TABLE (table)->parent; + + GCPRO4 (table, arg, range, parent); val = XCHAR_TABLE (table)->ascii; if (SUB_CHAR_TABLE_P (val)) val = XSUB_CHAR_TABLE (val)->contents[0]; val = map_sub_char_table (c_function, function, table, arg, val, range, - XCHAR_TABLE (table)->defalt, - XCHAR_TABLE (table)->parent); + table); + /* If VAL is nil and TABLE has a parent, we must consult the parent recursively. */ while (NILP (val) && ! NILP (XCHAR_TABLE (table)->parent)) { - Lisp_Object parent = XCHAR_TABLE (table)->parent; - Lisp_Object temp = XCHAR_TABLE (parent)->parent; + Lisp_Object temp; int from = XINT (XCAR (range)); + parent = XCHAR_TABLE (table)->parent; + temp = XCHAR_TABLE (parent)->parent; /* This is to get a value of FROM in PARENT without checking the parent of PARENT. */ XCHAR_TABLE (parent)->parent = Qnil; val = CHAR_TABLE_REF (parent, from); XCHAR_TABLE (parent)->parent = temp; val = map_sub_char_table (c_function, function, parent, arg, val, range, - XCHAR_TABLE (parent)->defalt, - XCHAR_TABLE (parent)->parent); + parent); table = parent; } @@ -822,14 +928,22 @@ map_char_table (void (*c_function) (Lisp_Object, Lisp_Object, Lisp_Object), Lisp if (c_function) (*c_function) (arg, XCAR (range), val); else - call2 (function, XCAR (range), val); + { + if (decoder) + val = decoder (table, val); + call2 (function, XCAR (range), val); + } } else { if (c_function) (*c_function) (arg, range, val); else - call2 (function, range, val); + { + if (decoder) + val = decoder (table, val); + call2 (function, range, val); + } } } @@ -984,9 +1098,315 @@ map_char_table_for_charset (void (*c_function) (Lisp_Object, Lisp_Object), } +/* Unicode character property tables. + + This section provides a convenient and efficient way to get a + Unicode character property from C code (from Lisp, you must use + get-char-code-property). + + The typical usage is to get a char-table for a specific property at + a proper initialization time as this: + + Lisp_Object bidi_class_table = uniprop_table (intern ("bidi-class")); + + and get a property value for character CH as this: + + Lisp_Object bidi_class = CHAR_TABLE_REF (CH, bidi_class_table); + + In this case, what you actually get is an index number to the + vector of property values (symbols nil, L, R, etc). + + A table for Unicode character property has these characteristics: + + o The purpose is `char-code-property-table', which implies that the + table has 5 extra slots. + + o The second extra slot is a Lisp function, an index (integer) to + the array uniprop_decoder[], or nil. If it is a Lisp function, we + can't use such a table from C (at the moment). If it is nil, it + means that we don't have to decode values. + + o The third extra slot is a Lisp function, an index (integer) to + the array uniprop_enncoder[], or nil. If it is a Lisp function, we + can't use such a table from C (at the moment). If it is nil, it + means that we don't have to encode values. */ + + +/* Uncompress the IDXth element of sub-char-table TABLE. */ + +static Lisp_Object +uniprop_table_uncompress (Lisp_Object table, int idx) +{ + Lisp_Object val = XSUB_CHAR_TABLE (table)->contents[idx]; + int min_char = (XINT (XSUB_CHAR_TABLE (table)->min_char) + + chartab_chars[2] * idx); + Lisp_Object sub = make_sub_char_table (3, min_char, Qnil); + struct Lisp_Sub_Char_Table *subtbl = XSUB_CHAR_TABLE (sub); + const unsigned char *p, *pend; + int i; + + XSUB_CHAR_TABLE (table)->contents[idx] = sub; + p = SDATA (val), pend = p + SBYTES (val); + if (*p == 1) + { + /* SIMPLE TABLE */ + p++; + idx = STRING_CHAR_ADVANCE (p); + while (p < pend && idx < chartab_chars[2]) + { + int v = STRING_CHAR_ADVANCE (p); + subtbl->contents[idx++] = v > 0 ? make_number (v) : Qnil; + } + } + else if (*p == 2) + { + /* RUN-LENGTH TABLE */ + p++; + for (idx = 0; p < pend; ) + { + int v = STRING_CHAR_ADVANCE (p); + int count = 1; + int len; + + if (p < pend) + { + count = STRING_CHAR_AND_LENGTH (p, len); + if (count < 128) + count = 1; + else + { + count -= 128; + p += len; + } + } + while (count-- > 0) + subtbl->contents[idx++] = make_number (v); + } + } +/* It seems that we don't need this function because C code won't need + to get a property that is compressed in this form. */ +#if 0 + else if (*p == 0) + { + /* WORD-LIST TABLE */ + } +#endif + return sub; +} + + +/* Decode VALUE as an elemnet of char-table TABLE. */ + +static Lisp_Object +uniprop_decode_value_run_length (Lisp_Object table, Lisp_Object value) +{ + if (VECTORP (XCHAR_TABLE (table)->extras[4])) + { + Lisp_Object valvec = XCHAR_TABLE (table)->extras[4]; + + if (XINT (value) >= 0 && XINT (value) < ASIZE (valvec)) + value = AREF (valvec, XINT (value)); + } + return value; +} + +static uniprop_decoder_t uniprop_decoder [] = + { uniprop_decode_value_run_length }; + +static int uniprop_decoder_count + = (sizeof uniprop_decoder) / sizeof (uniprop_decoder[0]); + + +/* Return the decoder of char-table TABLE or nil if none. */ + +static uniprop_decoder_t +uniprop_get_decoder (Lisp_Object table) +{ + int i; + + if (! INTEGERP (XCHAR_TABLE (table)->extras[1])) + return NULL; + i = XINT (XCHAR_TABLE (table)->extras[1]); + if (i < 0 || i >= uniprop_decoder_count) + return NULL; + return uniprop_decoder[i]; +} + + +/* Encode VALUE as an element of char-table TABLE which contains + characters as elements. */ + +static Lisp_Object +uniprop_encode_value_character (Lisp_Object table, Lisp_Object value) +{ + if (! NILP (value) && ! CHARACTERP (value)) + wrong_type_argument (Qintegerp, value); + return value; +} + + +/* Encode VALUE as an element of char-table TABLE which adopts RUN-LENGTH + compression. */ + +static Lisp_Object +uniprop_encode_value_run_length (Lisp_Object table, Lisp_Object value) +{ + Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents; + int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]); + + for (i = 0; i < size; i++) + if (EQ (value, value_table[i])) + break; + if (i == size) + wrong_type_argument (build_string ("Unicode property value"), value); + return make_number (i); +} + + +/* Encode VALUE as an element of char-table TABLE which adopts RUN-LENGTH + compression and contains numbers as elements . */ + +static Lisp_Object +uniprop_encode_value_numeric (Lisp_Object table, Lisp_Object value) +{ + Lisp_Object *value_table = XVECTOR (XCHAR_TABLE (table)->extras[4])->contents; + int i, size = ASIZE (XCHAR_TABLE (table)->extras[4]); + + CHECK_NUMBER (value); + for (i = 0; i < size; i++) + if (EQ (value, value_table[i])) + break; + value = make_number (i); + if (i == size) + { + Lisp_Object args[2]; + + args[0] = XCHAR_TABLE (table)->extras[4]; + args[1] = Fmake_vector (make_number (1), value); + XCHAR_TABLE (table)->extras[4] = Fvconcat (2, args); + } + return make_number (i); +} + +static uniprop_encoder_t uniprop_encoder[] = + { uniprop_encode_value_character, + uniprop_encode_value_run_length, + uniprop_encode_value_numeric }; + +static int uniprop_encoder_count + = (sizeof uniprop_encoder) / sizeof (uniprop_encoder[0]); + + +/* Return the encoder of char-table TABLE or nil if none. */ + +static uniprop_decoder_t +uniprop_get_encoder (Lisp_Object table) +{ + int i; + + if (! INTEGERP (XCHAR_TABLE (table)->extras[2])) + return NULL; + i = XINT (XCHAR_TABLE (table)->extras[2]); + if (i < 0 || i >= uniprop_encoder_count) + return NULL; + return uniprop_encoder[i]; +} + +/* Return a char-table for Unicode character property PROP. This + function may load a Lisp file and thus may cause + garbage-collection. */ + +Lisp_Object +uniprop_table (Lisp_Object prop) +{ + Lisp_Object val, table, result; + + val = Fassq (prop, Vchar_code_property_alist); + if (! CONSP (val)) + return Qnil; + table = XCDR (val); + if (STRINGP (table)) + { + struct gcpro gcpro1; + GCPRO1 (val); + result = Fload (concat2 (build_string ("international/"), table), + Qt, Qt, Qt, Qt); + UNGCPRO; + if (NILP (result)) + return Qnil; + table = XCDR (val); + } + if (! CHAR_TABLE_P (table) + || ! UNIPROP_TABLE_P (table)) + return Qnil; + val = XCHAR_TABLE (table)->extras[1]; + if (INTEGERP (val) + ? (XINT (val) < 0 || XINT (val) >= uniprop_decoder_count) + : ! NILP (val)) + return Qnil; + /* Prepare ASCII values in advance for CHAR_TABLE_REF. */ + XCHAR_TABLE (table)->ascii = char_table_ascii (table); + return table; +} + +DEFUN ("unicode-property-table-internal", Funicode_property_table_internal, + Sunicode_property_table_internal, 1, 1, 0, + doc: /* Return a char-table for Unicode character property PROP. +Use `get-unicode-property-internal' and +`put-unicode-property-internal' instead of `aref' and `aset' to get +and put an element value. */) + (Lisp_Object prop) +{ + Lisp_Object table = uniprop_table (prop); + + if (CHAR_TABLE_P (table)) + return table; + return Fcdr (Fassq (prop, Vchar_code_property_alist)); +} + +DEFUN ("get-unicode-property-internal", Fget_unicode_property_internal, + Sget_unicode_property_internal, 2, 2, 0, + doc: /* Return an element of CHAR-TABLE for character CH. +CHAR-TABLE must be what returned by `unicode-property-table-internal'. */) + (Lisp_Object char_table, Lisp_Object ch) +{ + Lisp_Object val; + uniprop_decoder_t decoder; + + CHECK_CHAR_TABLE (char_table); + CHECK_CHARACTER (ch); + if (! UNIPROP_TABLE_P (char_table)) + error ("Invalid Unicode property table"); + val = CHAR_TABLE_REF (char_table, XINT (ch)); + decoder = uniprop_get_decoder (char_table); + return (decoder ? decoder (char_table, val) : val); +} + +DEFUN ("put-unicode-property-internal", Fput_unicode_property_internal, + Sput_unicode_property_internal, 3, 3, 0, + doc: /* Set an element of CHAR-TABLE for character CH to VALUE. +CHAR-TABLE must be what returned by `unicode-property-table-internal'. */) + (Lisp_Object char_table, Lisp_Object ch, Lisp_Object value) +{ + uniprop_encoder_t encoder; + + CHECK_CHAR_TABLE (char_table); + CHECK_CHARACTER (ch); + if (! UNIPROP_TABLE_P (char_table)) + error ("Invalid Unicode property table"); + encoder = uniprop_get_encoder (char_table); + if (encoder) + value = encoder (char_table, value); + CHAR_TABLE_SET (char_table, XINT (ch), value); + return Qnil; +} + + void syms_of_chartab (void) { + DEFSYM (Qchar_code_property_table, "char-code-property-table"); + defsubr (&Smake_char_table); defsubr (&Schar_table_parent); defsubr (&Schar_table_subtype); @@ -998,4 +1418,19 @@ syms_of_chartab (void) defsubr (&Sset_char_table_default); defsubr (&Soptimize_char_table); defsubr (&Smap_char_table); + defsubr (&Sunicode_property_table_internal); + defsubr (&Sget_unicode_property_internal); + defsubr (&Sput_unicode_property_internal); + + /* Each element has the form (PROP . TABLE). + PROP is a symbol representing a character property. + TABLE is a char-table containing the property value for each character. + TABLE may be a name of file to load to build a char-table. + This variable should be modified only through + `define-char-code-property'. */ + + DEFVAR_LISP ("char-code-property-alist", Vchar_code_property_alist, + doc: /* Alist of character property name vs char-table containing property values. +Internal use only. */); + Vchar_code_property_alist = Qnil; } diff --git a/src/composite.c b/src/composite.c index de9775d18f..cf1e053f02 100644 --- a/src/composite.c +++ b/src/composite.c @@ -976,9 +976,8 @@ static int _work_char; ((C) > ' ' \ && ((C) == 0x200C || (C) == 0x200D \ || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \ - (SYMBOLP (_work_val) \ - && (_work_char = SDATA (SYMBOL_NAME (_work_val))[0]) != 'C' \ - && _work_char != 'Z')))) + (INTEGERP (_work_val) \ + && (XINT (_work_val) <= UNICODE_CATEGORY_So))))) /* Update cmp_it->stop_pos to the next position after CHARPOS (and BYTEPOS) where character composition may happen. If BYTEPOS is @@ -1027,6 +1026,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, /* FIXME: Bidi is not yet handled well in static composition. */ if (charpos < endpos && find_composition (charpos, endpos, &start, &end, &prop, string) + && start >= charpos && COMPOSITION_VALID_P (start, end, prop)) { cmp_it->stop_pos = endpos = start; diff --git a/src/dispextern.h b/src/dispextern.h index 57fa09d3bf..c0a67690a5 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1773,7 +1773,11 @@ extern int face_change_count; /* Data type for describing the bidirectional character types. The first 7 must be at the beginning, because they are the only values valid in the `bidi_type' member of `struct glyph'; we only reserve - 3 bits for it, so we cannot use there values larger than 7. */ + 3 bits for it, so we cannot use there values larger than 7. + + The order of members must be in sync with the 8th element of the + member of unidata-prop-alist (in admin/unidata/unidata-getn.el) for + Unicode character property `bidi-class'. */ typedef enum { UNKNOWN_BT = 0, STRONG_L, /* strong left-to-right */ diff --git a/src/font.c b/src/font.c index 14390335f3..5aff20b134 100644 --- a/src/font.c +++ b/src/font.c @@ -3739,8 +3739,9 @@ font_range (EMACS_INT pos, EMACS_INT *limit, struct window *w, struct face *face else FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, string, pos, pos_byte); category = CHAR_TABLE_REF (Vunicode_category_table, c); - if (EQ (category, QCf) - || CHAR_VARIATION_SELECTOR_P (c)) + if (INTEGERP (category) + && (XINT (category) == UNICODE_CATEGORY_Cf + || CHAR_VARIATION_SELECTOR_P (c))) continue; if (NILP (font_object)) { diff --git a/src/keymap.c b/src/keymap.c index be31f72eec..d33af68be4 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2951,9 +2951,11 @@ You type Translation\n\ to look through. If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW, - don't omit it; instead, mention it but say it is shadowed. */ + don't omit it; instead, mention it but say it is shadowed. -void + Return whether something was inserted or not. */ + +int describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow, Lisp_Object prefix, const char *title, int nomenu, int transl, int always_title, int mention_shadow) @@ -3063,10 +3065,8 @@ key binding\n\ skip: ; } - if (something) - insert_string ("\n"); - UNGCPRO; + return something; } static int previous_description_column; diff --git a/src/keymap.h b/src/keymap.h index 2b9d58b39d..2c826b64e1 100644 --- a/src/keymap.h +++ b/src/keymap.h @@ -36,8 +36,8 @@ EXFUN (Fcurrent_active_maps, 2); extern Lisp_Object access_keymap (Lisp_Object, Lisp_Object, int, int, int); extern Lisp_Object get_keymap (Lisp_Object, int, int); EXFUN (Fset_keymap_parent, 2); -extern void describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object, - const char *, int, int, int, int); +extern int describe_map_tree (Lisp_Object, int, Lisp_Object, Lisp_Object, + const char *, int, int, int, int); extern int current_minor_maps (Lisp_Object **, Lisp_Object **); extern void initial_define_key (Lisp_Object, int, const char *); extern void initial_define_lispy_key (Lisp_Object, const char *, const char *); diff --git a/src/m/iris4d.h b/src/m/iris4d.h deleted file mode 100644 index 881f71f846..0000000000 --- a/src/m/iris4d.h +++ /dev/null @@ -1,26 +0,0 @@ -/* machine description file for Iris-4D machines. Use with s/irix*.h. - -Copyright (C) 1987, 2001-2011 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ - - -/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which - were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for - the value field of a LISP_OBJECT). */ -#define DATA_START 0x10000000 -#define DATA_SEG_BITS 0x10000000 - diff --git a/src/nsfns.m b/src/nsfns.m index cdf350066b..d124f61a4f 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1728,8 +1728,8 @@ terminate Emacs if we can't open the connection. /* Register our external input/output types, used for determining applicable services and also drag/drop eligibility. */ - ns_send_types = [[NSArray arrayWithObject: NSStringPboardType] retain]; - ns_return_types = [[NSArray arrayWithObject: NSStringPboardType] retain]; + ns_send_types = [[NSArray arrayWithObjects: NSStringPboardType, nil] retain]; + ns_return_types = [[NSArray arrayWithObjects: nil] retain]; ns_drag_types = [[NSArray arrayWithObjects: NSStringPboardType, NSTabularTextPboardType, @@ -1876,6 +1876,10 @@ DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0, doc: /* List available Nextstep services by querying NSApp. */) (void) { +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_6 + /* You can't get services like this in 10.6+. */ + return Qnil; +#else Lisp_Object ret = Qnil; NSMenu *svcs; id delegate; @@ -1919,6 +1923,7 @@ DEFUN ("ns-list-services", Fns_list_services, Sns_list_services, 0, 0, 0, ret = interpret_services_menu (svcs, Qnil, ret); return ret; +#endif } diff --git a/src/nsgui.h b/src/nsgui.h index a695563094..999dc27e31 100644 --- a/src/nsgui.h +++ b/src/nsgui.h @@ -30,6 +30,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #undef init_process #endif /* NS_IMPL_COCOA */ +#undef verify + #import <AppKit/AppKit.h> #ifdef NS_IMPL_COCOA @@ -44,6 +46,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif /* __OBJC__ */ +#undef verify +#undef _GL_VERIFY_H +#include <verify.h> /* menu-related */ #define free_widget_value(wv) xfree (wv) diff --git a/src/nsmenu.m b/src/nsmenu.m index 2a2f952e75..0d25b82d5b 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -457,7 +457,6 @@ ns_update_menubar (struct frame *f, int deep_p, EmacsMenu *submenu) { /* but we need to make sure it will update on demand */ [svcsMenu setFrame: f]; - [svcsMenu setDelegate: svcsMenu]; } else #endif diff --git a/src/nsselect.m b/src/nsselect.m index 950fb1f1f1..aeb2a3e3a9 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -175,7 +175,7 @@ ns_string_to_pasteboard_internal (id pb, Lisp_Object str, NSString *gtype) } -static Lisp_Object +Lisp_Object ns_get_local_selection (Lisp_Object selection_name, Lisp_Object target_type) { diff --git a/src/nsterm.h b/src/nsterm.h index 7459087c98..b442973f0d 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -25,6 +25,12 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifdef HAVE_NS +#ifdef NS_IMPL_COCOA +#ifndef MAC_OS_X_VERSION_10_6 +#define MAC_OS_X_VERSION_10_6 1060 +#endif +#endif + #ifdef __OBJC__ /* ========================================================================== @@ -700,6 +706,8 @@ extern void check_ns (void); extern Lisp_Object ns_map_event_to_object (); extern Lisp_Object ns_string_from_pasteboard (); extern void ns_string_to_pasteboard (); +extern Lisp_Object ns_get_local_selection (Lisp_Object selection_name, + Lisp_Object target_type); extern void nxatoms_of_nsselect (); extern int ns_lisp_to_cursor_type (); extern Lisp_Object ns_cursor_type_to_lisp (int arg); diff --git a/src/nsterm.m b/src/nsterm.m index 52e0dc6c2a..ac95409ee7 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -134,11 +134,12 @@ static unsigned convert_ns_to_X_keysym[] = 0x1B, 0x1B /* escape */ }; - static Lisp_Object Qmodifier_value; Lisp_Object Qalt, Qcontrol, Qhyper, Qmeta, Qsuper, Qnone; extern Lisp_Object Qcursor_color, Qcursor_type, Qns, Qleft; +static Lisp_Object QUTF8_STRING; + /* On OS X picks up the default NSGlobalDomain AppleAntiAliasingThreshold, the maximum font size to NOT antialias. On GNUstep there is currently no way to control this behavior. */ @@ -5364,6 +5365,9 @@ ns_term_shutdown (int sig) [self allocateGState]; + [NSApp registerServicesMenuSendTypes: ns_send_types + returnTypes: ns_return_types]; + ns_window_num++; return self; } @@ -5735,13 +5739,17 @@ ns_term_shutdown (int sig) } -- validRequestorForSendType: (NSString *)typeSent - returnType: (NSString *)typeReturned +- (id) validRequestorForSendType: (NSString *)typeSent + returnType: (NSString *)typeReturned { NSTRACE (validRequestorForSendType); - if ([ns_send_types indexOfObjectIdenticalTo: typeSent] != NSNotFound && - [ns_return_types indexOfObjectIdenticalTo: typeSent] != NSNotFound) - return self; + if (typeSent != nil && [ns_send_types indexOfObject: typeSent] != NSNotFound + && (typeReturned == nil + || [ns_return_types indexOfObject: typeSent] != NSNotFound)) + { + if (! NILP (ns_get_local_selection (QPRIMARY, QUTF8_STRING))) + return self; + } return [super validRequestorForSendType: typeSent returnType: typeReturned]; @@ -5765,8 +5773,28 @@ ns_term_shutdown (int sig) - (BOOL) writeSelectionToPasteboard: (NSPasteboard *)pb types: (NSArray *)types { - /* supposed to write for as many of types as we are able */ - return NO; + NSArray *typesDeclared; + Lisp_Object val; + + /* We only support NSStringPboardType */ + if ([types containsObject:NSStringPboardType] == NO) { + return NO; + } + + val = ns_get_local_selection (QPRIMARY, QUTF8_STRING); + if (CONSP (val) && SYMBOLP (XCAR (val))) + { + val = XCDR (val); + if (CONSP (val) && NILP (XCDR (val))) + val = XCAR (val); + } + if (! STRINGP (val)) + return NO; + + typesDeclared = [NSArray arrayWithObject:NSStringPboardType]; + [pb declareTypes:typesDeclared owner:nil]; + ns_string_to_pasteboard (pb, val); + return YES; } @@ -6390,6 +6418,8 @@ syms_of_nsterm (void) DEFSYM (Qsuper, "super"); DEFSYM (Qcontrol, "control"); DEFSYM (Qnone, "none"); + DEFSYM (QUTF8_STRING, "UTF8_STRING"); + Fput (Qalt, Qmodifier_value, make_number (alt_modifier)); Fput (Qhyper, Qmodifier_value, make_number (hyper_modifier)); Fput (Qmeta, Qmodifier_value, make_number (meta_modifier)); diff --git a/src/s/irix6-5.h b/src/s/irix6-5.h index d283571d8f..26eb7dcde7 100644 --- a/src/s/irix6-5.h +++ b/src/s/irix6-5.h @@ -96,3 +96,10 @@ char *_getpty(); /* Tested on Irix 6.5. SCM worked on earlier versions. */ #define GC_SETJMP_WORKS 1 #define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS + + +/* DATA_SEG_BITS forces extra bits to be or'd in with any pointers which + were stored in a Lisp_Object (as Emacs uses fewer than 32 bits for + the value field of a LISP_OBJECT). */ +#define DATA_START 0x10000000 +#define DATA_SEG_BITS 0x10000000 diff --git a/src/term.c b/src/term.c index 9205719b5f..be23e54751 100644 --- a/src/term.c +++ b/src/term.c @@ -1546,7 +1546,8 @@ produce_glyphs (struct it *it) /* Nothing but characters are supported on terminal frames. */ xassert (it->what == IT_CHARACTER || it->what == IT_COMPOSITION - || it->what == IT_STRETCH); + || it->what == IT_STRETCH + || it->what == IT_GLYPHLESS); if (it->what == IT_STRETCH) { diff --git a/src/xdisp.c b/src/xdisp.c index a99f06a4e4..774bc22699 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -4583,6 +4583,11 @@ handle_composition_prop (struct it *it) && COMPOSITION_VALID_P (start, end, prop) && (STRINGP (it->string) || (PT <= start || PT >= end))) { + if (start < pos) + /* As we can't handle this situation (perhaps font-lock added + a new composition), we just return here hoping that next + redisplay will detect this composition much earlier. */ + return HANDLED_NORMALLY; if (start != pos) { if (STRINGP (it->string)) |